aboutsummaryrefslogtreecommitdiffstats
path: root/admin
diff options
context:
space:
mode:
Diffstat (limited to 'admin')
-rw-r--r--admin/ChangeLog16
-rw-r--r--admin/admin.el39
-rw-r--r--admin/grammars/README4
-rw-r--r--admin/grammars/bovine-grammar.el507
-rw-r--r--admin/grammars/wisent-grammar.el526
5 files changed, 48 insertions, 1044 deletions
diff --git a/admin/ChangeLog b/admin/ChangeLog
index 2da65523116..7d4921887ce 100644
--- a/admin/ChangeLog
+++ b/admin/ChangeLog
@@ -1,3 +1,19 @@
12012-10-07 Glenn Morris <rgm@gnu.org>
2
3 * admin.el (cusver-new-version): Set default.
4 (cusver-check): Improve interactive argument reading.
5
62012-10-06 Glenn Morris <rgm@gnu.org>
7
8 * admin.el (cusver-new-version): New variable.
9 (cusver-scan): Check if containing group has a :version.
10 (cusver-check): Add VERSION argument.
11
122012-10-01 David Engster <deng@randomsample.de>
13
14 * grammars/bovine-grammar.el:
15 * grammars/wisent-grammar.el: Move to lisp directory.
16
12012-10-01 David Engster <deng@randomsample.de> 172012-10-01 David Engster <deng@randomsample.de>
2 18
3 * grammars/bovine-grammar.el (bovine--grammar-newstyle-unquote): 19 * grammars/bovine-grammar.el (bovine--grammar-newstyle-unquote):
diff --git a/admin/admin.el b/admin/admin.el
index c71e6539413..3e3fbba7202 100644
--- a/admin/admin.el
+++ b/admin/admin.el
@@ -442,8 +442,12 @@ If optional OLD is non-nil, also include defvars."
442 )) 442 ))
443 "{}" "+")) 443 "{}" "+"))
444 444
445;; TODO if a defgroup with a version tag, apply to all customs in that 445(defvar cusver-new-version (format "%s.%s" emacs-major-version
446;; group (eg for new files). 446 (1+ emacs-minor-version))
447 "Version number that new defcustoms should have.")
448
449;; TODO do something about renamed variables with aliases to the old name?
450;; Scan old cus-start.el to find variables moved from C to lisp?
447(defun cusver-scan (file &optional old) 451(defun cusver-scan (file &optional old)
448 "Scan FILE for `defcustom' calls. 452 "Scan FILE for `defcustom' calls.
449Return a list with elements of the form (VAR . VER), 453Return a list with elements of the form (VAR . VER),
@@ -452,8 +456,8 @@ a :version tag having value VER (may be nil).
452If optional argument OLD is non-nil, also scan for defvars." 456If optional argument OLD is non-nil, also scan for defvars."
453 (let ((m (format "Scanning %s..." file)) 457 (let ((m (format "Scanning %s..." file))
454 (re (format "^[ \t]*\\((def%s\\)[ \t\n]" 458 (re (format "^[ \t]*\\((def%s\\)[ \t\n]"
455 (if old "\\(?:custom\\|var\\)" "custom"))) 459 (if old "\\(custom\\|var\\)" "\\(custom\\|group\\)")))
456 alist var ver form) 460 alist var ver form glist grp)
457 (message "%s" m) 461 (message "%s" m)
458 (with-temp-buffer 462 (with-temp-buffer
459 (insert-file-contents file) 463 (insert-file-contents file)
@@ -461,11 +465,23 @@ If optional argument OLD is non-nil, also scan for defvars."
461 (while (re-search-forward re nil t) 465 (while (re-search-forward re nil t)
462 (goto-char (match-beginning 1)) 466 (goto-char (match-beginning 1))
463 (if (and (setq form (ignore-errors (read (current-buffer)))) 467 (if (and (setq form (ignore-errors (read (current-buffer))))
464 (setq var (car-safe (cdr-safe form))) 468 (setq var (car-safe (cdr-safe form)))
465 ;; Exclude macros, eg (defcustom ,varname ...). 469 ;; Exclude macros, eg (defcustom ,varname ...).
466 (symbolp var)) 470 (symbolp var))
467 (setq ver (car (cdr-safe (memq :version form))) 471 (progn
468 alist (cons (cons var ver) alist)) 472 (setq ver (car (cdr-safe (memq :version form))))
473 (if (equal "group" (match-string 2))
474 ;; Group :version could be old.
475 (if (equal ver cusver-new-version)
476 (setq glist (cons (cons var ver) glist)))
477 ;; If it specifies a group and the whole group has a
478 ;; version. use that.
479 (unless ver
480 (setq grp (car (cdr-safe (memq :group form))))
481 (and grp
482 (setq grp (car (cdr-safe grp))) ; (quote foo) -> foo
483 (setq ver (assq grp glist))))
484 (setq alist (cons (cons var ver) alist))))
469 (if form (message "Malformed defcustom: `%s'" form))))) 485 (if form (message "Malformed defcustom: `%s'" form)))))
470 (message "%sdone" m) 486 (message "%sdone" m)
471 alist)) 487 alist))
@@ -490,7 +506,7 @@ If optional argument OLD is non-nil, also scan for defvars."
490;; TODO handle renamed things with aliases to the old names. 506;; TODO handle renamed things with aliases to the old names.
491;; What to do about new files? Does everything in there need a :version, 507;; What to do about new files? Does everything in there need a :version,
492;; or eg just the defgroup? 508;; or eg just the defgroup?
493(defun cusver-check (newdir olddir) 509(defun cusver-check (newdir olddir version)
494 "Check that defcustoms have :version tags where needed. 510 "Check that defcustoms have :version tags where needed.
495NEWDIR is the current lisp/ directory, OLDDIR is that from the previous 511NEWDIR is the current lisp/ directory, OLDDIR is that from the previous
496release. A defcustom that is only in NEWDIR should have a :version 512release. A defcustom that is only in NEWDIR should have a :version
@@ -499,11 +515,16 @@ just converting a defvar to a defcustom does not require a :version bump.
499 515
500Note that a :version tag should also be added if the value of a defcustom 516Note that a :version tag should also be added if the value of a defcustom
501changes (in a non-trivial way). This function does not check for that." 517changes (in a non-trivial way). This function does not check for that."
502 (interactive "DNew Lisp directory: \nDOld Lisp directory: ") 518 (interactive (list (read-directory-name "New Lisp directory: ")
519 (read-directory-name "Old Lisp directory: ")
520 (number-to-string
521 (read-number "New version number: "
522 (string-to-number cusver-new-version)))))
503 (or (file-directory-p (setq newdir (expand-file-name newdir))) 523 (or (file-directory-p (setq newdir (expand-file-name newdir)))
504 (error "Directory `%s' not found" newdir)) 524 (error "Directory `%s' not found" newdir))
505 (or (file-directory-p (setq olddir (expand-file-name olddir))) 525 (or (file-directory-p (setq olddir (expand-file-name olddir)))
506 (error "Directory `%s' not found" olddir)) 526 (error "Directory `%s' not found" olddir))
527 (setq cusver-new-version version)
507 (let* ((newfiles (progn (message "Finding new files with defcustoms...") 528 (let* ((newfiles (progn (message "Finding new files with defcustoms...")
508 (cusver-find-files newdir))) 529 (cusver-find-files newdir)))
509 (oldfiles (progn (message "Finding old files with defcustoms...") 530 (oldfiles (progn (message "Finding old files with defcustoms...")
diff --git a/admin/grammars/README b/admin/grammars/README
index 419797e0dcb..e38260952a5 100644
--- a/admin/grammars/README
+++ b/admin/grammars/README
@@ -3,8 +3,8 @@ generate the parser data in the lisp/semantic/bovine/ and
3lisp/semantic/wisent/ directories. You can run the parser generators 3lisp/semantic/wisent/ directories. You can run the parser generators
4with 4with
5 5
6emacs -batch -Q -l bovine-grammar.el -f bovine-make-parsers 6emacs -batch -Q -l semantic/bovine/grammar -f bovine-make-parsers
7emacs -batch -Q -l wisent-grammar.el -f wisent-make-parsers 7emacs -batch -Q -l semantic/wisent/grammar -f wisent-make-parsers
8 8
9Currently, the parser files in lisp/ are not generated directly from 9Currently, the parser files in lisp/ are not generated directly from
10these grammar files when making Emacs. This state of affairs, and the 10these grammar files when making Emacs. This state of affairs, and the
diff --git a/admin/grammars/bovine-grammar.el b/admin/grammars/bovine-grammar.el
deleted file mode 100644
index a7289f6bafe..00000000000
--- a/admin/grammars/bovine-grammar.el
+++ /dev/null
@@ -1,507 +0,0 @@
1;;; bovine-grammar.el --- Bovine's input grammar mode
2;;
3;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
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)
35(require 'semantic/lex)
36(require 'semantic/wisent)
37(require 'semantic/bovine)
38
39(defun bovine-grammar-EXPAND (bounds nonterm)
40 "Expand call to EXPAND grammar macro.
41Return the form to parse from within a nonterminal between BOUNDS.
42NONTERM 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.
48Return the form to recursively parse the area between BOUNDS.
49NONTERM 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.
55Return the form to create a generic semantic tag.
56See the function `semantic-tag' for the meaning of arguments NAME,
57CLASS 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.
62Return the form to create a semantic tag of class variable.
63See the function `semantic-tag-new-variable' for the meaning of
64arguments 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.
69Return the form to create a semantic tag of class function.
70See the function `semantic-tag-new-function' for the meaning of
71arguments 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.
76Return the form to create a semantic tag of class type.
77See the function `semantic-tag-new-type' for the meaning of arguments
78NAME, 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.
83Return the form to create a semantic tag of class include.
84See the function `semantic-tag-new-include' for the meaning of
85arguments 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.
90Return the form to create a semantic tag of class package.
91See the function `semantic-tag-new-package' for the meaning of
92arguments 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.
97Return the form to create a semantic tag of class code.
98See the function `semantic-tag-new-code' for the meaning of arguments
99NAME, 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.
104Return the form to create a semantic tag of class alias.
105See the function `semantic-tag-new-alias' for the meaning of arguments
106NAME, 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.
114FORM is a list in which we are substituting.
115Argument QUOTEMODE is non-nil if we are in backquote mode.
116When non-nil, optional argument INPLACE indicates that FORM is being
117expanded from elsewhere."
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))
145 ;; Hack for dealing with new reading of unquotes outside of
146 ;; backquote (introduced in rev. 102591 in emacs-bzr).
147 (when (and (>= emacs-major-version 24)
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)))))))
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 ")")))
234 ))
235
236(defun bovine-grammar-expand-action (textform quotemode)
237 "Expand semantic action string TEXTFORM into Lisp code.
238QUOTEMODE is the mode in which quoted symbols are slurred."
239 (if (string= "" textform)
240 nil
241 (let ((sexp (read textform)))
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.
267The 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
274Where each NONTERMINAL-SYMBOL is an artificial symbol which can appear
275in any child state. As a starting place, one of the NONTERMINAL-SYMBOLS
276must be `bovine-toplevel'.
277
278A MATCH-LIST is a list of possible matches of the form:
279
280 ( STATE-LIST1
281 STATE-LIST2
282 ...
283 STATE-LISTN )
284
285where STATE-LIST is of the form:
286 ( TYPE1 [ \"VALUE1\" ] TYPE2 [ \"VALUE2\" ] ... LAMBDA )
287
288where TYPE is one of the returned types of the token stream.
289VALUE is a value, or range of values to match against. For
290example, a SYMBOL might need to match \"foo\". Some TYPES will not
291have matching criteria.
292
293LAMBDA is a lambda expression which is evalled with the text of the
294type when it is found. It is passed the list of all buffer text
295elements found since the last lambda expression. It should return a
296semantic element (see below.)
297
298For consistency between languages, try to use common return values
299from your parser. Please reference the chapter \"Writing Parsers\" in
300the \"Language Support Developer's Guide -\" in the semantic texinfo
301manual."
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)
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 ))))
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
416 '("BY Grammar"
417 )
418 "BY mode specific grammar menu.
419Menu items are appended to the common grammar menu.")
420
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)
426 (grammar-setupcode-builder . bovine-grammar-setupcode-builder)
427 )))
428
429(add-to-list 'auto-mode-alist '("\\.by\\'" . bovine-grammar-mode))
430
431(defvar-mode-local bovine-grammar-mode semantic-grammar-macros
432 '(
433 (ASSOC . semantic-grammar-ASSOC)
434 (EXPAND . bovine-grammar-EXPAND)
435 (EXPANDFULL . bovine-grammar-EXPANDFULL)
436 (TAG . bovine-grammar-TAG)
437 (VARIABLE-TAG . bovine-grammar-VARIABLE-TAG)
438 (FUNCTION-TAG . bovine-grammar-FUNCTION-TAG)
439 (TYPE-TAG . bovine-grammar-TYPE-TAG)
440 (INCLUDE-TAG . bovine-grammar-INCLUDE-TAG)
441 (PACKAGE-TAG . bovine-grammar-PACKAGE-TAG)
442 (CODE-TAG . bovine-grammar-CODE-TAG)
443 (ALIAS-TAG . bovine-grammar-ALIAS-TAG)
444 )
445 "Semantic grammar macros used in bovine grammars.")
446
447(provide 'semantic/bovine/grammar)
448
449(defun bovine-make-parsers ()
450 "Generate Emacs' built-in Bovine-based parser files."
451 (interactive)
452 (semantic-mode 1)
453 ;; Loop through each .by file in current directory, and run
454 ;; `semantic-grammar-batch-build-one-package' to build the grammar.
455 (dolist (f (directory-files default-directory nil "\\.by\\'"))
456 (let ((packagename
457 (condition-case err
458 (with-current-buffer (find-file-noselect f)
459 (semantic-grammar-create-package))
460 (error (message "%s" (error-message-string err)) nil)))
461 lang filename)
462 (when (and packagename
463 (string-match "^.*/\\(.*\\)-by\\.el\\'" packagename))
464 (setq lang (match-string 1 packagename))
465 (setq filename (concat lang "-by.el"))
466 (with-temp-buffer
467 (insert-file-contents filename)
468 (setq buffer-file-name (expand-file-name filename))
469 ;; Fix copyright header:
470 (goto-char (point-min))
471 (re-search-forward "^;; Author:")
472 (setq copyright-end (match-beginning 0))
473 (re-search-forward "^;;; Code:\n")
474 (delete-region copyright-end (match-end 0))
475 (goto-char copyright-end)
476 (insert ";; This file is part of GNU Emacs.
477
478;; GNU Emacs is free software: you can redistribute it and/or modify
479;; it under the terms of the GNU General Public License as published by
480;; the Free Software Foundation, either version 3 of the License, or
481;; (at your option) any later version.
482
483;; GNU Emacs is distributed in the hope that it will be useful,
484;; but WITHOUT ANY WARRANTY; without even the implied warranty of
485;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
486;; GNU General Public License for more details.
487
488;; You should have received a copy of the GNU General Public License
489;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
490
491;;; Commentary:
492;;
493;; This file was generated from admin/grammars/"
494 lang ".by.
495
496;;; Code:
497")
498 (goto-char (point-min))
499 (delete-region (point-min) (line-end-position))
500 (insert ";;; " packagename
501 " --- Generated parser support file")
502 (delete-trailing-whitespace)
503 (re-search-forward ";;; \\(.*\\) ends here")
504 (replace-match packagename nil nil nil 1)
505 (save-buffer))))))
506
507;;; bovine-grammar.el ends here
diff --git a/admin/grammars/wisent-grammar.el b/admin/grammars/wisent-grammar.el
deleted file mode 100644
index 25dba5be2d8..00000000000
--- a/admin/grammars/wisent-grammar.el
+++ /dev/null
@@ -1,526 +0,0 @@
1;;; wisent-grammar.el --- Wisent's input grammar mode
2
3;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
4;;
5;; Author: David Ponce <david@dponce.com>
6;; Maintainer: David Ponce <david@dponce.com>
7;; Created: 26 Aug 2002
8;; Keywords: syntax
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software: you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23
24;;; Commentary:
25;;
26;; Major mode for editing Wisent's input grammar (.wy) files.
27
28;;; Code:
29(require 'semantic)
30(require 'semantic/grammar)
31(require 'semantic/find)
32(require 'semantic/lex)
33(require 'semantic/wisent)
34(require 'semantic/bovine)
35
36(defsubst wisent-grammar-region-placeholder (symb)
37 "Given a $N placeholder symbol in SYMB, return a $regionN symbol.
38Return nil if $N is not a valid placeholder symbol."
39 (let ((n (symbol-name symb)))
40 (if (string-match "^[$]\\([1-9][0-9]*\\)$" n)
41 (intern (concat "$region" (match-string 1 n))))))
42
43(defun wisent-grammar-EXPAND (symb nonterm)
44 "Expand call to EXPAND grammar macro.
45Return the form to parse from within a nonterminal.
46SYMB is a $I placeholder symbol that gives the bounds of the area to
47parse.
48NONTERM is the nonterminal symbol to start with."
49 (unless (member nonterm (semantic-grammar-start))
50 (error "EXPANDFULL macro called with %s, but not used with %%start"
51 nonterm))
52 (let (($ri (wisent-grammar-region-placeholder symb)))
53 (if $ri
54 `(semantic-bovinate-from-nonterminal
55 (car ,$ri) (cdr ,$ri) ',nonterm)
56 (error "Invalid form (EXPAND %s %s)" symb nonterm))))
57
58(defun wisent-grammar-EXPANDFULL (symb nonterm)
59 "Expand call to EXPANDFULL grammar macro.
60Return the form to recursively parse an area.
61SYMB is a $I placeholder symbol that gives the bounds of the area.
62NONTERM is the nonterminal symbol to start with."
63 (unless (member nonterm (semantic-grammar-start))
64 (error "EXPANDFULL macro called with %s, but not used with %%start"
65 nonterm))
66 (let (($ri (wisent-grammar-region-placeholder symb)))
67 (if $ri
68 `(semantic-parse-region
69 (car ,$ri) (cdr ,$ri) ',nonterm 1)
70 (error "Invalid form (EXPANDFULL %s %s)" symb nonterm))))
71
72(defun wisent-grammar-TAG (name class &rest attributes)
73 "Expand call to TAG grammar macro.
74Return the form to create a generic semantic tag.
75See the function `semantic-tag' for the meaning of arguments NAME,
76CLASS and ATTRIBUTES."
77 `(wisent-raw-tag
78 (semantic-tag ,name ,class ,@attributes)))
79
80(defun wisent-grammar-VARIABLE-TAG (name type default-value &rest attributes)
81 "Expand call to VARIABLE-TAG grammar macro.
82Return the form to create a semantic tag of class variable.
83See the function `semantic-tag-new-variable' for the meaning of
84arguments NAME, TYPE, DEFAULT-VALUE and ATTRIBUTES."
85 `(wisent-raw-tag
86 (semantic-tag-new-variable ,name ,type ,default-value ,@attributes)))
87
88(defun wisent-grammar-FUNCTION-TAG (name type arg-list &rest attributes)
89 "Expand call to FUNCTION-TAG grammar macro.
90Return the form to create a semantic tag of class function.
91See the function `semantic-tag-new-function' for the meaning of
92arguments NAME, TYPE, ARG-LIST and ATTRIBUTES."
93 `(wisent-raw-tag
94 (semantic-tag-new-function ,name ,type ,arg-list ,@attributes)))
95
96(defun wisent-grammar-TYPE-TAG (name type members parents &rest attributes)
97 "Expand call to TYPE-TAG grammar macro.
98Return the form to create a semantic tag of class type.
99See the function `semantic-tag-new-type' for the meaning of arguments
100NAME, TYPE, MEMBERS, PARENTS and ATTRIBUTES."
101 `(wisent-raw-tag
102 (semantic-tag-new-type ,name ,type ,members ,parents ,@attributes)))
103
104(defun wisent-grammar-INCLUDE-TAG (name system-flag &rest attributes)
105 "Expand call to INCLUDE-TAG grammar macro.
106Return the form to create a semantic tag of class include.
107See the function `semantic-tag-new-include' for the meaning of
108arguments NAME, SYSTEM-FLAG and ATTRIBUTES."
109 `(wisent-raw-tag
110 (semantic-tag-new-include ,name ,system-flag ,@attributes)))
111
112(defun wisent-grammar-PACKAGE-TAG (name detail &rest attributes)
113 "Expand call to PACKAGE-TAG grammar macro.
114Return the form to create a semantic tag of class package.
115See the function `semantic-tag-new-package' for the meaning of
116arguments NAME, DETAIL and ATTRIBUTES."
117 `(wisent-raw-tag
118 (semantic-tag-new-package ,name ,detail ,@attributes)))
119
120(defun wisent-grammar-CODE-TAG (name detail &rest attributes)
121 "Expand call to CODE-TAG grammar macro.
122Return the form to create a semantic tag of class code.
123See the function `semantic-tag-new-code' for the meaning of arguments
124NAME, DETAIL and ATTRIBUTES."
125 `(wisent-raw-tag
126 (semantic-tag-new-code ,name ,detail ,@attributes)))
127
128(defun wisent-grammar-ALIAS-TAG (name aliasclass definition &rest attributes)
129 "Expand call to ALIAS-TAG grammar macro.
130Return the form to create a semantic tag of class alias.
131See the function `semantic-tag-new-alias' for the meaning of arguments
132NAME, ALIASCLASS, DEFINITION and ATTRIBUTES."
133 `(wisent-raw-tag
134 (semantic-tag-new-alias ,name ,aliasclass ,definition ,@attributes)))
135
136(defun wisent-grammar-EXPANDTAG (raw-tag)
137 "Expand call to EXPANDTAG grammar macro.
138Return the form to produce a list of cooked tags from raw form of
139Semantic tag RAW-TAG."
140 `(wisent-cook-tag ,raw-tag))
141
142(defun wisent-grammar-AST-ADD (ast &rest nodes)
143 "Expand call to AST-ADD grammar macro.
144Return the form to update the abstract syntax tree AST with NODES.
145See also the function `semantic-ast-add'."
146 `(semantic-ast-add ,ast ,@nodes))
147
148(defun wisent-grammar-AST-PUT (ast &rest nodes)
149 "Expand call to AST-PUT grammar macro.
150Return the form to update the abstract syntax tree AST with NODES.
151See also the function `semantic-ast-put'."
152 `(semantic-ast-put ,ast ,@nodes))
153
154(defun wisent-grammar-AST-GET (ast node)
155 "Expand call to AST-GET grammar macro.
156Return the form to get, from the abstract syntax tree AST, the value
157of NODE.
158See also the function `semantic-ast-get'."
159 `(semantic-ast-get ,ast ,node))
160
161(defun wisent-grammar-AST-GET1 (ast node)
162 "Expand call to AST-GET1 grammar macro.
163Return the form to get, from the abstract syntax tree AST, the first
164value of NODE.
165See also the function `semantic-ast-get1'."
166 `(semantic-ast-get1 ,ast ,node))
167
168(defun wisent-grammar-AST-GET-STRING (ast node)
169 "Expand call to AST-GET-STRING grammar macro.
170Return the form to get, from the abstract syntax tree AST, the value
171of NODE as a string.
172See also the function `semantic-ast-get-string'."
173 `(semantic-ast-get-string ,ast ,node))
174
175(defun wisent-grammar-AST-MERGE (ast1 ast2)
176 "Expand call to AST-MERGE grammar macro.
177Return the form to merge the abstract syntax trees AST1 and AST2.
178See also the function `semantic-ast-merge'."
179 `(semantic-ast-merge ,ast1 ,ast2))
180
181(defun wisent-grammar-SKIP-BLOCK (&optional symb)
182 "Expand call to SKIP-BLOCK grammar macro.
183Return the form to skip a parenthesized block.
184Optional argument SYMB is a $I placeholder symbol that gives the
185bounds of the block to skip. By default, skip the block at `$1'.
186See also the function `wisent-skip-block'."
187 (let ($ri)
188 (when symb
189 (unless (setq $ri (wisent-grammar-region-placeholder symb))
190 (error "Invalid form (SKIP-BLOCK %s)" symb)))
191 `(wisent-skip-block ,$ri)))
192
193(defun wisent-grammar-SKIP-TOKEN ()
194 "Expand call to SKIP-TOKEN grammar macro.
195Return the form to skip the lookahead token.
196See also the function `wisent-skip-token'."
197 `(wisent-skip-token))
198
199(defun wisent-grammar-assocs ()
200 "Return associativity and precedence level definitions."
201 (mapcar
202 #'(lambda (tag)
203 (cons (intern (semantic-tag-name tag))
204 (mapcar #'semantic-grammar-item-value
205 (semantic-tag-get-attribute tag :value))))
206 (semantic-find-tags-by-class 'assoc (current-buffer))))
207
208(defun wisent-grammar-terminals ()
209 "Return the list of terminal symbols.
210Keep order of declaration in the WY file without duplicates."
211 (let (terms)
212 (mapc
213 #'(lambda (tag)
214 (mapcar #'(lambda (name)
215 (add-to-list 'terms (intern name)))
216 (cons (semantic-tag-name tag)
217 (semantic-tag-get-attribute tag :rest))))
218 (semantic--find-tags-by-function
219 #'(lambda (tag)
220 (memq (semantic-tag-class tag) '(token keyword)))
221 (current-buffer)))
222 (nreverse terms)))
223
224;; Cache of macro definitions currently in use.
225(defvar wisent--grammar-macros nil)
226
227(defun wisent-grammar-expand-macros (expr)
228 "Expand expression EXPR into a form without grammar macros.
229Return the expanded expression."
230 (if (or (atom expr) (semantic-grammar-quote-p (car expr)))
231 expr ;; Just return atom or quoted expression.
232 (let* ((expr (mapcar 'wisent-grammar-expand-macros expr))
233 (macro (assq (car expr) wisent--grammar-macros)))
234 (if macro ;; Expand Semantic built-in.
235 (apply (cdr macro) (cdr expr))
236 expr))))
237
238(defun wisent-grammar-nonterminals ()
239 "Return the list form of nonterminal definitions."
240 (let ((nttags (semantic-find-tags-by-class
241 'nonterminal (current-buffer)))
242 ;; Setup the cache of macro definitions.
243 (wisent--grammar-macros (semantic-grammar-macros))
244 rltags nterms rules rule elems elem actn sexp prec)
245 (while nttags
246 (setq rltags (semantic-tag-components (car nttags))
247 rules nil)
248 (while rltags
249 (setq elems (semantic-tag-get-attribute (car rltags) :value)
250 prec (semantic-tag-get-attribute (car rltags) :prec)
251 actn (semantic-tag-get-attribute (car rltags) :expr)
252 rule nil)
253 (when elems ;; not an EMPTY rule
254 (while elems
255 (setq elem (car elems)
256 elems (cdr elems))
257 (setq elem (if (consp elem) ;; mid-rule action
258 (wisent-grammar-expand-macros (read (car elem)))
259 (semantic-grammar-item-value elem)) ;; item
260 rule (cons elem rule)))
261 (setq rule (nreverse rule)))
262 (if prec
263 (setq prec (vector (semantic-grammar-item-value prec))))
264 (if actn
265 (setq sexp (wisent-grammar-expand-macros (read actn))))
266 (setq rule (if actn
267 (if prec
268 (list rule prec sexp)
269 (list rule sexp))
270 (if prec
271 (list rule prec)
272 (list rule))))
273 (setq rules (cons rule rules)
274 rltags (cdr rltags)))
275 (setq nterms (cons (cons (intern (semantic-tag-name (car nttags)))
276 (nreverse rules))
277 nterms)
278 nttags (cdr nttags)))
279 (nreverse nterms)))
280
281(defun wisent-grammar-grammar ()
282 "Return Elisp form of the grammar."
283 (let* ((terminals (wisent-grammar-terminals))
284 (nonterminals (wisent-grammar-nonterminals))
285 (assocs (wisent-grammar-assocs)))
286 (cons terminals (cons assocs nonterminals))))
287
288(defun wisent-grammar-parsetable-builder ()
289 "Return the value of the parser table."
290 `(progn
291 ;; Ensure that the grammar [byte-]compiler is available.
292 (eval-when-compile (require 'semantic/wisent/comp))
293 (wisent-compile-grammar
294 ',(wisent-grammar-grammar)
295 ',(semantic-grammar-start))))
296
297(defun wisent-grammar-setupcode-builder ()
298 "Return the parser setup code."
299 (format
300 "(semantic-install-function-overrides\n\
301 '((parse-stream . wisent-parse-stream)))\n\
302 (setq semantic-parser-name \"LALR\"\n\
303 semantic--parse-table %s\n\
304 semantic-debug-parser-source %S\n\
305 semantic-flex-keywords-obarray %s\n\
306 semantic-lex-types-obarray %s)\n\
307 ;; Collect unmatched syntax lexical tokens\n\
308 (semantic-make-local-hook 'wisent-discarding-token-functions)\n\
309 (add-hook 'wisent-discarding-token-functions\n\
310 'wisent-collect-unmatched-syntax nil t)"
311 (semantic-grammar-parsetable)
312 (buffer-name)
313 (semantic-grammar-keywordtable)
314 (semantic-grammar-tokentable)))
315
316(defvar wisent-grammar-menu
317 '("WY Grammar"
318 ["LALR Compiler Verbose" wisent-toggle-verbose-flag
319 :style toggle :active (boundp 'wisent-verbose-flag)
320 :selected (and (boundp 'wisent-verbose-flag)
321 wisent-verbose-flag)]
322 )
323 "WY mode specific grammar menu.
324Menu items are appended to the common grammar menu.")
325
326(define-derived-mode wisent-grammar-mode semantic-grammar-mode "WY"
327 "Major mode for editing Wisent grammars."
328 (semantic-grammar-setup-menu wisent-grammar-menu)
329 (semantic-install-function-overrides
330 '((grammar-parsetable-builder . wisent-grammar-parsetable-builder)
331 (grammar-setupcode-builder . wisent-grammar-setupcode-builder)
332 )))
333
334(add-to-list 'auto-mode-alist '("\\.wy\\'" . wisent-grammar-mode))
335
336(defvar-mode-local wisent-grammar-mode semantic-grammar-macros
337 '(
338 (ASSOC . semantic-grammar-ASSOC)
339 (EXPAND . wisent-grammar-EXPAND)
340 (EXPANDFULL . wisent-grammar-EXPANDFULL)
341 (TAG . wisent-grammar-TAG)
342 (VARIABLE-TAG . wisent-grammar-VARIABLE-TAG)
343 (FUNCTION-TAG . wisent-grammar-FUNCTION-TAG)
344 (TYPE-TAG . wisent-grammar-TYPE-TAG)
345 (INCLUDE-TAG . wisent-grammar-INCLUDE-TAG)
346 (PACKAGE-TAG . wisent-grammar-PACKAGE-TAG)
347 (EXPANDTAG . wisent-grammar-EXPANDTAG)
348 (CODE-TAG . wisent-grammar-CODE-TAG)
349 (ALIAS-TAG . wisent-grammar-ALIAS-TAG)
350 (AST-ADD . wisent-grammar-AST-ADD)
351 (AST-PUT . wisent-grammar-AST-PUT)
352 (AST-GET . wisent-grammar-AST-GET)
353 (AST-GET1 . wisent-grammar-AST-GET1)
354 (AST-GET-STRING . wisent-grammar-AST-GET-STRING)
355 (AST-MERGE . wisent-grammar-AST-MERGE)
356 (SKIP-BLOCK . wisent-grammar-SKIP-BLOCK)
357 (SKIP-TOKEN . wisent-grammar-SKIP-TOKEN)
358 )
359 "Semantic grammar macros used in wisent grammars.")
360
361(defvar wisent-make-parsers--emacs-license
362 ";; This file is part of GNU Emacs.
363
364;; GNU Emacs is free software: you can redistribute it and/or modify
365;; it under the terms of the GNU General Public License as published by
366;; the Free Software Foundation, either version 3 of the License, or
367;; (at your option) any later version.
368
369;; GNU Emacs is distributed in the hope that it will be useful,
370;; but WITHOUT ANY WARRANTY; without even the implied warranty of
371;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
372;; GNU General Public License for more details.
373
374;; You should have received a copy of the GNU General Public License
375;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.")
376
377(defvar wisent-make-parsers--python-license
378 ";; It is derived in part from the Python grammar, used under the
379;; following license:
380;;
381;; PYTHON SOFTWARE FOUNDATION LICENSE VERSION 2
382;; --------------------------------------------
383;; 1. This LICENSE AGREEMENT is between the Python Software Foundation
384;; (\"PSF\"), and the Individual or Organization (\"Licensee\") accessing
385;; and otherwise using this software (\"Python\") in source or binary
386;; form and its associated documentation.
387;;
388;; 2. Subject to the terms and conditions of this License Agreement,
389;; PSF hereby grants Licensee a nonexclusive, royalty-free, world-wide
390;; license to reproduce, analyze, test, perform and/or display
391;; publicly, prepare derivative works, distribute, and otherwise use
392;; Python alone or in any derivative version, provided, however, that
393;; PSF's License Agreement and PSF's notice of copyright, i.e.,
394;; \"Copyright (c) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
395;; 2009, 2010 Python Software Foundation; All Rights Reserved\" are
396;; retained in Python alone or in any derivative version prepared by
397;; Licensee.
398;;
399;; 3. In the event Licensee prepares a derivative work that is based
400;; on or incorporates Python or any part thereof, and wants to make
401;; the derivative work available to others as provided herein, then
402;; Licensee hereby agrees to include in any such work a brief summary
403;; of the changes made to Python.
404;;
405;; 4. PSF is making Python available to Licensee on an \"AS IS\"
406;; basis. PSF MAKES NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR
407;; IMPLIED. BY WAY OF EXAMPLE, BUT NOT LIMITATION, PSF MAKES NO AND
408;; DISCLAIMS ANY REPRESENTATION OR WARRANTY OF MERCHANTABILITY OR FITNESS
409;; FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF PYTHON WILL NOT
410;; INFRINGE ANY THIRD PARTY RIGHTS.
411;;
412;; 5. PSF SHALL NOT BE LIABLE TO LICENSEE OR ANY OTHER USERS OF PYTHON
413;; FOR ANY INCIDENTAL, SPECIAL, OR CONSEQUENTIAL DAMAGES OR LOSS AS A
414;; RESULT OF MODIFYING, DISTRIBUTING, OR OTHERWISE USING PYTHON, OR
415;; ANY DERIVATIVE THEREOF, EVEN IF ADVISED OF THE POSSIBILITY THEREOF.
416;;
417;; 6. This License Agreement will automatically terminate upon a
418;; material breach of its terms and conditions.
419;;
420;; 7. Nothing in this License Agreement shall be deemed to create any
421;; relationship of agency, partnership, or joint venture between PSF
422;; and Licensee. This License Agreement does not grant permission to
423;; use PSF trademarks or trade name in a trademark sense to endorse or
424;; promote products or services of Licensee, or any third party.
425;;
426;; 8. By copying, installing or otherwise using Python, Licensee
427;; agrees to be bound by the terms and conditions of this License
428;; Agreement.")
429
430(defvar wisent-make-parsers--ecmascript-license
431 "\n;; It is derived from the grammar in the ECMAScript Language
432;; Specification published at
433;;
434;; http://www.ecma-international.org/publications/standards/Ecma-262.htm
435;;
436;; and redistributed under the following license:
437;;
438;; Redistribution and use in source and binary forms, with or without
439;; modification, are permitted provided that the following conditions
440;; are met:
441;;
442;; 1. Redistributions of source code must retain the above copyright
443;; notice, this list of conditions and the following disclaimer.
444;;
445;; 2. Redistributions in binary form must reproduce the above
446;; copyright notice, this list of conditions and the following
447;; disclaimer in the documentation and/or other materials provided
448;; with the distribution.
449;;
450;; 3. Neither the name of the authors nor Ecma International may be
451;; used to endorse or promote products derived from this software
452;; without specific prior written permission. THIS SOFTWARE IS
453;; PROVIDED BY THE ECMA INTERNATIONAL \"AS IS\" AND ANY EXPRESS OR
454;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
455;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
456;; ARE DISCLAIMED. IN NO EVENT SHALL ECMA INTERNATIONAL BE LIABLE FOR
457;; ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
458;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
459;; OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
460;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
461;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
462;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
463;; USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
464;; DAMAGE.")
465
466(defvar wisent-make-parsers--parser-file-name
467 `(("semantic/grammar-wy.el")
468 ("srecode/srt-wy.el")
469 ("semantic/wisent/js-wy.el"
470 "Copyright (C) 1998-2011 Ecma International."
471 ,wisent-make-parsers--ecmascript-license)
472 ("semantic/wisent/javat-wy.el")
473 ("semantic/wisent/python-wy.el"
474 "Copyright (c) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
475\;; 2009, 2010 Python Software Foundation; All Rights Reserved"
476 ,wisent-make-parsers--python-license)))
477
478(defun wisent-make-parsers ()
479 "Generate Emacs' built-in Wisent-based parser files."
480 (interactive)
481 (semantic-mode 1)
482 ;; Loop through each .wy file in current directory, and run
483 ;; `semantic-grammar-batch-build-one-package' to build the grammar.
484 (dolist (f (directory-files default-directory nil "\\.wy\\'"))
485 (let ((packagename
486 (condition-case err
487 (with-current-buffer (find-file-noselect f)
488 (semantic-grammar-create-package))
489 (error (message "%s" (error-message-string err)) nil)))
490 output-data)
491 (when (setq output-data (assoc packagename wisent-make-parsers--parser-file-name))
492 (let ((additional-copyright (nth 1 output-data))
493 (additional-license (nth 2 output-data))
494 (filename (progn (string-match ".*/\\(.*\\)" packagename) (match-string 1 packagename)))
495 copyright-end)
496 ;; Touch up the generated parsers for Emacs integration.
497 (with-temp-buffer
498 (insert-file-contents filename)
499 ;; Fix copyright header:
500 (goto-char (point-min))
501 (when additional-copyright
502 (re-search-forward "Copyright (C).*$")
503 (insert "\n;; " additional-copyright))
504 (re-search-forward "^;; Author:")
505 (setq copyright-end (match-beginning 0))
506 (re-search-forward "^;;; Code:\n")
507 (delete-region copyright-end (match-end 0))
508 (goto-char copyright-end)
509 (insert wisent-make-parsers--emacs-license)
510 (insert "\n\n;;; Commentary:
511;;
512;; This file was generated from admin/grammars/"
513 f ".")
514 (when additional-license
515 (insert "\n" additional-license))
516 (insert "\n\n;;; Code:\n")
517 (goto-char (point-min))
518 (delete-region (point-min) (line-end-position))
519 (insert ";;; " packagename
520 " --- Generated parser support file")
521 (re-search-forward ";;; \\(.*\\) ends here")
522 (replace-match packagename nil nil nil 1)
523 (delete-trailing-whitespace)
524 (write-region nil nil (expand-file-name filename))))))))
525
526;;; wisent-grammar.el ends here
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-18 08:22:16 +0000