Mercurial > emacs
view lisp/progmodes/ebnf-ebx.el @ 110523:a5ad4f188e19
Synch Semantic to CEDET 1.0.
Move CEDET ChangeLog entries to new file lisp/cedet/ChangeLog.
* semantic.el (semantic-version): Update to 2.0.
(semantic-mode-map): Add "," and "m" bindings.
(navigate-menu): Update.
* semantic/symref.el (semantic-symref-calculate-rootdir):
New function.
(semantic-symref-detect-symref-tool): Use it.
* semantic/symref/grep.el (semantic-symref-grep-shell): New var.
(semantic-symref-perform-search): Use it. Calculate root dir with
semantic-symref-calculate-rootdir.
(semantic-symref-derive-find-filepatterns): Improve error message.
* semantic/symref/list.el
(semantic-symref-results-mode-map): New bindings.
(semantic-symref-auto-expand-results): New option.
(semantic-symref-results-dump): Obey auto-expand.
(semantic-symref-list-expand-all, semantic-symref-regexp)
(semantic-symref-list-contract-all)
(semantic-symref-list-map-open-hits)
(semantic-symref-list-update-open-hits)
(semantic-symref-list-create-macro-on-open-hit)
(semantic-symref-list-call-macro-on-open-hits): New functions.
(semantic-symref-list-menu-entries)
(semantic-symref-list-menu): New vars.
(semantic-symref-list-map-open-hits): Move cursor to beginning of
match before calling the mapped function.
* semantic/doc.el
(semantic-documentation-comment-preceeding-tag): Do nothing if the
mode doesn't provide comment-start-skip.
* semantic/scope.el
(semantic-analyze-scope-nested-tags-default): Strip duplicates.
(semantic-analyze-scoped-inherited-tag-map): Take the tag we are
looking for as part of the scoped tags list.
* semantic/html.el (semantic-default-html-setup): Add
senator-step-at-tag-classes.
* semantic/decorate/include.el
(semantic-decoration-on-unknown-includes): Change light bgcolor.
(semantic-decoration-on-includes-highlight-default): Check that
the include tag has a postion.
* semantic/complete.el (semantic-collector-local-members):
(semantic-complete-read-tag-local-members)
(semantic-complete-jump-local-members): New class and functions.
(semantic-complete-self-insert): Save excursion before completing.
* semantic/analyze/complete.el
(semantic-analyze-possible-completions-default): If no completions
are found, return the raw by-name-only completion list. Add FLAGS
arguments. Add support for 'no-tc (type constraint) and
'no-unique, or no stripping duplicates.
(semantic-analyze-possible-completions-default): Add FLAGS arg.
* semantic/util-modes.el
(semantic-stickyfunc-show-only-functions-p): New option.
(semantic-stickyfunc-fetch-stickyline): Don't show stickytext for
the very first line in a buffer.
* semantic/util.el (semantic-hack-search)
(semantic-recursive-find-nonterminal-by-name)
(semantic-current-tag-interactive): Deleted.
(semantic-describe-buffer): Fix expand-nonterminal. Add
lex-syntax-mods, type relation separator char, and command
separation char.
(semantic-sanity-check): Only message if called interactively.
* semantic/tag.el (semantic-tag-deep-copy-one-tag): Copy the
:filename property and the tag position.
* semantic/lex-spp.el (semantic-lex-spp-lex-text-string):
Add recursion limit.
* semantic/imenu.el (semantic-imenu-bucketize-type-members):
Make this buffer local, not the obsoleted variable.
* semantic/idle.el: Add breadcrumbs support.
(semantic-idle-summary-current-symbol-info-default)
(semantic-idle-tag-highlight)
(semantic-idle-completion-list-default): Use
semanticdb-without-unloaded-file-searches for speed, and to
conform to the controls that specify if the idle timer is supposed
to be parsing unparsed includes.
(semantic-idle-symbol-highlight-face)
(semantic-idle-symbol-maybe-highlight): Rename from *-summary-*.
Callers changed.
(semantic-idle-work-parse-neighboring-files-flag): Default to nil.
(semantic-idle-work-update-headers-flag): New var.
(semantic-idle-work-for-one-buffer): Use it.
(semantic-idle-local-symbol-highlight): Rename from
semantic-idle-tag-highlight.
(semantic-idle-truncate-long-summaries): New option.
* semantic/ia.el (semantic-ia-cache)
(semantic-ia-get-completions): Deleted. Callers changed.
(semantic-ia-show-variants): New command.
(semantic-ia-show-doc): If doc is empty, don't make a temp buffer.
(semantic-ia-show-summary): If there isn't anything to show, say so.
* semantic/grammar.el (semantic-grammar-create-package):
Save the buffer even in batch mode.
* semantic/fw.el
(semanticdb-without-unloaded-file-searches): New macro.
* semantic/dep.el (semantic-dependency-find-file-on-path):
Fix case dereferencing ede-object when it is a list.
* semantic/db-typecache.el (semanticdb-expand-nested-tag)
(semanticdb-typecache-faux-namespace): New functions.
(semanticdb-typecache-file-tags)
(semanticdb-typecache-merge-streams): Use them.
(semanticdb-typecache-file-tags): When deriving tags from a file,
give the mode a chance to monkey with the tag copy.
(semanticdb-typecache-find-default): Wrap find in save-excursion.
(semanticdb-typecache-find-by-name-helper): Merge found names down.
* semantic/db-global.el
(semanticdb-enable-gnu-global-in-buffer): Don't show messages if
GNU Global is not available and we don't want to throw an error.
* semantic/db-find.el (semanticdb-find-result-nth-in-buffer):
When trying to normalize the tag to a buffer, don't error if
set-buffer method doesn't exist.
* semantic/db-file.el (semanticdb-save-db): Simplify msg.
* semantic/db.el (semanticdb-refresh-table): If forcing a
refresh on a file not in a buffer, use semantic-find-file-noselect
and delete the buffer after use.
(semanticdb-current-database-list): When calculating root via
hooks, force it through true-filename and skip the list of
possible roots.
* semantic/ctxt.el (semantic-ctxt-imported-packages): New.
* semantic/analyze/debug.el
(semantic-analyzer-debug-insert-tag): Reset standard output to
current buffer.
(semantic-analyzer-debug-global-symbol)
(semantic-analyzer-debug-missing-innertype): Change "prefix" to
"symbol" in messages.
* semantic/analyze/refs.el: (semantic-analyze-refs-impl)
(semantic-analyze-refs-proto): When calculating value, make sure
the found tag is 'similar' to the originating tag.
(semantic--analyze-refs-find-tags-with-parent): Attempt to
identify matches via imported symbols of parents.
(semantic--analyze-refs-full-lookup-with-parents): Do a deep
search during the brute search.
* semantic/analyze.el
(semantic-analyze-find-tag-sequence-default): Be robust to
calculated scopes being nil.
* semantic/bovine/c.el (semantic-c-describe-environment): Add
project macro symbol array.
(semantic-c-parse-lexical-token): Add recursion limit.
(semantic-ctxt-imported-packages, semanticdb-expand-nested-tag):
New overrides.
(semantic-expand-c-tag-namelist): Split a full type from a typedef
out to its own tag.
(semantic-expand-c-tag-namelist): Do not split out a typedef'd
inline type if it is an anonymous type.
(semantic-c-reconstitute-token): Use the optional initializers as
a clue that some function is probably a constructor. When
defining the type of these constructors, split the parent name,
and use only the class part, if applicable.
* semantic/bovine/c-by.el:
* semantic/wisent/python-wy.el: Regenerate.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Sat, 18 Sep 2010 22:49:54 -0400 |
parents | 1d1d5d9bd884 |
children | 280c8ae2476d 376148b31b5e |
line wrap: on
line source
;;; ebnf-ebx.el --- parser for EBNF used to specify XML (EBNFX) ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 ;; Free Software Foundation, Inc. ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Keywords: wp, ebnf, PostScript ;; Version: 1.2 ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;;; Commentary: ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; ;; This is part of ebnf2ps package. ;; ;; This package defines a parser for EBNF used to specify XML (EBNFX). ;; ;; See ebnf2ps.el for documentation. ;; ;; ;; EBNFX Syntax ;; ------------ ;; ;; See the URL: ;; `http://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation' ;; (Extensible Markup Language (XML) 1.0 (Third Edition)) ;; ;; ;; rule ::= symbol '::=' expression ;; /* rules are separated by at least one blank line. */ ;; ;; expression ::= concatenation ('|' concatenation)* ;; ;; concatenation ::= exception* ;; ;; exception ::= term ('-' term)? ;; ;; term ::= factor ('*' | '+' | '?')? ;; ;; factor ::= hex-char+ ;; | '[' '^'? ( char ( '-' char )? )+ ']' ;; | '"' 'string' '"' ;; | "'" "string" "'" ;; | '(' expression ')' ;; | symbol ;; ;; symbol ::= 'upper or lower case letter' ;; ('upper or lower case letter' | '-' | '_')* ;; /* upper and lower 8-bit accentuated characters are included */ ;; ;; hex-char ::= '#x' [0-9A-Fa-f]+ ;; ;; char ::= hex-char | 'any character except control characters' ;; /* 8-bit accentuated characters are included */ ;; ;; any-char ::= char | 'newline' | 'tab' ;; ;; ignore ::= '[' ('wfc' | 'WFC' | 'vc' | 'VC') ':' ( any-char - ']' )* ']' ;; ;; comment ::= '/*' ( any-char - '*/' ) '*/' ;; ;; ;; Below is the Notation section extracted from the URL cited above. ;; ;; 6 Notation ;; ;; The formal grammar of XML is given in this specification using a simple ;; Extended Backus-Naur Form (EBNF) notation. Each rule in the grammar defines ;; one symbol, in the form ;; ;; symbol ::= expression ;; ;; Symbols are written with an initial capital letter if they are the start ;; symbol of a regular language, otherwise with an initial lowercase letter. ;; Literal strings are quoted. ;; ;; Within the expression on the right-hand side of a rule, the following ;; expressions are used to match strings of one or more characters: ;; ;; #xN ;; ;; where N is a hexadecimal integer, the expression matches the character ;; whose number (code point) in ISO/IEC 10646 is N. The number of leading ;; zeros in the #xN form is insignificant. ;; ;; [a-zA-Z], [#xN-#xN] ;; ;; matches any Char with a value in the range(s) indicated (inclusive). ;; ;; [abc], [#xN#xN#xN] ;; ;; matches any Char with a value among the characters enumerated. ;; Enumerations and ranges can be mixed in one set of brackets. ;; ;; [^a-z], [^#xN-#xN] ;; ;; matches any Char with a value outside the range indicated. ;; ;; [^abc], [^#xN#xN#xN] ;; ;; matches any Char with a value not among the characters given. ;; Enumerations and ranges of forbidden values can be mixed in one set of ;; brackets. ;; ;; "string" ;; ;; matches a literal string matching that given inside the double quotes. ;; ;; 'string' ;; ;; matches a literal string matching that given inside the single quotes. ;; ;; These symbols may be combined to match more complex patterns as follows, ;; where A and B represent simple expressions: ;; ;; (expression) ;; ;; expression is treated as a unit and may be combined as described in this ;; list. ;; ;; A? ;; ;; matches A or nothing; optional A. ;; ;; A B ;; ;; matches A followed by B. This operator has higher precedence than ;; alternation; thus A B | C D is identical to (A B) | (C D). ;; ;; A | B ;; ;; matches A or B. ;; ;; A - B ;; ;; matches any string that matches A but does not match B. ;; ;; A+ ;; ;; matches one or more occurrences of A. Concatenation has higher ;; precedence than alternation; thus A+ | B+ is identical to (A+) | (B+). ;; ;; A* ;; ;; matches zero or more occurrences of A. Concatenation has higher ;; precedence than alternation; thus A* | B* is identical to (A*) | (B*). ;; ;; Other notations used in the productions are: ;; ;; /* ... */ ;; ;; comment. ;; ;; [ wfc: ... ] ;; ;; well-formedness constraint; this identifies by name a constraint on ;; well-formed documents associated with a production. ;; ;; [ vc: ... ] ;; ;; validity constraint; this identifies by name a constraint on valid ;; documents associated with a production. ;; ;; ;; Differences Between EBNFX And ebnf2ps EBNFX ;; ------------------------------------------- ;; ;; Besides the characters that EBNFX accepts, ebnf2ps EBNFX accepts also the ;; underscore (_) and minus (-) for rule name and european 8-bit accentuated ;; characters (from \240 to \377) for rule name, string and comment. Also ;; rule name can start with upper case letter. ;; ;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Code: (require 'ebnf-otz) (defvar ebnf-ebx-lex nil "Value returned by `ebnf-ebx-lex' function.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Syntactic analyzer ;;; rulelist ::= rule+ (defun ebnf-ebx-parser (start) "EBNFX parser." (let ((total (+ (- ebnf-limit start) 1)) (bias (1- start)) (origin (point)) rule-list token rule) (goto-char start) (setq token (ebnf-ebx-lex)) (and (eq token 'end-of-input) (error "Invalid EBNFX file format")) (and (eq token 'end-of-rule) (setq token (ebnf-ebx-lex))) (while (not (eq token 'end-of-input)) (ebnf-message-float "Parsing...%s%%" (/ (* (- (point) bias) 100.0) total)) (setq token (ebnf-ebx-rule token) rule (cdr token) token (car token)) (or (ebnf-add-empty-rule-list rule) (setq rule-list (cons rule rule-list)))) (goto-char origin) rule-list)) ;;; rule ::= symbol '::=' expression (defun ebnf-ebx-rule (token) (let ((name ebnf-ebx-lex) (action ebnf-action) elements) (setq ebnf-action nil) (or (eq token 'non-terminal) (error "Invalid rule name")) (setq token (ebnf-ebx-lex)) (or (eq token 'production) (error "Invalid rule: missing `::='")) (setq elements (ebnf-ebx-expression)) (or (memq (car elements) '(end-of-rule end-of-input)) (error "Invalid rule: there is no end of rule")) (setq elements (cdr elements)) (ebnf-eps-add-production name) (cons (ebnf-ebx-lex) (ebnf-make-production name elements action)))) ;; expression ::= concatenation ('|' concatenation)* (defun ebnf-ebx-expression () (let (body concatenation) (while (eq (car (setq concatenation (ebnf-ebx-concatenation (ebnf-ebx-lex)))) 'alternative) (setq body (cons (cdr concatenation) body))) (ebnf-token-alternative body concatenation))) ;; concatenation ::= exception* (defun ebnf-ebx-concatenation (token) (let ((term (ebnf-ebx-exception token)) seq) (or (setq token (car term) term (cdr term)) (error "Empty element")) (setq seq (cons term seq)) (while (setq term (ebnf-ebx-exception token) token (car term) term (cdr term)) (setq seq (cons term seq))) (cons token (ebnf-token-sequence seq)))) ;;; exception ::= term ('-' term)? (defun ebnf-ebx-exception (token) (let ((term (ebnf-ebx-term token))) (if (eq (car term) 'exception) (let ((except (ebnf-ebx-term (ebnf-ebx-lex)))) (cons (car except) (ebnf-make-except (cdr term) (cdr except)))) term))) ;;; term ::= factor ('*' | '+' | '?')? (defun ebnf-ebx-term (token) (let ((factor (ebnf-ebx-factor token))) (when factor (setq token (ebnf-ebx-lex)) (cond ((eq token 'zero-or-more) (setq factor (ebnf-make-zero-or-more factor) token (ebnf-ebx-lex))) ((eq token 'one-or-more) (setq factor (ebnf-make-one-or-more factor) token (ebnf-ebx-lex))) ((eq token 'optional) (setq factor (ebnf-token-optional factor) token (ebnf-ebx-lex))))) (cons token factor))) ;;; factor ::= hex-char+ ;;; | '[' '^'? ( char ( '-' char )? )+ ']' ;;; | '"' 'string' '"' ;;; | "'" "string" "'" ;;; | '(' expression ')' ;;; | symbol ;;; ;;; symbol ::= 'upper or lower case letter' ;;; ('upper or lower case letter' | '-' | '_')* ;;; /* upper and lower 8-bit accentuated characters are included */ ;;; ;;; hex-char ::= '#x' [0-9A-Fa-f]+ ;;; ;;; char ::= hex-char | 'any character except control characters' ;;; /* 8-bit accentuated characters are included */ ;;; ;;; any-char ::= char | 'newline' | 'tab' (defun ebnf-ebx-factor (token) (cond ;; terminal ((eq token 'terminal) (ebnf-make-terminal ebnf-ebx-lex)) ;; non-terminal ((eq token 'non-terminal) (ebnf-make-non-terminal ebnf-ebx-lex)) ;; group ((eq token 'begin-group) (let ((body (ebnf-ebx-expression))) (or (eq (car body) 'end-group) (error "Missing `)'")) (cdr body))) ;; no element (t nil) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Lexical analyzer (defconst ebnf-ebx-token-table (make-vector 256 'error) "Vector used to map characters to a lexical token.") (defun ebnf-ebx-initialize () "Initialize EBNFX token table." ;; control character & control 8-bit character are set to `error' (let ((char ?\101)) ;; printable character: A-Z (while (< char ?\133) (aset ebnf-ebx-token-table char 'non-terminal) (setq char (1+ char))) ;; printable character: a-z (setq char ?\141) (while (< char ?\173) (aset ebnf-ebx-token-table char 'non-terminal) (setq char (1+ char))) ;; European 8-bit accentuated characters: (setq char ?\240) (while (< char ?\400) (aset ebnf-ebx-token-table char 'non-terminal) (setq char (1+ char))) ;; Override end of line characters: (aset ebnf-ebx-token-table ?\n 'end-of-rule) ; [NL] linefeed (aset ebnf-ebx-token-table ?\r 'end-of-rule) ; [CR] carriage return ;; Override space characters: (aset ebnf-ebx-token-table ?\013 'space) ; [VT] vertical tab (aset ebnf-ebx-token-table ?\t 'space) ; [HT] horizontal tab (aset ebnf-ebx-token-table ?\ 'space) ; [SP] space ;; Override form feed character: (aset ebnf-ebx-token-table ?\f 'form-feed) ; [FF] form feed ;; Override other lexical characters: (aset ebnf-ebx-token-table ?# 'hash) (aset ebnf-ebx-token-table ?\" 'double-quote) (aset ebnf-ebx-token-table ?\' 'single-quote) (aset ebnf-ebx-token-table ?\( 'begin-group) (aset ebnf-ebx-token-table ?\) 'end-group) (aset ebnf-ebx-token-table ?- 'exception) (aset ebnf-ebx-token-table ?: 'colon) (aset ebnf-ebx-token-table ?\[ 'begin-square) (aset ebnf-ebx-token-table ?| 'alternative) (aset ebnf-ebx-token-table ?* 'zero-or-more) (aset ebnf-ebx-token-table ?+ 'one-or-more) (aset ebnf-ebx-token-table ?\? 'optional) ;; Override comment character: (aset ebnf-ebx-token-table ?/ 'comment))) ;; replace the range "\240-\377" (see `ebnf-range-regexp'). (defconst ebnf-ebx-non-terminal-chars (ebnf-range-regexp "-_A-Za-z" ?\240 ?\377)) (defconst ebnf-ebx-non-terminal-letter-chars (ebnf-range-regexp "A-Za-z" ?\240 ?\377)) (defun ebnf-ebx-lex () "Lexical analyzer for EBNFX. Return a lexical token. See documentation for variable `ebnf-ebx-lex'." (if (>= (point) ebnf-limit) 'end-of-input (let (token) ;; skip spaces and comments (while (if (> (following-char) 255) (progn (setq token 'error) nil) (setq token (aref ebnf-ebx-token-table (following-char))) (cond ((eq token 'space) (skip-chars-forward " \013\t" ebnf-limit) (< (point) ebnf-limit)) ((eq token 'comment) (ebnf-ebx-skip-comment)) ((eq token 'form-feed) (forward-char) (setq ebnf-action 'form-feed)) ((eq token 'end-of-rule) (ebnf-ebx-skip-end-of-rule)) ((and (eq token 'begin-square) (let ((case-fold-search t)) (looking-at "\\[\\(wfc\\|vc\\):"))) (ebnf-ebx-skip-constraint)) (t nil) ))) (cond ;; end of input ((>= (point) ebnf-limit) 'end-of-input) ;; error ((eq token 'error) (error "Invalid character")) ;; end of rule ((eq token 'end-of-rule) 'end-of-rule) ;; terminal: #x [0-9A-Fa-f]+ ((eq token 'hash) (setq ebnf-ebx-lex (ebnf-ebx-character)) 'terminal) ;; terminal: "string" ((eq token 'double-quote) (setq ebnf-ebx-lex (ebnf-ebx-string ?\")) 'terminal) ;; terminal: 'string' ((eq token 'single-quote) (setq ebnf-ebx-lex (ebnf-ebx-string ?\')) 'terminal) ;; terminal: [ ^? ( char ( - char )? )+ ] ((eq token 'begin-square) (setq ebnf-ebx-lex (ebnf-ebx-range)) 'terminal) ;; non-terminal: NAME ((eq token 'non-terminal) (setq ebnf-ebx-lex (ebnf-buffer-substring ebnf-ebx-non-terminal-chars)) 'non-terminal) ;; colon: ::= ((eq token 'colon) (or (looking-at "::=") (error "Missing `::=' token")) (forward-char 3) 'production) ;; miscellaneous: (, ), *, +, ?, |, - (t (forward-char) token) )))) ;; replace the range "\177-\237" (see `ebnf-range-regexp'). (defconst ebnf-ebx-constraint-chars (ebnf-range-regexp "^\000-\010\016-\037]" ?\177 ?\237)) (defun ebnf-ebx-skip-constraint () (or (> (skip-chars-forward ebnf-ebx-constraint-chars ebnf-limit) 0) (error "Invalid character")) (or (= (following-char) ?\]) (error "Missing end of constraint `]'")) (forward-char) t) (defun ebnf-ebx-skip-end-of-rule () (let (eor-p) (while (progn ;; end of rule ==> 2 or more consecutive end of lines (setq eor-p (or (> (skip-chars-forward "\r\n" ebnf-limit) 1) eor-p)) ;; skip spaces (skip-chars-forward " \013\t" ebnf-limit) ;; skip comments (and (= (following-char) ?/) (ebnf-ebx-skip-comment)))) (not eor-p))) ;; replace the range "\177-\237" (see `ebnf-range-regexp'). (defconst ebnf-ebx-comment-chars (ebnf-range-regexp "^\000-\010\016-\037\\*" ?\177 ?\237)) (defconst ebnf-ebx-filename-chars (ebnf-range-regexp "^\000-\037\\*" ?\177 ?\237)) (defun ebnf-ebx-skip-comment () (forward-char) (or (= (following-char) ?*) (error "Invalid beginning of comment")) (forward-char) (cond ;; open EPS file ((and ebnf-eps-executing (= (following-char) ?\[)) (ebnf-eps-add-context (ebnf-ebx-eps-filename))) ;; close EPS file ((and ebnf-eps-executing (= (following-char) ?\])) (ebnf-eps-remove-context (ebnf-ebx-eps-filename))) ;; EPS header ((and ebnf-eps-executing (= (following-char) ?H)) (ebnf-eps-header-comment (ebnf-ebx-eps-filename))) ;; EPS footer ((and ebnf-eps-executing (= (following-char) ?F)) (ebnf-eps-footer-comment (ebnf-ebx-eps-filename))) ;; any other action in comment (t (setq ebnf-action (aref ebnf-comment-table (following-char)))) ) (while (progn (skip-chars-forward ebnf-ebx-comment-chars ebnf-limit) (or (= (following-char) ?*) (error "Missing end of comment")) (forward-char) (and (/= (following-char) ?/) (< (point) ebnf-limit)))) ;; check for a valid end of comment (and (>= (point) ebnf-limit) (error "Missing end of comment")) (forward-char) t) (defun ebnf-ebx-eps-filename () (forward-char) (let (fname nchar) (while (progn (setq fname (concat fname (ebnf-buffer-substring ebnf-ebx-filename-chars))) (and (< (point) ebnf-limit) (> (setq nchar (skip-chars-forward "*" ebnf-limit)) 0) (< (point) ebnf-limit) (/= (following-char) ?/))) (setq fname (concat fname (make-string nchar ?*)) nchar nil)) (if (or (not nchar) (= nchar 0)) fname (and (< (point) ebnf-limit) (= (following-char) ?/) (setq nchar (1- nchar))) (concat fname (make-string nchar ?*))))) ;; replace the range "\240-\377" (see `ebnf-range-regexp'). (defconst ebnf-ebx-double-string-chars (ebnf-range-regexp "\t -!#-~" ?\240 ?\377)) (defconst ebnf-ebx-single-string-chars (ebnf-range-regexp "\t -&(-~" ?\240 ?\377)) (defun ebnf-ebx-string (delim) (buffer-substring-no-properties (progn (forward-char) (point)) (progn (skip-chars-forward (if (= delim ?\") ebnf-ebx-double-string-chars ebnf-ebx-single-string-chars) ebnf-limit) (or (= (following-char) delim) (error "Missing string delimiter `%c'" delim)) (prog1 (point) (forward-char))))) (defun ebnf-ebx-character () ;; #x [0-9A-Fa-f]+ (buffer-substring-no-properties (point) (progn (ebnf-ebx-hex-character) (point)))) (defun ebnf-ebx-range () ;; [ ^? ( char ( - char )? )+ ] (buffer-substring-no-properties (point) (progn (forward-char) (and (= (following-char) ?^) (forward-char)) (and (= (following-char) ?-) (forward-char)) (while (progn (ebnf-ebx-any-character) (when (= (following-char) ?-) (forward-char) (ebnf-ebx-any-character)) (and (/= (following-char) ?\]) (< (point) ebnf-limit)))) (and (>= (point) ebnf-limit) (error "Missing end of character range `]'")) (forward-char) (point)))) (defun ebnf-ebx-any-character () (let ((char (following-char))) (cond ((= char ?#) (ebnf-ebx-hex-character t)) ((or (and (<= ?\ char) (<= char ?\")) ; # (and (<= ?$ char) (<= char ?,)) ; - (and (<= ?. char) (<= char ?\\)) ; ] (and (<= ?^ char) (<= char ?~)) (and (<= ?\240 char) (<= char ?\377))) (forward-char)) (t (error "Invalid character `%c'" char))))) (defun ebnf-ebx-hex-character (&optional no-error) ;; #x [0-9A-Fa-f]+ (forward-char) (if (/= (following-char) ?x) (or no-error (error "Invalid hexadecimal character")) (forward-char) (or (> (skip-chars-forward "0-9A-Fa-f" ebnf-limit) 0) (error "Invalid hexadecimal character")))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (provide 'ebnf-ebx) ;; arch-tag: bfe2f95b-66bc-4dc6-8b7e-b7831e68f5fb ;;; ebnf-ebx.el ends here