lisp/cedet/semantic/wisent/grammar.el

   1 ;;; semantic/wisent/grammar.el --- Wisent's input grammar mode
   2
   3 ;; Copyright (C) 2002-2014 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     (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.
 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 ;;;###autoload
 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 (defvar-mode-local wisent-grammar-mode semantic-grammar-macros
 335   '(
 336     (ASSOC          . semantic-grammar-ASSOC)
 337     (EXPAND         . wisent-grammar-EXPAND)
 338     (EXPANDFULL     . wisent-grammar-EXPANDFULL)
 339     (TAG            . wisent-grammar-TAG)
 340     (VARIABLE-TAG   . wisent-grammar-VARIABLE-TAG)
 341     (FUNCTION-TAG   . wisent-grammar-FUNCTION-TAG)
 342     (TYPE-TAG       . wisent-grammar-TYPE-TAG)
 343     (INCLUDE-TAG    . wisent-grammar-INCLUDE-TAG)
 344     (PACKAGE-TAG    . wisent-grammar-PACKAGE-TAG)
 345     (EXPANDTAG      . wisent-grammar-EXPANDTAG)
 346     (CODE-TAG       . wisent-grammar-CODE-TAG)
 347     (ALIAS-TAG      . wisent-grammar-ALIAS-TAG)
 348     (AST-ADD        . wisent-grammar-AST-ADD)
 349     (AST-PUT        . wisent-grammar-AST-PUT)
 350     (AST-GET        . wisent-grammar-AST-GET)
 351     (AST-GET1       . wisent-grammar-AST-GET1)
 352     (AST-GET-STRING . wisent-grammar-AST-GET-STRING)
 353     (AST-MERGE      . wisent-grammar-AST-MERGE)
 354     (SKIP-BLOCK     . wisent-grammar-SKIP-BLOCK)
 355     (SKIP-TOKEN     . wisent-grammar-SKIP-TOKEN)
 356     )
 357   "Semantic grammar macros used in wisent grammars.")
 358
 359 (defvar wisent-make-parsers--emacs-license
 360   ";; This file is part of GNU Emacs.
 361
 362 ;; GNU Emacs is free software: you can redistribute it and/or modify
 363 ;; it under the terms of the GNU General Public License as published by
 364 ;; the Free Software Foundation, either version 3 of the License, or
 365 ;; (at your option) any later version.
 366
 367 ;; GNU Emacs is distributed in the hope that it will be useful,
 368 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 369 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 370 ;; GNU General Public License for more details.
 371
 372 ;; You should have received a copy of the GNU General Public License
 373 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.")
 374
 375 (defvar wisent-make-parsers--python-license
 376   ";; It is derived in part from the Python grammar, used under the
 377 ;; following license:
 378 ;;
 379 ;; PYTHON SOFTWARE FOUNDATION LICENSE VERSION 2
 380 ;; --------------------------------------------
 381 ;; 1. This LICENSE AGREEMENT is between the Python Software Foundation
 382 ;; (\"PSF\"), and the Individual or Organization (\"Licensee\") accessing
 383 ;; and otherwise using this software (\"Python\") in source or binary
 384 ;; form and its associated documentation.
 385 ;;
 386 ;; 2. Subject to the terms and conditions of this License Agreement,
 387 ;; PSF hereby grants Licensee a nonexclusive, royalty-free, world-wide
 388 ;; license to reproduce, analyze, test, perform and/or display
 389 ;; publicly, prepare derivative works, distribute, and otherwise use
 390 ;; Python alone or in any derivative version, provided, however, that
 391 ;; PSF's License Agreement and PSF's notice of copyright, i.e.,
 392 ;; \"Copyright (c) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
 393 ;; 2009, 2010 Python Software Foundation; All Rights Reserved\" are
 394 ;; retained in Python alone or in any derivative version prepared by
 395 ;; Licensee.
 396 ;;
 397 ;; 3. In the event Licensee prepares a derivative work that is based
 398 ;; on or incorporates Python or any part thereof, and wants to make
 399 ;; the derivative work available to others as provided herein, then
 400 ;; Licensee hereby agrees to include in any such work a brief summary
 401 ;; of the changes made to Python.
 402 ;;
 403 ;; 4. PSF is making Python available to Licensee on an \"AS IS\"
 404 ;; basis.  PSF MAKES NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR
 405 ;; IMPLIED.  BY WAY OF EXAMPLE, BUT NOT LIMITATION, PSF MAKES NO AND
 406 ;; DISCLAIMS ANY REPRESENTATION OR WARRANTY OF MERCHANTABILITY OR FITNESS
 407 ;; FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF PYTHON WILL NOT
 408 ;; INFRINGE ANY THIRD PARTY RIGHTS.
 409 ;;
 410 ;; 5. PSF SHALL NOT BE LIABLE TO LICENSEE OR ANY OTHER USERS OF PYTHON
 411 ;; FOR ANY INCIDENTAL, SPECIAL, OR CONSEQUENTIAL DAMAGES OR LOSS AS A
 412 ;; RESULT OF MODIFYING, DISTRIBUTING, OR OTHERWISE USING PYTHON, OR
 413 ;; ANY DERIVATIVE THEREOF, EVEN IF ADVISED OF THE POSSIBILITY THEREOF.
 414 ;;
 415 ;; 6. This License Agreement will automatically terminate upon a
 416 ;; material breach of its terms and conditions.
 417 ;;
 418 ;; 7. Nothing in this License Agreement shall be deemed to create any
 419 ;; relationship of agency, partnership, or joint venture between PSF
 420 ;; and Licensee.  This License Agreement does not grant permission to
 421 ;; use PSF trademarks or trade name in a trademark sense to endorse or
 422 ;; promote products or services of Licensee, or any third party.
 423 ;;
 424 ;; 8. By copying, installing or otherwise using Python, Licensee
 425 ;; agrees to be bound by the terms and conditions of this License
 426 ;; Agreement.")
 427
 428 (defvar wisent-make-parsers--ecmascript-license
 429   "\n;; It is derived from the grammar in the ECMAScript Language
 430 ;; Specification published at
 431 ;;
 432 ;; http://www.ecma-international.org/publications/standards/Ecma-262.htm
 433 ;;
 434 ;; and redistributed under the following license:
 435 ;;
 436 ;; Redistribution and use in source and binary forms, with or without
 437 ;; modification, are permitted provided that the following conditions
 438 ;; are met:
 439 ;;
 440 ;; 1. Redistributions of source code must retain the above copyright
 441 ;; notice, this list of conditions and the following disclaimer.
 442 ;;
 443 ;; 2. Redistributions in binary form must reproduce the above
 444 ;; copyright notice, this list of conditions and the following
 445 ;; disclaimer in the documentation and/or other materials provided
 446 ;; with the distribution.
 447 ;;
 448 ;; 3. Neither the name of the authors nor Ecma International may be
 449 ;; used to endorse or promote products derived from this software
 450 ;; without specific prior written permission.  THIS SOFTWARE IS
 451 ;; PROVIDED BY THE ECMA INTERNATIONAL \"AS IS\" AND ANY EXPRESS OR
 452 ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 453 ;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 454 ;; ARE DISCLAIMED. IN NO EVENT SHALL ECMA INTERNATIONAL BE LIABLE FOR
 455 ;; ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
 456 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
 457 ;; OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
 458 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
 459 ;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 460 ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
 461 ;; USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
 462 ;; DAMAGE.")
 463
 464 (defvar wisent-make-parsers--parser-file-name
 465   `(("semantic/grammar-wy.el")
 466     ("srecode/srt-wy.el")
 467     ("semantic/wisent/js-wy.el"
 468      "Copyright (C) 1998-2011 Ecma International."
 469      ,wisent-make-parsers--ecmascript-license)
 470     ("semantic/wisent/javat-wy.el")
 471     ("semantic/wisent/python-wy.el"
 472      "Copyright (c) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
 473 \;; 2009, 2010 Python Software Foundation; All Rights Reserved"
 474      ,wisent-make-parsers--python-license)))
 475
 476 ;; Cf bovine--make-parser-1.
 477 (defun wisent--make-parser-1 (infile &optional outdir)
 478   (if outdir (setq outdir (file-name-directory (expand-file-name outdir))))
 479   (let ((packagename
 480          ;; This is with-demoted-errors.
 481          (condition-case err
 482              (with-current-buffer (find-file-noselect infile)
 483                (if outdir (setq default-directory outdir))
 484                (semantic-grammar-create-package nil t))
 485            (error (message "%s" (error-message-string err)) nil)))
 486         output-data)
 487     (when (setq output-data (assoc packagename wisent-make-parsers--parser-file-name))
 488       (let ((additional-copyright (nth 1 output-data))
 489             (additional-license   (nth 2 output-data))
 490             (filename (expand-file-name
 491                        (progn (string-match ".*/\\(.*\\)" packagename)
 492                               (match-string 1 packagename))
 493                        outdir))
 494             copyright-end)
 495         ;; Touch up the generated parsers for Emacs integration.
 496         (with-temp-file filename
 497           (insert-file-contents filename)
 498           ;; Fix copyright header:
 499           (goto-char (point-min))
 500           (when additional-copyright
 501             (re-search-forward "Copyright (C).*$")
 502             (insert "\n;; " additional-copyright))
 503           (re-search-forward "^;; Author:")
 504           (setq copyright-end (match-beginning 0))
 505           (re-search-forward "^;;; Code:\n")
 506           (delete-region copyright-end (match-end 0))
 507           (goto-char copyright-end)
 508           (insert wisent-make-parsers--emacs-license)
 509           (insert "\n\n;;; Commentary:
 510 ;;
 511 ;; This file was generated from admin/grammars/"
 512                   (file-name-nondirectory infile) ".")
 513           (when additional-license
 514             (insert "\n" additional-license))
 515           (insert "\n\n;;; Code:\n")
 516           (goto-char (point-min))
 517           (delete-region (point-min) (line-end-position))
 518           (insert ";;; " packagename
 519                   " --- Generated parser support file")
 520           (re-search-forward ";;; \\(.*\\) ends here")
 521           (replace-match packagename nil nil nil 1)
 522           (delete-trailing-whitespace))))))
 523
 524 (defun wisent-make-parsers ()
 525   "Generate Emacs' built-in Wisent-based parser files."
 526   (interactive)
 527   (semantic-mode 1)
 528   ;; Loop through each .wy file in current directory, and run
 529   ;; `semantic-grammar-batch-build-one-package' to build the grammar.
 530   (dolist (f (directory-files default-directory nil "\\.wy\\'"))
 531     (wisent--make-parser-1 f)))
 532
 533
 534 (defun wisent-batch-make-parser (&optional infile outdir)
 535   "Generate a Wisent parser from input INFILE, writing to OUTDIR.
 536 This is mainly intended for use in batch mode:
 537
 538 emacs -batch -l semantic/wisent/grammar -f wisent-make-parser-batch \\
 539    [-dir output-dir | -o output-file] file.by
 540
 541 If -o is supplied, only the directory part is used."
 542   (semantic-mode 1)
 543   (when (and noninteractive (not infile))
 544     (let (arg)
 545       (while command-line-args-left
 546         (setq arg (pop command-line-args-left))
 547         (cond ((string-equal arg "-dir")
 548                (setq outdir (pop command-line-args-left)))
 549               ((string-equal arg "-o")
 550                (setq outdir (file-name-directory (pop command-line-args-left))))
 551               (t (setq infile arg))))))
 552   (or infile (error "No input file specified"))
 553   (or (file-readable-p infile)
 554       (error "Input file `%s' not readable" infile))
 555   (wisent--make-parser-1 infile outdir))
 556
 557
 558 (provide 'semantic/wisent/grammar)
 559
 560 ;; Local variables:
 561 ;; generated-autoload-load-name: "semantic/wisent/grammar"
 562 ;; End:
 563
 564 ;;; semantic/wisent/grammar.el ends here