* Backus Naur
@ 2010-10-02 11:09 A. Soare
2010-10-04 2:03 ` Richard Stallman
0 siblings, 1 reply; 3+ messages in thread
From: A. Soare @ 2010-10-02 11:09 UTC (permalink / raw)
To: Emacs Dev [emacs-devel]
[-- Attachment #1: Type: text/plain, Size: 529 bytes --]
I wrote for myself a backus naur mode, that I use for the grammar of C language.
I attach here the code, and the grammar of C
Emacs has already some major modes for working with extended bnf, which is standardized. This is not the case for my implementation, that I wrote only for my own use.
Alin
____________________________________________________
Découvrez les nouveaux modèles de voitures présentés au Mondial de l’Automobile à Paris : http://actu.voila.fr/evenementiel/salon-auto-paris-2010/
[-- Attachment #2: test-grammar --]
[-- Type: application/octet-stream, Size: 12131 bytes --]
% * C 99 grammar *
% ****************
decimal-floating-constant:
fractional-constant [ exponent-part ] [ floating-suffix ]
| digit-sequence exponent-part [ floating-suffix ]
token:
keyword [opt-test]
identifier
constant
string-literal
| punctuator
preprocessing-token:
header-name
| identifier
| pp-number
| character-constant
| string-literal
| punctuator
% each non-white-space character that cannot be one of the above
keyword:
@auto | @enum | @restrict | @unsigned
| @break | @extern | @Return | @void
| @case | @float | @short | @volatile
| @char | @for | @signed | @while
| @const | @goto | @sizeof | @_Bool
| @continue | @if | @static | @_Complex
| @default | @inline | @struct | @_Imaginary
| @do | @int | @switch
| @double | @long | @typedef
| @else | @register | @union
% IDENTIFIER: An identifier can denote an object; a function; a tag
% or a member of a structure, union, or enumeration; a typedef name;
% a label name; a macro name; or a macro parameter.
identifier:
identifier-nondigit
| identifier
identifier-nondigit
| identifier digit
identifier-nondigit:
nondigit
| universal-character-name
% other implementation-defined characters
nondigit:
@_ | @a | @b | @c | @d | @e | @f | @g | @h
| @i | @j | @k | @l | @m | @n | @o | @p | @q
| @r | @s | @t | @u | @v | @w | @x | @y | @z
| @A | @B | @C | @D | @E | @F | @G | @H | @I
| @J | @K | @L | @M | @N | @O | @P | @Q | @R
| @S | @T | @U | @V | @W | @X | @Y | @Z
digit:
@0 | @1 | @2 | @3 | @4 | @5 | @6 | @7 | @8 | @9
universal-character-name:
@\u hex-quad
| @\U hex-quad hex-quad
hex-quad:
hexadecimal-digit hexadecimal-digit
| hexadecimal-digit hexadecimal-digit
constant:
integer-constant
| floating-constant
| enumeration-constant
| character-constant
integer-constant:
decimal-constant [ integer-suffix ]
| octal-constant [ integer-suffix ]
| hexadecimal-constant [ integer-suffix ]
decimal-constant:
nonzero-digit
| decimal-constant digit
octal-constant:
@0
| octal-constant octal-digit
hexadecimal-constant:
hexadecimal-prefix hexadecimal-digit
| hexadecimal-constant hexadecimal-digit
hexadecimal-prefix:
@0x @0X
nonzero-digit:
@1 @2 @3 @4 @5 @6 @7 @8 @9
octal-digit:
@0 @1 @2 @3 @4 @5 @6 @7
hexadecimal-digit:
@0 @1 @2 @3 @4 @5 @6 @7 @8 @9
| @a @b @c @d @e @f
| @A @B @C @D @E @F
integer-suffix:
unsigned-suffix [ long-suffix ]
| unsigned-suffix long-long-suffix
| long-suffix [ unsigned-suffix ]
| long-long-suffix [ unsigned-suffix ]
unsigned-suffix:
@u @U
long-suffix:
@l @L
long-long-suffix:
@ll @LL
floating-constant:
decimal-floating-constant
| hexadecimal-floating-constant
decimal-floating-constant:
fractional-constant [ exponent-part ] [ floating-suffix ]
| digit-sequence exponent-part [ floating-suffix ]
hexadecimal-floating-constant:
hexadecimal-prefix hexadecimal-fractional-constant
| binary-exponent-part [ floating-suffix ]
| hexadecimal-prefix hexadecimal-digit-sequence
| binary-exponent-part [ floating-suffix ]
fractional-constant:
[ digit-sequence ] @. digit-sequence
| digit-sequence @.
exponent-part:
@e [ sign ] digit-sequence
| @E [ sign ] digit-sequence
sign:
@+ @-
digit-sequence:
digit
| digit-sequence digit
hexadecimal-fractional-constant:
[ hexadecimal-digit-sequence ] @.
| hexadecimal-digit-sequence
| hexadecimal-digit-sequence @.
binary-exponent-part:
@p [ sign ] digit-sequence
| @P [ sign ] digit-sequence
hexadecimal-digit-sequence:
hexadecimal-digit
| hexadecimal-digit-sequence hexadecimal-digit
floating-suffix:
@f @l @F @L
enumeration-constant:
identifier
character-constant:
@@@ c-char-sequence @@
| @L @@@ c-char-sequence @@
c-char-sequence:
c-char
| c-char-sequence c-char
c-char:
% any member of the source character set except'
% the single-quote ', backslash \, or new-line character
% escape-sequence
escape-sequence:
simple-escape-sequence
| octal-escape-sequence
| hexadecimal-escape-sequence
| universal-character-name
simple-escape-sequence:
@\@ @\" @\? @\\
| @\a @\b @\f @\n @\r @\t @\v
octal-escape-sequence:
@\ octal-digit
| @\ octal-digit octal-digit
| @\ octal-digit octal-digit octal-digit
hexadecimal-escape-sequence:
@\x hexadecimal-digit
hexadecimal-escape-sequence hexadecimal-digit
string-literal:
s-char-sequence:
s-char
| s-char-sequence s-char
s-char:
% any member of the source character set except
% the double-quote ", backslash \, or new-line character
% escape-sequence
punctuator:
@[ @] @( @) @{ @} @. @->
| @++ @-- @& @* @+ @- @~ @!
| @/ @% @<< @>> @< @> @<= @>=
| @== @!= @^ @| @&& @||
| @? @: @; @... @= @*= @/= @%=
| @+= @-= @<<= @>>= @&= @^=
| @|= @, @# @## @<: @:> @<%
| @%> @%: @%: @%:
header-name:
@< h-char-sequence @>
| @" q-char-sequence @"
h-char-sequence:
h-char
| h-char-sequence h-char
h-char:
% any member of the source character set except
% the new-line character and >
q-char-sequence:
q-char
| q-char-sequence q-char
q-char:
% any member of the source character set except
% the new-line character and "
pp-number:
digit
| @. digit
| pp-number digit
| pp-number identifier-nondigit
| pp-number @e sign
| pp-number @E sign
| pp-number @p sign
| pp-number @P sign
| pp-number @.
primary-expression:
identifier
constant
string-literal
@( expression @)
postfix-expression:
primary-expression
postfix-expression @[ expression @]
postfix-expression @( [ argument-expression-list ] @)
postfix-expression @. identifier
postfix-expression @-> identifier
postfix-expression @++
postfix-expression @--
@( type-name @) @{ initializer-list @}
@( type-name @) @{ initializer-list @, @}
argument-expression-list:
assignment-expression
argument-expression-list @, assignment-expression
unary-expression:
postfix-expression
@++ unary-expression
@-- unary-expression
unary-operator cast-expression
@sizeof unary-expression
@sizeof @( type-name @)
unary-operator:
@& @* @+ @- @~ @!
cast-expression:
unary-expression
@( type-name @) cast-expression
multiplicative-expression:
cast-expression
multiplicative-expression @* cast-expression
multiplicative-expression @/ cast-expression
multiplicative-expression @% cast-expression
additive-expression:
multiplicative-expression
additive-expression @+ multiplicative-expression
additive-expression @- multiplicative-expression
shift-expression:
additive-expression
shift-expression @<< additive-expression
shift-expression @>> additive-expression
relational-expression:
shift-expression
relational-expression @< shift-expression
relational-expression @> shift-expression
relational-expression @<= shift-expression
relational-expression @>= shift-expression
equality-expression:
relational-expression
equality-expression @== relational-expression
equality-expression @!= relational-expression
AND-expression:
equality-expression
AND-expression @& equality-expression
exclusive-OR-expression:
AND-expression
exclusive-OR-expression @^ AND-expression
inclusive-OR-expression:
exclusive-OR-expression
inclusive-OR-expression @| exclusive-OR-expression
logical-AND-expression:
inclusive-OR-expression
logical-AND-expression @&& inclusive-OR-expression
logical-OR-expression:
logical-AND-expression
logical-OR-expression @|| logical-AND-expression
conditional-expression:
logical-OR-expression
logical-OR-expression @? expression @: conditional-expression
assignment-expression:
conditional-expression
unary-expression assignment-operator assignment-expression
assignment-operator:
@= @*= @/= @%= @+= @-= @<<= @>>= @&= @^= @|=
expression:
assignment-expression
expression @, assignment-expression
constant-expression:
conditional-expression
declaration:
declaration-specifiers [ init-declarator-list ] @;
declaration-specifiers:
storage-class-specifier [ declaration-specifiers ]
type-specifier [ declaration-specifiers ]
type-qualifier [ declaration-specifiers ]
function-specifier [ declaration-specifiers ]
init-declarator-list:
init-declarator
init-declarator-list @, init-declarator
init-declarator:
declarator
declarator @= initializer
storage-class-specifier:
@typedef
@extern
@static
@auto
@register
type-specifier:
@void
@char
@short
@int
@long
@float
@double
@signed
@unsigned
@_Bool
@_Complex
@_Imaginary
struct-or-union-specifier
enum-specifier
typedef-name
type-qualifier:
@const
@restrict
@volatile
function-specifier:
@inline
struct-or-union-specifier:
struct-or-union [ identifier ] @{ struct-declaration-list @}
struct-or-union identifier
struct-or-union:
@struct
@union
struct-declaration-list:
struct-declaration
struct-declaration-list struct-declaration
struct-declaration:
specifier-qualifier-list struct-declarator-list @;
specifier-qualifier-list:
type-specifier [ specifier-qualifier-list ]
type-qualifier [ specifier-qualifier-list ]
struct-declarator-list:
struct-declarator
struct-declarator-list @, struct-declarator
struct-declarator:
declarator
[ declarator ] @: constant-expression
enum-specifier:
@enum [ identifier ] @{ enumerator-list @}
@enum [ identifier ] @{ enumerator-list @, @}
@enum identifier
enumerator-list:
enumerator
enumerator-list @, enumerator
enumerator:
enumeration-constant
enumeration-constant @= constant-expression
declarator:
[ pointer ] direct-declarator
direct-declarator:
identifier
@( declarator @)
direct-declarator @[ [ type-qualifier-list ] [ assignment-expression ] @]
direct-declarator @[ @static
[ type-qualifier-list ] assignment-expression @]
direct-declarator @[ type-qualifier-list @static assignment-expression @]
direct-declarator @[ [ type-qualifier-list ] @* @]
direct-declarator @( parameter-type-list @)
direct-declarator @( [ identifier-list ] @)
pointer:
@* [ type-qualifier-list ]
@* [ type-qualifier-list ] pointer
type-qualifier
type-qualifier-list type-qualifier
parameter-type-list:
parameter-list
parameter-list @, @...
parameter-list:
parameter-declaration
parameter-list @, parameter-declaration
parameter-declaration:
declaration-specifiers declarator
declaration-specifiers [ abstract-declarator ]
identifier-list:
identifier
identifier-list @, identifier
type-name:
specifier-qualifier-list [ abstract-declarator ]
abstract-declarator:
pointer
[ pointer ] direct-abstract-declarator
direct-abstract-declarator:
@( abstract-declarator @)
[ direct-abstract-declarator ] @[ [ assignment-expression ] @]
[ direct-abstract-declarator ] @[ @* @]
[ direct-abstract-declarator ] @( [ parameter-type-list ] @)
typedef-name:
identifier
initializer:
assignment-expression
@{ initializer-list @}
@{ initializer-list @, @}
initializer-list:
[ designation ] initializer
initializer-list @, [ designation ] initializer
designation:
designator-list @=
designator-list:
designator
designator-list designator
designator:
@[ constant-expression @]
@. identifier
statement:
labeled-statement
compound-statement
expression-statement
selection-statement
iteration-statement
jump-statement
labeled-statement:
identifier @: statement
@case constant-expression @: statement
@default @: statement
compound-statement:
@{ [ block-item-list ] @}
block-item-list:
block-item
block-item-list block-item
block-item:
declaration
statement
expression-statement:
[ expression ] @;
selection-statement:
@if @( expression @) statement
@if @( expression @) statement @else statement
@switch @( expression @) statement
iteration-statement:
@while @( expression @) statement
@do statement @while @( expression @) @;
@for @( [ expression ] @; [ expression ] @; [ expression ] @) statement
@for @( declaration [ expression ] @; [ expression ] @) statement
jump-statement:
@goto identifier @;
@continue @;
@break @;
@return [ expression ] @;
translation-unit:
external-declaration
translation-unit external-declaration
external-declaration:
function-definition
declaration
function-definition:
declaration-specifiers declarator [ declaration-list ] compound-statement
declaration-list:
declaration
declaration-list declaration
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: bn-mode.el --]
[-- Type: text/x-emacs-lisp; name=bn-mode.el, Size: 22590 bytes --]
(defvar bn-left-nonterminal-definition
"^\\([A-Za-z-]*\\)\\(:\\)[ ]\\{0,3\\}$"
"The regular expression that marks the left side from the \
definition of a rule" )
(defvar imenu-create-index-function)
(defvar imenu-use-markers)
(defvar bn-left-nonterminal-list nil
"keeps the list of all the left nonterminals. this could be
defined locally only, inside `bn-lazy-font-lock'. Used for
imenu and completion-list .")
(defvar bn-timer-var nil
"non nil means that a fontification will follow")
(defvar bn-search-history nil
"used by search-completion to keep the history of searched
strings" )
(defvar bn-comment-char "%"
"a line which starts with this character is commented")
(defvar after-change-functions nil )
(defun bn-mode nil
"A major mode for well writing context-free grammars
in Backus-Naur notation."
(interactive)
'bn-mode
'fundamental-mode
'"Backus-Naur"
(kill-all-local-variables)
(setq major-mode 'bn-mode
mode-name "Backus-Naur" )
(make-local-variable 'bn-comment-char)
(make-local-variable 'bn-overlays)
(make-local-variable 'bn-iterator)
(make-local-variable 'after-change-functions)
(make-local-variable 'bn-left-nonterminal-list)
(make-local-variable 'bn-rotate-around-left-nonterminal-match-ring)
(make-local-variable 'imenu-create-index-function)
(setq imenu-create-index-function 'bn-imenu)
(make-local-variable 'imenu-generic-expression)
(setq imenu-generic-expression t)
(and t
(fboundp 'imenu-add-to-menubar)
(imenu-add-to-menubar "Index"))
(setq font-lock-defaults
(list
(list
(list
bn-left-nonterminal-definition
'(1 'bn-left-nonterminal-definition-font )
'(2 'bn-left-nonterminal-definition-closure ) )
'( "\\('\\)\\([[:graph:]]*\\)\\('\\)"
(1 'bn-terminal-closure )
(2 'bn-terminal-definition )
(3 'bn-terminal-closure )
)
'( "\\(@\\)\\([[:graph:]]+\\)"
(1 'bn-terminal-closure )
(2 'bn-terminal-definition )
)
(list
(concat "[^[:graph:]]"
"\\([[]\\)"
"\\(.*\\)"
"[^[:graph:]]"
"\\([]]\\)")
'(1 'bn-optional-closure )
'(2 'bn-optional-definition )
'(3 'bn-optional-closure ))
(list
(concat "^" "\\(" bn-comment-char "\\)"
"\\(.*\\)" )
'(1 'bn-comment-sign )
'(2 'bn-commented-text ) )
(list
"|"
'(0 'bn-or ) ) )
t ) )
(bn-stop-timer)
(remove-overlays)
(setq after-change-functions (add-to-list 'after-change-functions 'bn-change) )
(local-set-key [tab] 'bn-indent)
(local-set-key [home]
(lambda nil (interactive)
(if (equal (char-before) ?\n)
(bn-beginning-of-defun)
(beginning-of-line) ) ) )
(local-set-key [end]
(lambda nil (interactive)
(if (equal (char-after) ?\n)
(bn-end-of-defun)
(end-of-line) ) ) )
(bn-lazy-font-lock)
(local-set-key "\M-s" 'bn-search )
(local-set-key (kbd "C-x SPC")
(lambda ()
"jump to the definition of the nonterminal under the cursor. "
(interactive "")
(let* ((type (get-text-property (point) 'type))
(nonterminal
(and type
(get-text-property (point) 'nonterminal) ) )
(p
(and nonterminal
(get-text-property (point) 'position) ) ) )
(cond
( (eq type 'right)
(and p
(bn-jump p )
'(recenter)
(message "jump to `%s' %s" nonterminal p ) ) )
((eq type 'left)
(error "`%s' is a left nonterminal\n" nonterminal ) ) ) ) ) )
(make-local-variable 'bn-search-history)
(local-set-key (kbd "C-;")
(lambda nil
"replaces isearch"
(interactive)
(let ((aa
(completing-read
"search left-nonterminal: "
(mapcar 'caar bn-left-nonterminal-list )
nil
t
nil
bn-search-history
nil
nil ) ) )
(and aa
(bn-jump (cdr (assoc aa (mapcar 'car bn-left-nonterminal-list ) ) ) ) ) ) ) )
)
(defun bn-jump (p)
(push-mark)
(goto-char p) )
(defun bn-stop-timer ()
"stop the timer for fontification"
(and bn-timer-var
(progn
(cancel-timer bn-timer-var)
(setq bn-timer-var nil) ) ) )
(defface bn-left-nonterminal-definition-font
'((((class grayscale) (background light)) (:foreground "Gray90" :weight bold))
(((class grayscale) (background dark)) (:foreground "DimGray" :weight bold))
(((class color) (min-colors 88) (background light)) (:foreground "red"))
(((class color) (min-colors 88) (background dark)) (:foreground "orange red"))
(((class color) (min-colors 16) (background light)) (:foreground "orange"))
(((class color) (min-colors 16) (background dark)) (:foreground "gold"))
(((class color) (min-colors 8)) (:foreground "dark orange"))
(t (:weight bold :underline t)))
"font used for left nonterminals." )
(defface bn-right-nonterminal-definition-font
'((((class grayscale) (background light)) (:foreground "AntiqueWhite4" :weight bold))
(((class grayscale) (background dark)) (:foreground "AntiqueWhite4" :weight bold))
(((class color) (min-colors 88) (background light)) (:foreground "AntiqueWhite4"))
(((class color) (min-colors 88) (background dark)) (:foreground "AntiqueWhite4"))
(((class color) (min-colors 16) (background light)) (:foreground "AntiqueWhite4"))
(((class color) (min-colors 16) (background dark)) (:foreground "AntiqueWhite4"))
(((class color) (min-colors 8)) (:foreground "AntiqueWhite4"))
(t (:weight bold :underline t)))
"font used for right nonterminals." )
(defface bn-left-nonterminal-definition-closure
'((((class grayscale) (background light)) (:foreground "Gray90" :weight bold))
(((class grayscale) (background dark)) (:foreground "DimGray" :weight bold))
(((class color) (min-colors 88) (background light)) (:foreground "deep sky blue"))
(((class color) (min-colors 88) (background dark)) (:foreground "spring green"))
(((class color) (min-colors 16) (background light)) (:foreground "dark sea green"))
(((class color) (min-colors 16) (background dark)) (:foreground "yellow green"))
(((class color) (min-colors 8)) (:foreground "olive drab"))
(t (:weight bold :underline t)))
"font used for the character `:' at the end of a left nonterminal." )
(defface bn-terminal-definition
'((((class grayscale) (background light)) (:foreground "DeepSkyBlue1" :weight bold))
(((class grayscale) (background dark)) (:foreground "DeepSkyBlue1" :weight bold))
(((class color) (min-colors 88) (background light)) (:foreground "DeepSkyBlue1"))
(((class color) (min-colors 88) (background dark)) (:foreground "DeepSkyBlue1"))
(((class color) (min-colors 16) (background light)) (:foreground "DeepSkyBlue1"))
(((class color) (min-colors 16) (background dark)) (:foreground "DeepSkyBlue1"))
(((class color) (min-colors 8)) (:foreground "DeepSkyBlue1"))
(t (:weight bold :underline t)))
"font used for terminals." )
(defface bn-terminal-closure
'((((class grayscale) (background light)) (:foreground "dark blue" :weight bold))
(((class grayscale) (background dark)) (:foreground "dark blue" :weight bold))
(((class color) (min-colors 88) (background light)) (:foreground "dark blue"))
(((class color) (min-colors 88) (background dark)) (:foreground "dark blue"))
(((class color) (min-colors 16) (background light)) (:foreground "dark blue"))
(((class color) (min-colors 16) (background dark)) (:foreground "dark blue"))
(((class color) (min-colors 8)) (:foreground "dark blue"))
(t (:weight bold :underline t)))
"font used for the characters \' around a terminal." )
(defface bn-optional-closure
'((((class grayscale) (background light)) (:foreground "RoyalBlue1" :weight bold))
(((class grayscale) (background dark)) (:foreground "RoyalBlue1" :weight bold))
(((class color) (min-colors 88) (background light)) (:foreground "RoyalBlue1"))
(((class color) (min-colors 88) (background dark)) (:foreground "RoyalBlue1"))
(((class color) (min-colors 16) (background light)) (:foreground "RoyalBlue1"))
(((class color) (min-colors 16) (background dark)) (:foreground "RoyalBlue1"))
(((class color) (min-colors 8)) (:foreground "RoyalBlue1"))
(t (:weight bold :underline t)))
"font used for the characters [ ] about an optional ." )
(defface bn-optional-definition
'((((class grayscale) (background light)) (:foreground "dark green" :weight bold))
(((class grayscale) (background dark)) (:foreground "dark green" :weight bold))
(((class color) (min-colors 88) (background light)) (:foreground "dark green"))
(((class color) (min-colors 88) (background dark)) (:foreground "dark green"))
(((class color) (min-colors 16) (background light)) (:foreground "dark green"))
(((class color) (min-colors 16) (background dark)) (:foreground "dark green"))
(((class color) (min-colors 8)) (:foreground "dark green"))
(t (:weight bold :underline t)))
"font used for the ." )
(defface bn-search-rotate-face
'((((class grayscale) (background light)) (:foreground "Gray90" :weight bold))
(((class grayscale) (background dark)) (:foreground "DimGray" :weight bold))
(((class color) (min-colors 88) (background light)) (:foreground "chartreuse1"))
(((class color) (min-colors 88) (background dark)) (:foreground "chartreuse2"))
(((class color) (min-colors 16) (background light)) (:foreground "chartreuse3"))
(((class color) (min-colors 16) (background dark)) (:foreground "chartreuse4"))
(((class color) (min-colors 8)) (:foreground "SpringGreen4"))
(t (:weight bold :underline t)))
"font used for matched right nonterminals." )
(defface bn-commented-text
'((((class grayscale) (background light)) (:foreground "medium sea green" :weight bold))
(((class grayscale) (background dark)) (:foreground "medium sea green" :weight bold))
(((class color) (min-colors 88) (background light)) (:foreground "medium sea green"))
(((class color) (min-colors 88) (background dark)) (:foreground "medium sea green"))
(((class color) (min-colors 16) (background light)) (:foreground "medium sea green"))
(((class color) (min-colors 16) (background dark)) (:foreground "medium sea green"))
(((class color) (min-colors 8)) (:foreground "medium sea green"))
(t (:weight bold :underline t)))
"font used for the text on a commented line" )
(defface bn-or
'((((class grayscale) (background light)) (:foreground "brown" :weight bold))
(((class grayscale) (background dark)) (:foreground "blue" :weight bold))
(((class color) (min-colors 88) (background light)) (:foreground "blue"))
(((class color) (min-colors 88) (background dark)) (:foreground "blue"))
(((class color) (min-colors 16) (background light)) (:foreground "blue"))
(((class color) (min-colors 16) (background dark)) (:foreground "blue"))
(((class color) (min-colors 8)) (:foreground "blue"))
(t (:weight bold :underline t :foreground "blue" :weight bold)))
"font used for" )
(defface bn-comment-sign
'((((class grayscale) (background light)) (:foreground "Gray90" :weight bold))
(((class grayscale) (background dark)) (:foreground "DimGray" :weight bold))
(((class color) (min-colors 88) (background light)) (:foreground "indian red"))
(((class color) (min-colors 88) (background dark)) (:foreground "lightgreen"))
(((class color) (min-colors 16) (background light)) (:foreground "tomato"))
(((class color) (min-colors 16) (background dark)) (:foreground "dark violet"))
(((class color) (min-colors 8)) (:foreground "sienna"))
(t (:weight bold :underline t)))
"font used for the character that comments a line" )
(defun bn-indent ()
" The lines that contain a left nonterminal are indented from
0. These are the lines that match the regular expression
`bn-left-nonterminal-definition'.
The blank lines are cleared.
The lines which contain a rule are indented with a tab."
(interactive)
(let (
;; initial point
(cc (current-column))
;; end of line
(eol (prog2
(move-end-of-line nil)
(current-column) ) )
;; beginning of text
(bot (prog2
(move-beginning-of-line nil)
(skip-chars-forward "[:blank:]")
(current-column) ) ) )
(cond
;; empty line
((zerop eol)
t)
;; lines with blanks
((eq bot eol)
(move-beginning-of-line nil)
(just-one-space 0) )
;; line containing a left nonterminal
((save-excursion
(move-to-column eol)
(and (> (current-column) 3)
(search-backward ":" (- (point) 1) t ) ) )
(move-beginning-of-line nil)
(just-one-space 0) )
;; for the rest... add a tab at the beginning of the line
( (save-excursion
(move-beginning-of-line nil)
(not (search-forward-regexp "\t[^[:blank:]]" (+ 2 (point) ) t ) ) )
(just-one-space 0)
(insert-char ?\t 1)
(skip-chars-forward "[:blank:]") ) )
;; if the cursor was before the indetation inside the word, keep
;; it on the same position; if the initial position of the cursor
;; was before the word, move it at the beginning of the word
(move-to-column (+ (current-column)
(max 0 (- cc bot) ) ) ) ) )
(defun bn-commented-line-p ()
"return t when the point is inside a commented line, and nil
otherwise."
(equal
(save-excursion
(beginning-of-line)
(following-char) )
(elt bn-comment-char 0 ) ) )
(defun bn-lazy-font-lock ()
"called after every buffer change to re-fontify the text."
(bn-stop-timer)
(save-excursion
(let (list-of-left-nonterminals
(map-right-nonterminal (make-sparse-keymap) )
(map-left-nonterminal (make-sparse-keymap) )
;; font lock properties modify the buffer, so this hook is
;; called recursively. temporarly after-change-functions
;; must be nil.
after-change-functions
;; changing the properties, one changes the modified status
(buffer-modified-flag (buffer-modified-p) )
;; this is equalent in this case to setting
;; after-change-functions to nil. However, we keep both
(inhibit-modification-hooks t)
;; make a temporary copy of the undo
;; list. add-text-properties adds information in the undo
;; list, even if in this case it shouldn't
(ul buffer-undo-list) )
;; we disable the undo information temporarly, because changing
;; the fontification is added by default in the undo list.
(buffer-disable-undo)
(define-key map-right-nonterminal [mouse-3]
(lambda (event) (interactive "e")
"jump to a left terminal definition"
(let ((p (get-text-property
(cadr (cadr event) )
'position) ) )
(and p
(bn-jump p )
'(recenter)
(message (format "%s" p ) ) ) ) ) )
(define-key map-left-nonterminal "\M-s" 'bn-search )
(goto-char (point-min) )
;; make the list of left nonterminals out
(while (search-forward-regexp
;; TODO: to add fontification here for optional
;; nonterminals inside `[ ... ]'
(concat bn-left-nonterminal-definition )
nil t)
(push (cons (substring-no-properties (match-string 1) )
(match-beginning 1) )
list-of-left-nonterminals ) )
;; clean the previous fontification
(remove-text-properties
(point-min) (point-max)
'(mouse-face highlight font-lock-face keymap position) )
(setq bn-left-nonterminal-list nil)
;; add first the fontification of font-lock
(font-lock-fontify-buffer)
;; scan the buffer to find the positions where every
;; left-nonterminal appears in the rules
(dolist (m list-of-left-nonterminals)
(let ( (match-positions) )
(goto-char (point-min) )
(while
(and (search-forward-regexp
(concat "[\t ]" "\\(" (car m) "\\)" "[\n .\t]") nil t)
(goto-char (1- (point) ) ) )
(setq make-fontification
(not (eq (get-text-property (1- (point)) 'face)
'bn-optional-definition)))
(and
;; if a right nonterminal is found, add it to the
;; matching list, subject to not being on a commented line
;; or inside a [ comment ]
make-fontification
(not (bn-commented-line-p) )
(add-text-properties
(match-beginning 1)
(match-end 1)
(list
'font-lock-face 'bn-right-nonterminal-definition-font)))
(and
(not (bn-commented-line-p) )
(add-text-properties
(match-beginning 1)
(match-end 1)
(list 'mouse-face 'highlight
'help-echo
(concat (car m)
(format " at %d." (cdr m) )
(let ((nl (count-lines (point) (cdr m) ) ) )
(cond ( (> (point) (cdr m) )
(format " %d line%s backward."
(1- nl)
(if (equal 2 nl)
""
"s" ) ) )
( t
(format " %d line%s forward."
nl
(if (equal 1 nl)
""
"s" ) ) )
) )
"\nright click to jump there." )
'position (cdr m)
'type 'right
'nonterminal (car m)
'keymap map-right-nonterminal) )
(push (match-beginning 1) match-positions) ) )
;; add text properties to the left nonterminal
(add-text-properties
(cdr m) (+ (length (car m) ) (cdr m) )
(list
'help-echo (concat "`" (car m) "'" " "
(if match-positions
(format "at %s" (reverse match-positions) )
"is a start symbol" )
(format
".\n %s to rotate around matches."
(substitute-command-keys "\\[bn-search]") ) )
'position (progn
(let ( ( ring-positions (make-ring (length match-positions) ) ) )
(dolist (p (reverse match-positions) )
(ring-insert ring-positions p) )
ring-positions) )
'nonterminal (car m)
'type 'left
'keymap map-left-nonterminal) )
(push (cons m match-positions) bn-left-nonterminal-list ) ) )
;; restore the undo, modified status
(restore-buffer-modified-p buffer-modified-flag)
(buffer-enable-undo)
(setq buffer-undo-list ul )
) ) )
(defun bn-change (x y z)
"hook which is called after every buffer change. it starts a
timer that fontify the current buffer, according to the rules
defined in the grammar. if a previous timer is active, stop it
before starting the new timer."
;; clear the overlays from the previous search if any
(bn-stop-timer)
'(setq overriding-terminal-local-map nil)
(setq bn-timer-var
(run-with-idle-timer
1 nil 'bn-lazy-font-lock) ) )
(defun bn-beginning-of-defun ()
"jump at the beginning of a left nonterminal definition."
(search-backward-regexp bn-left-nonterminal-definition nil t) )
(defun bn-end-of-defun ()
"jump at the end of a left nonterminal definition."
(if (search-forward-regexp bn-left-nonterminal-definition nil t)
(beginning-of-line)
(bn-jump (point-max) ) )
(let ((repeat t))
(while repeat
(skip-chars-backward " \t\n")
(if (not (bn-commented-line-p) )
(setq repeat nil)
(beginning-of-line) ) ) )
(skip-chars-forward " \t")
(and (not (eobp) )
(forward-char) ) )
(defun bn-search ()
"Search for the left nonterminal under the cursor"
(interactive)
(let* ((left-nonterminal (get-text-property (point) 'nonterminal ) )
(left-nonterminal-positions
(and left-nonterminal
(get-text-property (point) 'position ) ) ) )
(cond
;; a symbol accessed from nowhere
( (and
(ring-p left-nonterminal-positions )
(ring-empty-p left-nonterminal-positions ) )
(message "`%s' is a start symbol" left-nonterminal ) )
;; at cursor position there is a left nonterminal
( (ring-p left-nonterminal-positions )
;; fontify right nonterminals that match
(dolist (p (ring-elements left-nonterminal-positions ) )
(let ((ov (make-overlay p (+ p (length left-nonterminal ) ) ) ) )
(overlay-put ov 'face 'bn-search-rotate-face) ) )
;; loop of input events
(let* (key
(l t)
(pos 0)
(number-of-matches (ring-size left-nonterminal-positions ) )
(many-matches (> number-of-matches 1 ) )
(Mkeys (concat
"\n"
(if many-matches
"`n' jump to the next match. `p' jump to the previous match. "
"" )
"`q' interrupts search." ) )
(M (concat
(format "`%s'" left-nonterminal )
(format " : `%s': " (reverse (ring-elements left-nonterminal-positions ) ) )
Mkeys ) ) )
;; jump to the first match
(bn-jump (ring-ref left-nonterminal-positions pos) )
'(recenter)
(message (concat "Search for " M ) )
(while l
(setq key (read-key-sequence nil) )
(cond
;; quit the search
( (and (stringp key)
(string-equal key "q" ) )
(message "quit search." )
(setq l nil ) )
;; searck for the next match
( (and (stringp key)
many-matches
(string-equal key "n" ) )
(setq pos (1- pos) )
(goto-char (ring-ref left-nonterminal-positions pos) )
(message M ) )
;; search for the previous match
( (and (stringp key)
many-matches
(string-equal key "p" ) )
(setq pos (1+ pos) )
(goto-char (ring-ref left-nonterminal-positions pos ) )
(message M ) )
(t
(message
(concat (format "`%s'" (key-description key ) )
" does not match. "
Mkeys ) ) ) ) ) )
;; removing overlays
(remove-overlays) )
((listp left-nonterminal-positions )
(error "No left-nonterminal defintion at point" ))
(t
(error " `%s' : cannot loop for a right symbol. " left-nonterminal ) ) ) ) )
'(defun bn-imenu ()
(mapcar
(lambda (l)
(cons (caar l)
(if (cadr l)
(copy-marker (cadr l) )
0) ) )
bn-left-nonterminal-list) )
(defun bn-imenu ()
(mapcar
(lambda (l)
(cons (car l)
(copy-marker (cdr l) ) ) )
(mapcar 'car
bn-left-nonterminal-list) ) )
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: Backus Naur
2010-10-02 11:09 A. Soare
@ 2010-10-04 2:03 ` Richard Stallman
0 siblings, 0 replies; 3+ messages in thread
From: Richard Stallman @ 2010-10-04 2:03 UTC (permalink / raw)
To: alinsoar; +Cc: emacs-devel
Emacs has already some major modes for working with extended bnf, which is =
standardized. This is not the case for my implementation, that I wrote only=
for my own use.
I don't understand what you mean -- could you explain the difference?
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: Backus Naur
@ 2010-10-08 19:14 A. Soare
0 siblings, 0 replies; 3+ messages in thread
From: A. Soare @ 2010-10-08 19:14 UTC (permalink / raw)
To: rms; +Cc: emacs-devel
> Emacs has already some major modes for working with extended bnf, which is =
> standardized. This is not the case for my implementation, that I wrote only=
> for my own use.
>
> I don't understand what you mean -- could you explain the difference?
I do not know exactly to explain you the difference, as I do not know ebnf. I made the major mode for my own use, in order to help me for the problems I want to solve, with no intention for learning the extended bnf.
Vinicius Jose Latorre published "Links for ebnf2ps package" on his wiki page:
http://www.emacswiki.org/emacs/ViniciusJoseLatorre. He known the ebnf protocol.
I can say just I suppose the difference consist of regular expressions.
My code:
1. marks the terminals (defined by the regexp "all words inside apostrophe '' " ) using font-lock.
scans the file 1 second after the file was changed. It uses the regular expression "all words starting at the beginning of line and finishing by ':' newline " to collect left nonterminas. Afterwards, for every left nonterminal X from the list, it adds properties to right nonterminal X, if it is not terminal (terminals are marked in this moment with the properties defined by the properties of font-lock).
Apart from this, I do not know what to tell you the diff is. I do not want to spend time now on exptending the code to be ebnf compatible. But I suppose that it is not much difference.
Alin.
____________________________________________________
Découvrez les nouveaux modèles de voitures présentés au Mondial de l’Automobile à Paris : http://actu.voila.fr/evenementiel/salon-auto-paris-2010/
^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2010-10-08 19:14 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2010-10-08 19:14 Backus Naur A. Soare
-- strict thread matches above, loose matches on Subject: below --
2010-10-02 11:09 A. Soare
2010-10-04 2:03 ` Richard Stallman
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).