etc/grammars/wisent-grammar.el

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