etc/grammars/wisent-grammar.el

   1 ;;; wisent-grammar.el --- Wisent's input grammar mode
   2
   3 ;; Copyright (C) 2002-2011 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.
  38 Return 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.
  45 Return the form to parse from within a nonterminal.
  46 SYMB is a $I placeholder symbol that gives the bounds of the area to
  47 parse.
  48 NONTERM 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.
  60 Return the form to recursively parse an area.
  61 SYMB is a $I placeholder symbol that gives the bounds of the area.
  62 NONTERM 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.
  74 Return the form to create a generic semantic tag.
  75 See the function `semantic-tag' for the meaning of arguments NAME,
  76 CLASS 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.
  82 Return the form to create a semantic tag of class variable.
  83 See the function `semantic-tag-new-variable' for the meaning of
  84 arguments 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.
  90 Return the form to create a semantic tag of class function.
  91 See the function `semantic-tag-new-function' for the meaning of
  92 arguments 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.
  98 Return the form to create a semantic tag of class type.
  99 See the function `semantic-tag-new-type' for the meaning of arguments
 100 NAME, 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.
 106 Return the form to create a semantic tag of class include.
 107 See the function `semantic-tag-new-include' for the meaning of
 108 arguments 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.
 114 Return the form to create a semantic tag of class package.
 115 See the function `semantic-tag-new-package' for the meaning of
 116 arguments 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.
 122 Return the form to create a semantic tag of class code.
 123 See the function `semantic-tag-new-code' for the meaning of arguments
 124 NAME, 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.
 130 Return the form to create a semantic tag of class alias.
 131 See the function `semantic-tag-new-alias' for the meaning of arguments
 132 NAME, 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.
 138 Return the form to produce a list of cooked tags from raw form of
 139 Semantic 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.
 144 Return the form to update the abstract syntax tree AST with NODES.
 145 See 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.
 150 Return the form to update the abstract syntax tree AST with NODES.
 151 See 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.
 156 Return the form to get, from the abstract syntax tree AST, the value
 157 of NODE.
 158 See 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.
 163 Return the form to get, from the abstract syntax tree AST, the first
 164 value of NODE.
 165 See 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.
 170 Return the form to get, from the abstract syntax tree AST, the value
 171 of NODE as a string.
 172 See 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.
 177 Return the form to merge the abstract syntax trees AST1 and AST2.
 178 See 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.
 183 Return the form to skip a parenthesized block.
 184 Optional argument SYMB is a $I placeholder symbol that gives the
 185 bounds of the block to skip.  By default, skip the block at `$1'.
 186 See 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.
 195 Return the form to skip the lookahead token.
 196 See 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.
 210 Keep order of declaration in the WY file without duplicates."
 211   (let (terms)
 212     (mapcar
 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.
 229 Return 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.
 324 Menu 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
 362 (defvar wisent-make-parsers--emacs-license
 363   ";; This file is part of GNU Emacs.
 364
 365 ;; GNU Emacs is free software: you can redistribute it and/or modify
 366 ;; it under the terms of the GNU General Public License as published by
 367 ;; the Free Software Foundation, either version 3 of the License, or
 368 ;; (at your option) any later version.
 369
 370 ;; GNU Emacs is distributed in the hope that it will be useful,
 371 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 372 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 373 ;; GNU General Public License for more details.
 374
 375 ;; You should have received a copy of the GNU General Public License
 376 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.")
 377
 378 (defvar wisent-make-parsers--python-license
 379   ";; It is derived in part from the Python grammar, used under the
 380 ;; following license:
 381 ;;
 382 ;; PYTHON SOFTWARE FOUNDATION LICENSE VERSION 2
 383 ;; --------------------------------------------
 384 ;; 1. This LICENSE AGREEMENT is between the Python Software Foundation
 385 ;; (\"PSF\"), and the Individual or Organization (\"Licensee\") accessing
 386 ;; and otherwise using this software (\"Python\") in source or binary
 387 ;; form and its associated documentation.
 388 ;;
 389 ;; 2. Subject to the terms and conditions of this License Agreement,
 390 ;; PSF hereby grants Licensee a nonexclusive, royalty-free, world-wide
 391 ;; license to reproduce, analyze, test, perform and/or display
 392 ;; publicly, prepare derivative works, distribute, and otherwise use
 393 ;; Python alone or in any derivative version, provided, however, that
 394 ;; PSF's License Agreement and PSF's notice of copyright, i.e.,
 395 ;; \"Copyright (c) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
 396 ;; 2009, 2010 Python Software Foundation; All Rights Reserved\" are
 397 ;; retained in Python alone or in any derivative version prepared by
 398 ;; Licensee.
 399 ;;
 400 ;; 3. In the event Licensee prepares a derivative work that is based
 401 ;; on or incorporates Python or any part thereof, and wants to make
 402 ;; the derivative work available to others as provided herein, then
 403 ;; Licensee hereby agrees to include in any such work a brief summary
 404 ;; of the changes made to Python.
 405 ;;
 406 ;; 4. PSF is making Python available to Licensee on an \"AS IS\"
 407 ;; basis.  PSF MAKES NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR
 408 ;; IMPLIED.  BY WAY OF EXAMPLE, BUT NOT LIMITATION, PSF MAKES NO AND
 409 ;; DISCLAIMS ANY REPRESENTATION OR WARRANTY OF MERCHANTABILITY OR FITNESS
 410 ;; FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF PYTHON WILL NOT
 411 ;; INFRINGE ANY THIRD PARTY RIGHTS.
 412 ;;
 413 ;; 5. PSF SHALL NOT BE LIABLE TO LICENSEE OR ANY OTHER USERS OF PYTHON
 414 ;; FOR ANY INCIDENTAL, SPECIAL, OR CONSEQUENTIAL DAMAGES OR LOSS AS A
 415 ;; RESULT OF MODIFYING, DISTRIBUTING, OR OTHERWISE USING PYTHON, OR
 416 ;; ANY DERIVATIVE THEREOF, EVEN IF ADVISED OF THE POSSIBILITY THEREOF.
 417 ;;
 418 ;; 6. This License Agreement will automatically terminate upon a
 419 ;; material breach of its terms and conditions.
 420 ;;
 421 ;; 7. Nothing in this License Agreement shall be deemed to create any
 422 ;; relationship of agency, partnership, or joint venture between PSF
 423 ;; and Licensee.  This License Agreement does not grant permission to
 424 ;; use PSF trademarks or trade name in a trademark sense to endorse or
 425 ;; promote products or services of Licensee, or any third party.
 426 ;;
 427 ;; 8. By copying, installing or otherwise using Python, Licensee
 428 ;; agrees to be bound by the terms and conditions of this License
 429 ;; Agreement.")
 430
 431 (defvar wisent-make-parsers--ecmascript-license
 432   "\n;; It is derived from the grammar in the ECMAScript Language
 433 ;; Specification published at
 434 ;;
 435 ;; http://www.ecma-international.org/publications/standards/Ecma-262.htm
 436 ;;
 437 ;; and redistributed under the following license:
 438 ;;
 439 ;; Redistribution and use in source and binary forms, with or without
 440 ;; modification, are permitted provided that the following conditions
 441 ;; are met:
 442 ;;
 443 ;; 1. Redistributions of source code must retain the above copyright
 444 ;; notice, this list of conditions and the following disclaimer.
 445 ;;
 446 ;; 2. Redistributions in binary form must reproduce the above
 447 ;; copyright notice, this list of conditions and the following
 448 ;; disclaimer in the documentation and/or other materials provided
 449 ;; with the distribution.
 450 ;;
 451 ;; 3. Neither the name of the authors nor Ecma International may be
 452 ;; used to endorse or promote products derived from this software
 453 ;; without specific prior written permission.  THIS SOFTWARE IS
 454 ;; PROVIDED BY THE ECMA INTERNATIONAL \"AS IS\" AND ANY EXPRESS OR
 455 ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 456 ;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 457 ;; ARE DISCLAIMED. IN NO EVENT SHALL ECMA INTERNATIONAL BE LIABLE FOR
 458 ;; ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
 459 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
 460 ;; OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
 461 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
 462 ;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 463 ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
 464 ;; USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
 465 ;; DAMAGE.")
 466
 467 (defvar wisent-make-parsers--parser-file-name
 468   `(("semantic-grammar-wy.el"
 469      "semantic/grammar-wy")
 470     ("srecode-template-wy.el"
 471      "srecode/srt-wy")
 472     ("wisent-javascript-jv-wy.el"
 473      "semantic/wisent/js-wy"
 474      "Copyright (C) 1998-2011 Ecma International"
 475      ,wisent-make-parsers--ecmascript-license)
 476     ("wisent-java-tags-wy.el"
 477      "semantic/wisent/javat-wy")
 478     ("wisent-python-wy.el"
 479      "semantic/wisent/python-wy"
 480      "Copyright (C) 2001-2010 Python Software Foundation"
 481      ,wisent-make-parsers--python-license)))
 482
 483 (defun wisent-make-parsers ()
 484   "Generate Emacs' built-in Wisent-based parser files."
 485   (semantic-mode 1)
 486   ;; Loop through each .wy file in current directory, and run
 487   ;; `semantic-grammar-batch-build-one-package' to build the grammar.
 488   (dolist (f (directory-files default-directory nil ".wy$"))
 489     (let ((packagename
 490            (condition-case err
 491                (with-current-buffer (find-file-noselect f)
 492                  (semantic-grammar-create-package))
 493              (error (message "%s" (error-message-string err)) nil)))
 494           output-data)
 495       (when (setq output-data (assoc packagename wisent-make-parsers--parser-file-name))
 496         (let ((require-name         (nth 1 output-data))
 497               (additional-copyright (nth 2 output-data))
 498               (additional-license   (nth 3 output-data))
 499               copyright-end)
 500           ;; Touch up the generated parsers for Emacs integration.
 501           (with-temp-buffer
 502             (insert-file-contents packagename)
 503             (setq buffer-file-name (expand-file-name packagename))
 504             ;; Fix copyright header:
 505             (goto-char (point-min))
 506             (when additional-copyright
 507               (re-search-forward "Copyright (C).*$")
 508               (insert "\n;; " additional-copyright))
 509             (re-search-forward "^;; Author:")
 510             (setq copyright-end (match-beginning 0))
 511             (re-search-forward "^;;; Code:\n")
 512             (delete-region copyright-end (match-end 0))
 513             (goto-char copyright-end)
 514             (insert wisent-make-parsers--emacs-license)
 515             (insert "\n\n;;; Commentary:
 516 ;;
 517 ;; This file was generated from etc/grammars/"
 518                         f ".")
 519             (when additional-license
 520               (insert "\n" additional-license))
 521             (insert "\n\n;;; Code:\n
 522 \(require 'semantic/lex)\n")
 523             (goto-char (point-min))
 524             (delete-region (point-min) (line-end-position))
 525             (insert ";;; " require-name
 526                     ".el --- Generated parser support file")
 527             (delete-trailing-whitespace)
 528             (re-search-forward ";;\n(require 'semantic-lex)\n")
 529             (delete-region (match-beginning 0) (match-end 0))
 530             ;; Fix footer:
 531             (goto-char (point-max))
 532             (re-search-backward "^(provide")
 533             (delete-region (match-beginning 0) (point-max))
 534             (goto-char (point-max))
 535             (insert "(provide '" require-name ")\n\n")
 536             (insert ";;; " require-name ".el ends here\n")
 537             (let ((make-backup-files nil))
 538               (save-buffer))))))))
 539
 540
 541
 542 ;;; wisent-grammar.el ends here