Mercurial > emacs
changeset 83061:bff8fa30c018
Merged in changes from CVS HEAD
Patches applied:
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-113
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-114
Merge some minor redisplay bug-fixes from emacs--tiling--0
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-115
Update from CVS
* miles@gnu.org--gnu-2004/emacs--tiling--0--patch-9
Remove bogus xassert
* miles@gnu.org--gnu-2004/emacs--tiling--0--patch-10
Avoid negative descents for images with ascent > height
* miles@gnu.org--gnu-2004/emacs--tiling--0--patch-13
Fix iterator-inconsistency bug in redisplay
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-101
| author | Karoly Lorentey <lorentey@elte.hu> |
|---|---|
| date | Thu, 26 Feb 2004 00:39:34 +0000 |
| parents | 70063cb10ca9 (current diff) 02b649742717 (diff) |
| children | 8cfc953cfadf |
| files | lisp/ChangeLog src/xdisp.c src/xfns.c |
| diffstat | 11 files changed, 1364 insertions(+), 207 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Thu Feb 26 00:37:31 2004 +0000 +++ b/lisp/ChangeLog Thu Feb 26 00:39:34 2004 +0000 @@ -1,3 +1,43 @@ +2004-02-24 Vinicius Jose Latorre <viniciusjl@ig.com.br> + + * ebnf-abn.el: New file, implements an ABNF parser. + + * ebnf2ps.el: Doc fix. Accept ABNF (Augmented BNF). New arrow shapes: + semi-up-hollow, semi-up-full, semi-down-hollow and semi-down-full. Fix + a bug on productions like test = {"test"}* | ( "tt" ["test"] ). + Reported by Markus Dreyer <mdreyer@ix.urz.uni-heidelberg.de>. + (ebnf-version): New version number (4.0). + (ebnf-print-directory, ebnf-print-file, ebnf-spool-directory) + (ebnf-spool-file, ebnf-eps-directory, ebnf-eps-file) + (ebnf-delete-style): New commands. + (ebnf-directory, ebnf-file): New funs. + (ebnf-special-show-delimiter, ebnf-file-suffix-regexp) + (ebnf-production-name-p, ebnf-stop-on-error): New options. + (ebnf-syntax-alist): New var. + (ebnf-element-width): New fun replacing ebnf-list-width. + (ebnf-arrow-shape, ebnf-syntax): Custom fix. + (ebnf-style-custom-list, ebnf-style-database, ebnf-arrow-shape-alist) + (ebnf-prologue): Adjust vars. + (ebnf-setup, ebnf-insert-style, ebnf-merge-style, ebnf-apply-style) + (ebnf-reset-style, ebnf-push-style, ebnf-pop-style) + (ebnf-check-style-values, ebnf-generate-production) + (ebnf-generate-region, ebnf-production-dimension, ebnf-justify-list) + (ebnf-make-terminal1, ebnf-make-or-more1, ebnf-make-repeat) + (ebnf-token-repeat): Code fix. + + * ebnf-yac.el: Doc fix. Handle Bison pragmas %nonassoc, %right, %left + and %prec. Suggested by Matthew K. Junker <junker@alum.mit.edu>. + (ebnf-yac-definitions, ebnf-yac-lex): Code fix. + + * ebnf-iso.el: Doc fix. + (ebnf-iso-token-table, ebnf-iso-non-terminal-chars): Adjust vars. + (ebnf-iso-lex): Code fix. + + * ebnf-bnf.el: Doc fix. + (ebnf-bnf-lex): Code fix. + + * ebnf-otz.el: Doc fix. + 2004-02-23 Luc Teirlinck <teirllm@auburn.edu> * abbrev.el (write-abbrev-file): Make argument optional. Doc fix.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/progmodes/ebnf-abn.el Thu Feb 26 00:39:34 2004 +0000 @@ -0,0 +1,663 @@ +;;; ebnf-abn.el --- parser for ABNF (Augmented BNF) + +;; Copyright (C) 2004 Free Sofware Foundation, Inc. + +;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Time-stamp: <2004/02/23 22:38:59 vinicius> +;; Keywords: wp, ebnf, PostScript +;; Version: 1.0 + +;; 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 2, 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; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; +;; This is part of ebnf2ps package. +;; +;; This package defines a parser for ABNF (Augmented BNF). +;; +;; See ebnf2ps.el for documentation. +;; +;; +;; ABNF Syntax +;; ----------- +;; +;; See the URL: +;; `http://www.faqs.org/rfcs/rfc2234.html' +;; or +;; `http://www.rnp.br/ietf/rfc/rfc2234.txt' +;; ("Augmented BNF for Syntax Specifications: ABNF"). +;; +;; +;; rulelist = 1*( rule / (*c-wsp c-nl) ) +;; +;; rule = rulename defined-as elements c-nl +;; ; continues if next line starts with white space +;; +;; rulename = ALPHA *(ALPHA / DIGIT / "-") +;; +;; defined-as = *c-wsp ("=" / "=/") *c-wsp +;; ; basic rules definition and incremental +;; ; alternatives +;; +;; elements = alternation *c-wsp +;; +;; c-wsp = WSP / (c-nl WSP) +;; +;; c-nl = comment / CRLF +;; ; comment or newline +;; +;; comment = ";" *(WSP / VCHAR) CRLF +;; +;; alternation = concatenation +;; *(*c-wsp "/" *c-wsp concatenation) +;; +;; concatenation = repetition *(1*c-wsp repetition) +;; +;; repetition = [repeat] element +;; +;; repeat = 1*DIGIT / (*DIGIT "*" *DIGIT) +;; +;; element = rulename / group / option / +;; char-val / num-val / prose-val +;; +;; group = "(" *c-wsp alternation *c-wsp ")" +;; +;; option = "[" *c-wsp alternation *c-wsp "]" +;; +;; char-val = DQUOTE *(%x20-21 / %x23-7E) DQUOTE +;; ; quoted string of SP and VCHAR without DQUOTE +;; +;; num-val = "%" (bin-val / dec-val / hex-val) +;; +;; bin-val = "b" 1*BIT +;; [ 1*("." 1*BIT) / ("-" 1*BIT) ] +;; ; series of concatenated bit values +;; ; or single ONEOF range +;; +;; dec-val = "d" 1*DIGIT +;; [ 1*("." 1*DIGIT) / ("-" 1*DIGIT) ] +;; +;; hex-val = "x" 1*HEXDIG +;; [ 1*("." 1*HEXDIG) / ("-" 1*HEXDIG) ] +;; +;; prose-val = "<" *(%x20-3D / %x3F-7E) ">" +;; ; bracketed string of SP and VCHAR without +;; ; angles +;; ; prose description, to be used as last resort +;; +;; ; Core rules -- the coding depends on the system, here is used 7-bit ASCII +;; +;; ALPHA = %x41-5A / %x61-7A +;; ; A-Z / a-z +;; +;; BIT = "0" / "1" +;; +;; CHAR = %x01-7F +;; ; any 7-bit US-ASCII character, excluding NUL +;; +;; CR = %x0D +;; ; carriage return +;; +;; CRLF = CR LF +;; ; Internet standard newline +;; +;; CTL = %x00-1F / %x7F +;; ; controls +;; +;; DIGIT = %x30-39 +;; ; 0-9 +;; +;; DQUOTE = %x22 +;; ; " (Double Quote) +;; +;; HEXDIG = DIGIT / "A" / "B" / "C" / "D" / "E" / "F" +;; +;; HTAB = %x09 +;; ; horizontal tab +;; +;; LF = %x0A +;; ; linefeed +;; +;; LWSP = *(WSP / CRLF WSP) +;; ; linear white space (past newline) +;; +;; OCTET = %x00-FF +;; ; 8 bits of data +;; +;; SP = %x20 +;; ; space +;; +;; VCHAR = %x21-7E +;; ; visible (printing) characters +;; +;; WSP = SP / HTAB +;; ; white space +;; +;; +;; NOTES: +;; +;; 1. Rules name and terminal strings are case INSENSITIVE. +;; So, the following rule names are all equals: +;; Rule-name, rule-Name, rule-name, RULE-NAME +;; Also, the following strings are equals: +;; "abc", "ABC", "aBc", "Abc", "aBC", etc. +;; +;; 2. To have a case SENSITIVE string, use the character notation. +;; For example, to specify the lowercase string "abc", use: +;; %d97.98.99 +;; +;; 3. There are no implicit spaces between elements, for example, the +;; following rules: +;; +;; foo = %x61 ; a +;; +;; bar = %x62 ; b +;; +;; mumble = foo bar foo +;; +;; Are equivalent to the following rule: +;; +;; mumble = %x61.62.61 +;; +;; If spaces are needed, it should be explicit specified, like: +;; +;; spaces = 1*(%x20 / %x09) ; one or more spaces or tabs +;; +;; mumble = foo spaces bar spaces foo +;; +;; 4. Lines starting with space or tab are considered a continuation line. +;; For example, the rule: +;; +;; rule = foo +;; bar +;; +;; Is equivalent to: +;; +;; rule = foo bar +;; +;; +;; Differences Between ABNF And ebnf2ps ABNF +;; ----------------------------------------- +;; +;; Besides the characters that ABNF accepts, ebnf2ps ABNF accepts also the +;; underscore (_) for rule name and european 8-bit accentuated characters (from +;; \240 to \377) for rule name, string and comment. +;; +;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Code: + + +(require 'ebnf-otz) + + +(defvar ebnf-abn-lex nil + "Value returned by `ebnf-abn-lex' function.") + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Syntactic analyzer + + +;;; rulelist = 1*( rule / (*c-wsp c-nl) ) + +(defun ebnf-abn-parser (start) + "ABNF parser." + (let ((total (+ (- ebnf-limit start) 1)) + (bias (1- start)) + (origin (point)) + rule-list token rule) + (goto-char start) + (setq token (ebnf-abn-lex)) + (and (eq token 'end-of-input) + (error "Invalid ABNF file format")) + (while (not (eq token 'end-of-input)) + (ebnf-message-float + "Parsing...%s%%" + (/ (* (- (point) bias) 100.0) total)) + (setq token (ebnf-abn-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 = rulename defined-as elements c-nl +;;; ; continues if next line starts with white space +;;; +;;; rulename = ALPHA *(ALPHA / DIGIT / "-") +;;; +;;; defined-as = *c-wsp ("=" / "=/") *c-wsp +;;; ; basic rules definition and incremental +;;; ; alternatives +;;; +;;; elements = alternation *c-wsp +;;; +;;; c-wsp = WSP / (c-nl WSP) +;;; +;;; c-nl = comment / CRLF +;;; ; comment or newline +;;; +;;; comment = ";" *(WSP / VCHAR) CRLF + + +(defun ebnf-abn-rule (token) + (let ((name ebnf-abn-lex) + (action ebnf-action) + elements) + (setq ebnf-action nil) + (or (eq token 'non-terminal) + (error "Invalid rule name")) + (setq token (ebnf-abn-lex)) + (or (memq token '(equal incremental-alternative)) + (error "Invalid rule: missing `=' or `=/'")) + (and (eq token 'incremental-alternative) + (setq name (concat name " =/"))) + (setq elements (ebnf-abn-alternation)) + (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-abn-lex) + (ebnf-make-production name elements action)))) + + +;;; alternation = concatenation +;;; *(*c-wsp "/" *c-wsp concatenation) + + +(defun ebnf-abn-alternation () + (let (body concatenation) + (while (eq (car (setq concatenation + (ebnf-abn-concatenation (ebnf-abn-lex)))) + 'alternative) + (setq body (cons (cdr concatenation) body))) + (ebnf-token-alternative body concatenation))) + + +;;; concatenation = repetition *(1*c-wsp repetition) + + +(defun ebnf-abn-concatenation (token) + (let ((term (ebnf-abn-repetition token)) + seq) + (or (setq token (car term) + term (cdr term)) + (error "Empty element")) + (setq seq (cons term seq)) + (while (setq term (ebnf-abn-repetition token) + token (car term) + term (cdr term)) + (setq seq (cons term seq))) + (cons token + (if (= (length seq) 1) + ;; sequence with only one element + (car seq) + ;; a real sequence + (ebnf-make-sequence (nreverse seq)))))) + + +;;; repetition = [repeat] element +;;; +;;; repeat = 1*DIGIT / (*DIGIT "*" *DIGIT) + + +(defun ebnf-abn-repetition (token) + (let (lower upper) + ;; INTEGER [ "*" [ INTEGER ] ] + (when (eq token 'integer) + (setq lower ebnf-abn-lex + token (ebnf-abn-lex)) + (or (eq token 'repeat) + (setq upper lower))) + ;; "*" [ INTEGER ] + (when (eq token 'repeat) + ;; only * ==> lower & upper are empty string + (or lower + (setq lower "" + upper "")) + (when (eq (setq token (ebnf-abn-lex)) 'integer) + (setq upper ebnf-abn-lex + token (ebnf-abn-lex)))) + (let ((element (ebnf-abn-element token))) + (cond + ;; there is a repetition + (lower + (or element + (error "Missing element repetition")) + (setq token (ebnf-abn-lex)) + (cond + ;; one or more + ((and (string= lower "1") (null upper)) + (cons token (ebnf-make-one-or-more element))) + ;; zero or more + ((or (and (string= lower "0") (null upper)) + (and (string= lower "") (string= upper ""))) + (cons token (ebnf-make-zero-or-more element))) + ;; real repetition + (t + (ebnf-token-repeat lower (cons token element) upper)))) + ;; there is an element + (element + (cons (ebnf-abn-lex) element)) + ;; something that caller has to deal + (t + (cons token nil)))))) + + +;;; element = rulename / group / option / +;;; char-val / num-val / prose-val +;;; +;;; group = "(" *c-wsp alternation *c-wsp ")" +;;; +;;; option = "[" *c-wsp alternation *c-wsp "]" +;;; +;;; char-val = DQUOTE *(%x20-21 / %x23-7E) DQUOTE +;;; ; quoted string of SP and VCHAR without DQUOTE +;;; +;;; num-val = "%" (bin-val / dec-val / hex-val) +;;; +;;; bin-val = "b" 1*BIT +;;; [ 1*("." 1*BIT) / ("-" 1*BIT) ] +;;; ; series of concatenated bit values +;;; ; or single ONEOF range +;;; +;;; dec-val = "d" 1*DIGIT +;;; [ 1*("." 1*DIGIT) / ("-" 1*DIGIT) ] +;;; +;;; hex-val = "x" 1*HEXDIG +;;; [ 1*("." 1*HEXDIG) / ("-" 1*HEXDIG) ] +;;; +;;; prose-val = "<" *(%x20-3D / %x3F-7E) ">" +;;; ; bracketed string of SP and VCHAR without +;;; ; angles +;;; ; prose description, to be used as last resort + + +(defun ebnf-abn-element (token) + (cond + ;; terminal + ((eq token 'terminal) + (ebnf-make-terminal ebnf-abn-lex)) + ;; non-terminal + ((eq token 'non-terminal) + (ebnf-make-non-terminal ebnf-abn-lex)) + ;; group + ((eq token 'begin-group) + (let ((body (ebnf-abn-alternation))) + (or (eq (car body) 'end-group) + (error "Missing `)'")) + (cdr body))) + ;; optional + ((eq token 'begin-optional) + (let ((body (ebnf-abn-alternation))) + (or (eq (car body) 'end-optional) + (error "Missing `]'")) + (ebnf-token-optional (cdr body)))) + ;; no element + (t + nil) + )) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Lexical analyzer + + +(defconst ebnf-abn-token-table (make-vector 256 'error) + "Vector used to map characters to a lexical token.") + + +(defun ebnf-abn-initialize () + "Initialize EBNF token table." + ;; control character & control 8-bit character are set to `error' + (let ((char ?\060)) + ;; digits: 0-9 + (while (< char ?\072) + (aset ebnf-abn-token-table char 'integer) + (setq char (1+ char))) + ;; printable character: A-Z + (setq char ?\101) + (while (< char ?\133) + (aset ebnf-abn-token-table char 'non-terminal) + (setq char (1+ char))) + ;; printable character: a-z + (setq char ?\141) + (while (< char ?\173) + (aset ebnf-abn-token-table char 'non-terminal) + (setq char (1+ char))) + ;; European 8-bit accentuated characters: + (setq char ?\240) + (while (< char ?\400) + (aset ebnf-abn-token-table char 'non-terminal) + (setq char (1+ char))) + ;; Override end of line characters: + (aset ebnf-abn-token-table ?\n 'end-of-rule) ; [NL] linefeed + (aset ebnf-abn-token-table ?\r 'end-of-rule) ; [CR] carriage return + ;; Override space characters: + (aset ebnf-abn-token-table ?\013 'space) ; [VT] vertical tab + (aset ebnf-abn-token-table ?\t 'space) ; [HT] horizontal tab + (aset ebnf-abn-token-table ?\ 'space) ; [SP] space + ;; Override form feed character: + (aset ebnf-abn-token-table ?\f 'form-feed) ; [FF] form feed + ;; Override other lexical characters: + (aset ebnf-abn-token-table ?< 'non-terminal) + (aset ebnf-abn-token-table ?% 'terminal) + (aset ebnf-abn-token-table ?\" 'terminal) + (aset ebnf-abn-token-table ?\( 'begin-group) + (aset ebnf-abn-token-table ?\) 'end-group) + (aset ebnf-abn-token-table ?* 'repeat) + (aset ebnf-abn-token-table ?= 'equal) + (aset ebnf-abn-token-table ?\[ 'begin-optional) + (aset ebnf-abn-token-table ?\] 'end-optional) + (aset ebnf-abn-token-table ?/ 'alternative) + ;; Override comment character: + (aset ebnf-abn-token-table ?\; 'comment))) + + +;; replace the range "\240-\377" (see `ebnf-range-regexp'). +(defconst ebnf-abn-non-terminal-chars + (ebnf-range-regexp "-_0-9A-Za-z" ?\240 ?\377)) +(defconst ebnf-abn-non-terminal-letter-chars + (ebnf-range-regexp "A-Za-z" ?\240 ?\377)) + + +(defun ebnf-abn-lex () + "Lexical analyser for ABNF. + +Return a lexical token. + +See documentation for variable `ebnf-abn-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-abn-token-table (following-char))) + (cond + ((eq token 'space) + (skip-chars-forward " \013\t" ebnf-limit) + (< (point) ebnf-limit)) + ((eq token 'comment) + (ebnf-abn-skip-comment)) + ((eq token 'form-feed) + (forward-char) + (setq ebnf-action 'form-feed)) + ((eq token 'end-of-rule) + (ebnf-abn-skip-end-of-rule)) + (t nil) + ))) + (cond + ;; end of input + ((>= (point) ebnf-limit) + 'end-of-input) + ;; error + ((eq token 'error) + (error "Illegal character")) + ;; end of rule + ((eq token 'end-of-rule) + 'end-of-rule) + ;; integer + ((eq token 'integer) + (setq ebnf-abn-lex (ebnf-buffer-substring "0-9")) + 'integer) + ;; terminal: "string" or %[bdx]NNN((.NNN)+|-NNN)? + ((eq token 'terminal) + (setq ebnf-abn-lex + (if (= (following-char) ?\") + (ebnf-abn-string) + (ebnf-abn-character))) + 'terminal) + ;; non-terminal: NAME or <NAME> + ((eq token 'non-terminal) + (let ((prose-p (= (following-char) ?<))) + (when prose-p + (forward-char) + (or (looking-at ebnf-abn-non-terminal-letter-chars) + (error "Invalid prose value"))) + (setq ebnf-abn-lex + (ebnf-buffer-substring ebnf-abn-non-terminal-chars)) + (when prose-p + (or (= (following-char) ?>) + (error "Invalid prose value")) + (setq ebnf-abn-lex (concat "<" ebnf-abn-lex ">")))) + 'non-terminal) + ;; equal: =, =/ + ((eq token 'equal) + (forward-char) + (if (/= (following-char) ?/) + 'equal + (forward-char) + 'incremental-alternative)) + ;; miscellaneous: (, ), [, ], /, * + (t + (forward-char) + token) + )))) + + +(defun ebnf-abn-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-abn-skip-comment)))) + (not eor-p))) + + +;; replace the range "\177-\237" (see `ebnf-range-regexp'). +(defconst ebnf-abn-comment-chars + (ebnf-range-regexp "^\n\000-\010\016-\037" ?\177 ?\237)) + + +(defun ebnf-abn-skip-comment () + (forward-char) + (cond + ;; open EPS file + ((and ebnf-eps-executing (= (following-char) ?\[)) + (ebnf-eps-add-context (ebnf-abn-eps-filename))) + ;; close EPS file + ((and ebnf-eps-executing (= (following-char) ?\])) + (ebnf-eps-remove-context (ebnf-abn-eps-filename))) + ;; any other action in comment + (t + (setq ebnf-action (aref ebnf-comment-table (following-char))) + (skip-chars-forward ebnf-abn-comment-chars ebnf-limit)) + ) + ;; check for a valid end of comment + (cond ((>= (point) ebnf-limit) + nil) + ((= (following-char) ?\n) + t) + (t + (error "Illegal character")) + )) + + +(defun ebnf-abn-eps-filename () + (forward-char) + (ebnf-buffer-substring ebnf-abn-comment-chars)) + + +;; replace the range "\240-\377" (see `ebnf-range-regexp'). +(defconst ebnf-abn-string-chars + (ebnf-range-regexp " -!#-~" ?\240 ?\377)) + + +(defun ebnf-abn-string () + (buffer-substring-no-properties + (progn + (forward-char) + (point)) + (progn + (skip-chars-forward ebnf-abn-string-chars ebnf-limit) + (or (= (following-char) ?\") + (error "Missing `\"'")) + (prog1 + (point) + (forward-char))))) + + +(defun ebnf-abn-character () + ;; %[bdx]NNN((-NNN)|(.NNN)+)? + (buffer-substring-no-properties + (point) + (progn + (forward-char) + (let* ((char (following-char)) + (chars (cond ((or (= char ?B) (= char ?b)) "01") + ((or (= char ?D) (= char ?d)) "0-9") + ((or (= char ?X) (= char ?x)) "0-9A-Fa-f") + (t (error "Invalid terminal value"))))) + (forward-char) + (or (> (skip-chars-forward chars ebnf-limit) 0) + (error "Invalid terminal value")) + (if (= (following-char) ?-) + (progn + (forward-char) + (or (> (skip-chars-forward chars ebnf-limit) 0) + (error "Invalid terminal value range"))) + (while (= (following-char) ?.) + (forward-char) + (or (> (skip-chars-forward chars ebnf-limit) 0) + (error "Invalid terminal value"))))) + (point)))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +(provide 'ebnf-abn) + +;;; arch-tag: 8d1b3c4d-4226-4393-b9ae-b7ccf07cf779 +;;; ebnf-abn.el ends here
--- a/lisp/progmodes/ebnf-bnf.el Thu Feb 26 00:37:31 2004 +0000 +++ b/lisp/progmodes/ebnf-bnf.el Thu Feb 26 00:39:34 2004 +0000 @@ -1,12 +1,13 @@ ;;; ebnf-bnf.el --- parser for EBNF -;; Copyright (C) 1999, 2000, 2001 Free Sofware Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004 +;; Free Sofware Foundation, Inc. -;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br> -;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br> +;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Time-stamp: <2004/02/22 14:25:06 vinicius> ;; Keywords: wp, ebnf, PostScript -;; Time-stamp: <2003-02-10 10:29:48 jbarranquero> -;; Version: 1.7 +;; Version: 1.8 ;; This file is part of GNU Emacs. @@ -462,9 +463,9 @@ 'integer) ;; special: ?special? ((eq token 'special) - (setq ebnf-bnf-lex (concat "?" + (setq ebnf-bnf-lex (concat (and ebnf-special-show-delimiter "?") (ebnf-string " ->@-~" ?\? "special") - "?")) + (and ebnf-special-show-delimiter "?"))) 'special) ;; terminal: "string" ((eq token 'terminal)
--- a/lisp/progmodes/ebnf-iso.el Thu Feb 26 00:37:31 2004 +0000 +++ b/lisp/progmodes/ebnf-iso.el Thu Feb 26 00:39:34 2004 +0000 @@ -1,12 +1,13 @@ ;;; ebnf-iso.el --- parser for ISO EBNF -;; Copyright (C) 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004 +;; Free Software Foundation, Inc. -;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br> -;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br> +;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Time-stamp: <2004/02/22 14:24:55 vinicius> ;; Keywords: wp, ebnf, PostScript -;; Time-stamp: <2003/08/12 21:29:14 vinicius> -;; Version: 1.6 +;; Version: 1.7 ;; This file is part of GNU Emacs. @@ -112,7 +113,7 @@ ;; ISO EBNF accepts the characters given by <character> production above, ;; HORIZONTAL TAB (^I), VERTICAL TAB (^K), NEWLINE (^J or ^M) and FORM FEED ;; (^L), any other characters are illegal. But ebnf2ps accepts also the -;; european 8-bit accentuated characters (from \240 to \377). +;; european 8-bit accentuated characters (from \240 to \377) and underscore. ;; ;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -346,6 +347,7 @@ ;; Override form feed character: (aset table ?\f 'form-feed) ; [FF] form feed ;; Override other lexical characters: + (aset table ?_ 'non-terminal) (aset table ?\" 'double-terminal) (aset table ?\' 'single-terminal) (aset table ?\? 'special) @@ -390,7 +392,7 @@ ;; replace the range "\240-\377" (see `ebnf-range-regexp'). (defconst ebnf-iso-non-terminal-chars - (ebnf-range-regexp " 0-9A-Za-z" ?\240 ?\377)) + (ebnf-range-regexp " 0-9A-Za-z_" ?\240 ?\377)) (defun ebnf-iso-lex () @@ -439,9 +441,9 @@ 'integer) ;; special: ?special? ((eq token 'special) - (setq ebnf-iso-lex (concat "?" + (setq ebnf-iso-lex (concat (and ebnf-special-show-delimiter "?") (ebnf-string " ->@-~" ?\? "special") - "?")) + (and ebnf-special-show-delimiter "?"))) 'special) ;; terminal: "string" ((eq token 'double-terminal)
--- a/lisp/progmodes/ebnf-otz.el Thu Feb 26 00:37:31 2004 +0000 +++ b/lisp/progmodes/ebnf-otz.el Thu Feb 26 00:39:34 2004 +0000 @@ -1,11 +1,12 @@ ;;; ebnf-otz.el --- syntactic chart OpTimiZer -;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004 +;; Free Sofware Foundation, Inc. -;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br> -;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br> +;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Time-stamp: <2004/02/22 14:24:37 vinicius> ;; Keywords: wp, ebnf, PostScript -;; Time-stamp: <2003-02-10 10:46:51 jbarranquero> ;; Version: 1.0 ;; This file is part of GNU Emacs.
--- a/lisp/progmodes/ebnf-yac.el Thu Feb 26 00:37:31 2004 +0000 +++ b/lisp/progmodes/ebnf-yac.el Thu Feb 26 00:39:34 2004 +0000 @@ -1,12 +1,13 @@ ;;; ebnf-yac.el --- parser for Yacc/Bison -;; Copyright (C) 1999, 2000, 2001 Free Sofware Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004 +;; Free Sofware Foundation, Inc. -;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br> -;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br> +;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Time-stamp: <2004/02/22 14:24:17 vinicius> ;; Keywords: wp, ebnf, PostScript -;; Time-stamp: <2003-02-10 10:47:04 jbarranquero> -;; Version: 1.2 +;; Version: 1.2.1 ;; This file is part of GNU Emacs. @@ -42,7 +43,9 @@ ;; ;; YACC = { YACC-Definitions }* "%%" { YACC-Rule }* [ "%%" [ YACC-Code ] ]. ;; -;; YACC-Definitions = "%token" [ "<" Name ">" ] Name-List +;; YACC-Definitions = ( "%token" | "%left" | "%right" | "%nonassoc" ) +;; [ "<" Name ">" ] Name-List +;; | "%prec" Name ;; | "any other Yacc definition" ;; . ;; @@ -68,6 +71,19 @@ ;; | "//" "any character" "\\n". ;; ;; +;; In other words, a valid Name begins with a letter (upper or lower case) +;; followed by letters, decimal digits, underscore (_) or point (.). For +;; example: this_is_a_valid.name, Another_EXAMPLE, mIxEd.CaSe. +;; +;; +;; Acknowledgements +;; ---------------- +;; +;; Thanks to Matthew K. Junker <junker@alum.mit.edu> for the suggestion to deal +;; with %right, %left and %prec pragmas. His suggestion was extended to deal +;; with %nonassoc pragma too. +;; +;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Code: @@ -126,7 +142,9 @@ syntax-list)) -;;; YACC-Definitions = "%token" [ "<" Name ">" ] Name-List +;;; YACC-Definitions = ( "%token" | "%left" | "%right" | "%nonassoc" ) +;;; [ "<" Name ">" ] Name-List +;;; | "%prec" Name ;;; | "any other Yacc definition" ;;; . @@ -135,7 +153,8 @@ (while (not (memq token '(yac-separator end-of-input))) (setq token (cond - ;; "%token" [ "<" Name ">" ] Name-List + ;; ( "%token" | "%left" | "%right" | "%nonassoc" ) + ;; [ "<" Name ">" ] Name-List ((eq token 'yac-token) (setq token (ebnf-yac-lex)) (when (eq token 'open-angle) @@ -148,7 +167,12 @@ ebnf-yac-token-list (nconc (cdr token) ebnf-yac-token-list)) (car token)) - ;; "any other Yacc definition" + ;; "%prec" Name + ((eq token 'yac-prec) + (or (eq (ebnf-yac-lex) 'non-terminal) + (error "Missing prec name")) + (ebnf-yac-lex)) + ;; "any other Yacc definition" (t (ebnf-yac-lex)) ))) @@ -360,9 +384,13 @@ ((eq (following-char) ?%) (forward-char) 'yac-separator) - ;; %TOKEN - ((string= (upcase (ebnf-buffer-substring "0-9A-Za-z_")) "TOKEN") - 'yac-token) + ;; %TOKEN, %RIGHT, %LEFT, %PREC, %NONASSOC + ((cdr (assoc (upcase (ebnf-buffer-substring "0-9A-Za-z_")) + '(("TOKEN" . yac-token) + ("RIGHT" . yac-token) + ("LEFT" . yac-token) + ("NONASSOC" . yac-token) + ("PREC" . yac-prec))))) ;; other Yacc pragmas (t 'yac-pragma)
--- a/lisp/progmodes/ebnf2ps.el Thu Feb 26 00:37:31 2004 +0000 +++ b/lisp/progmodes/ebnf2ps.el Thu Feb 26 00:39:34 2004 +0000 @@ -1,12 +1,13 @@ ;;; ebnf2ps.el --- translate an EBNF to a syntactic chart on PostScript -;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc. - -;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br> -;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br> +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004 +;; Free Software Foundation, Inc. + +;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Time-stamp: <2004/02/24 20:48:53 vinicius> ;; Keywords: wp, ebnf, PostScript -;; Time-stamp: <2003/08/08 23:09:36 vinicius> -;; Version: 3.6.1 +;; Version: 4.0 ;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/ ;; This file is part of GNU Emacs. @@ -26,14 +27,14 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. -(defconst ebnf-version "3.6.1" - "ebnf2ps.el, v 3.6.1 <2001/09/24 vinicius> +(defconst ebnf-version "4.0" + "ebnf2ps.el, v 4.0 <2004/02/24 vinicius> Vinicius's last change version. When reporting bugs, please also report the version of Emacs, if any, that ebnf2ps was running with. Please send all bug fixes and enhancements to - Vinicius Jose Latorre <vinicius@cpqd.com.br>. + Vinicius Jose Latorre <viniciusjl@ig.com.br>. ") @@ -72,10 +73,16 @@ ;; ebnf2ps provides six commands for generating PostScript syntactic chart ;; images of Emacs buffers: ;; +;; ebnf-print-directory +;; ebnf-print-file ;; ebnf-print-buffer ;; ebnf-print-region +;; ebnf-spool-directory +;; ebnf-spool-file ;; ebnf-spool-buffer ;; ebnf-spool-region +;; ebnf-eps-directory +;; ebnf-eps-file ;; ebnf-eps-buffer ;; ebnf-eps-region ;; @@ -110,12 +117,16 @@ ;; you'll be asked to confirm the exit; this is modeled on the confirmation ;; that Emacs uses for modified buffers. ;; -;; The word "buffer" or "region" in the command name determines how much of the -;; buffer is printed: -;; -;; buffer - Print the entire buffer. -;; -;; region - Print just the current region. +;; The word "directory", "file", "buffer" or "region" in the command name +;; determines how much of the buffer is printed: +;; +;; directory - Read files in the directory and print them. +;; +;; file - Read file and print it. +;; +;; buffer - Print the entire buffer. +;; +;; region - Print just the current region. ;; ;; Two ebnf- command examples: ;; @@ -126,9 +137,10 @@ ;; spool the image in Emacs to send to the printer ;; later. ;; -;; Note that `ebnf-eps-buffer' and `ebnf-eps-region' never spool the EPS image, -;; so they don't use the ps-print spooling mechanism. See section "Actions in -;; Comments" for an explanation about EPS file generation. +;; Note that `ebnf-eps-directory', `ebnf-eps-file', `ebnf-eps-buffer' and +;; `ebnf-eps-region' never spool the EPS image, so they don't use the ps-print +;; spooling mechanism. See section "Actions in Comments" for an explanation +;; about EPS file generation. ;; ;; ;; Invoking Ebnf2ps @@ -223,14 +235,30 @@ ;; . ;; ;; non_terminal = "[!#%&'*-,0-:<>@-Z\\\\^-z~\\240-\\377]+". +;; ;; that is, a valid non_terminal accepts decimal digits, letters (upper +;; ;; and lower), 8-bit accentuated characters, +;; ;; "!", "#", "%", "&", "'", "*", "+", ",", ":", +;; ;; "<", ">", "@", "\", "^", "_", "`" and "~". ;; ;; terminal = "\\([^\"\\]\\|\\\\[ -~\\240-\\377]\\)+". -;; -;; special = "[^?\\n\\000-\\010\\016-\\037\\177-\\237]*". +;; ;; that is, a valid terminal accepts any printable character (including +;; ;; 8-bit accentuated characters) except `"', as `"' is used to delimit a +;; ;; terminal. Also, accepts escaped characters, that is, a character +;; ;; pair starting with `\' followed by a printable character, for +;; ;; example: \", \\. +;; +;; special = "[^?\\000-\\010\\012-\\037\\177-\\237]*". +;; ;; that is, a valid special accepts any printable character (including +;; ;; 8-bit accentuated characters) and tabs except `?', as `?' is used to +;; ;; delimit a special. ;; ;; integer = "[0-9]+". +;; ;; that is, an integer is a sequence of one or more decimal digits. ;; ;; comment = ";" "[^\\n\\000-\\010\\016-\\037\\177-\\237]*" "\\n". +;; ;; that is, a comment starts with the character `;' and terminates at end +;; ;; of line. Also, it only accepts printable characters (including 8-bit +;; ;; accentuated characters) and tabs. ;; ;; Try to use the above EBNF to test ebnf2ps. ;; @@ -273,6 +301,10 @@ ;; `ebnf-terminal-regexp', `ebnf-case-fold-search', ;; `ebnf-lex-comment-char' and `ebnf-lex-eop-char'. ;; +;; `abnf' ebnf2ps recognizes the syntax described in the URL: +;; `http://www.faqs.org/rfcs/rfc2234.html' +;; ("Augmented BNF for Syntax Specifications: ABNF"). +;; ;; `iso-ebnf' ebnf2ps recognizes the syntax described in the URL: ;; `http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html' ;; ("International Standard of the ISO EBNF Notation"). @@ -545,6 +577,9 @@ ;; ;; `ebnf-terminal-border-color' Specify border color for terminal box. ;; +;; `ebnf-production-name-p' Non-nil means production name will be +;; printed. +;; ;; `ebnf-sort-production' Specify how productions are sorted. ;; ;; `ebnf-production-font' Specify production font. @@ -562,6 +597,9 @@ ;; `ebnf-non-terminal-border-color' Specify border color for non-terminal ;; box. ;; +;; `ebnf-special-show-delimiter' Non-nil means special delimiter +;; (character `?') is shown. +;; ;; `ebnf-special-font' Specify special font. ;; ;; `ebnf-special-shape' Specify special box shape. @@ -629,10 +667,16 @@ ;; default terminal, non-terminal or ;; special. ;; +;; `ebnf-file-suffix-regexp' Specify file name suffix that contains +;; EBNF. +;; ;; `ebnf-eps-prefix' Specify EPS prefix file name. ;; ;; `ebnf-use-float-format' Non-nil means use `%f' float format. ;; +;; `ebnf-stop-on-error' Non-nil means signal error and stop. +;; Nil means signal error and continue. +;; ;; `ebnf-yac-ignore-error-recovery' Non-nil means ignore error recovery. ;; ;; `ebnf-ignore-empty-rule' Non-nil means ignore empty rules. @@ -695,21 +739,24 @@ ;; `ebnf-insert-style' Insert a new style NAME with inheritance INHERITS and ;; values VALUES. ;; +;; `ebnf-delete-style' Delete style NAME. +;; ;; `ebnf-merge-style' Merge values of style NAME with style VALUES. ;; -;; `ebnf-apply-style' Set STYLE to current style. +;; `ebnf-apply-style' Set STYLE as the current style. ;; ;; `ebnf-reset-style' Reset current style. ;; -;; `ebnf-push-style' Push the current style and set STYLE to current style. -;; -;; `ebnf-pop-style' Pop a style and set it to current style. -;; -;; These commands helps to put together a lot of variable settings in a group +;; `ebnf-push-style' Push the current style and set STYLE as the current +;; style. +;; +;; `ebnf-pop-style' Pop a style and set it as the current style. +;; +;; These commands help to put together a lot of variable settings in a group ;; and name this group. So when you wish to apply these settings it's only ;; needed to give the name. ;; -;; There is also a notion of simple inheritance of style; so if you declare +;; There is also a notion of simple inheritance of style; so, if you declare ;; that a style A inherits from a style B, all settings of B is applied first ;; and then the settings of A is applied. This is useful when you wish to ;; modify some aspects of an existing style, but at same time wish to keep it @@ -994,6 +1041,17 @@ ;; Acknowledgements ;; ---------------- ;; +;; Thanks to Drew Adams <?@?> for suggestions: +;; - `ebnf-production-name-p', `ebnf-stop-on-error', +;; `ebnf-file-suffix-regexp'and `ebnf-special-show-delimiter' variables. +;; - `ebnf-delete-style', `ebnf-eps-file' and `ebnf-eps-directory' +;; commands. +;; - some docs fix. +;; +;; Thanks to Matthew K. Junker <junker@alum.mit.edu> for the suggestion to deal +;; with some Bison features (%right, %left and %prec pragmas). His suggestion +;; was extended to deal with %nonassoc pragma too. +;; ;; Thanks to all who emailed comments. ;; ;; @@ -1140,6 +1198,12 @@ :group 'ebnf-displacement) +(defcustom ebnf-special-show-delimiter t + "*Non-nil means special delimiter (character `?') is shown." + :type 'boolean + :group 'ebnf-special) + + (defcustom ebnf-special-font '(7 Courier "Black" "Gray95" bold italic) "*Specify special font. @@ -1332,6 +1396,12 @@ :group 'ebnf-terminal) +(defcustom ebnf-production-name-p t + "*Non-nil means production name will be printed." + :type 'boolean + :group 'ebnf-production) + + (defcustom ebnf-sort-production nil "*Specify how productions are sorted. @@ -1482,14 +1552,28 @@ |* * + `semi-up-hollow' `semi-up-full' + * * + |* |* + | * |X* + ==+==* ==+==* + + `semi-down-hollow' `semi-down-full' + ==+==* ==+==* + | * |X* + |* |* + * * + `user' See also documentation for variable `ebnf-user-arrow'. Any other value is treated as `none'." :type '(radio :tag "Arrow Shape" - (const none) (const semi-up) - (const semi-down) (const simple) - (const transparent) (const hollow) - (const full) (const user)) + (const none) (const semi-up) + (const semi-down) (const simple) + (const transparent) (const hollow) + (const full) (const semi-up-hollow) + (const semi-down-hollow) (const semi-up-full) + (const semi-down-full) (const user)) :group 'ebnf-shape) @@ -1553,6 +1637,10 @@ `ebnf-terminal-regexp', `ebnf-case-fold-search', `ebnf-lex-comment-char' and `ebnf-lex-eop-char'. + `abnf' ebnf2ps recognizes the syntax described in the URL: + `http://www.faqs.org/rfcs/rfc2234.html' + (\"Augmented BNF for Syntax Specifications: ABNF\"). + `iso-ebnf' ebnf2ps recognizes the syntax described in the URL: `http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html' (\"International Standard of the ISO EBNF Notation\"). @@ -1567,7 +1655,7 @@ Any other value is treated as `ebnf'." :type '(radio :tag "Syntax" - (const ebnf) (const iso-ebnf) (const yacc)) + (const ebnf) (const abnf) (const iso-ebnf) (const yacc)) :group 'ebnf-syntactic) @@ -1638,6 +1726,14 @@ :group 'ebnf-syntactic) +(defcustom ebnf-file-suffix-regexp "\.[Bb][Nn][Ff]$" + "*Specify file name suffix that contains EBNF. + +See `ebnf-eps-directory' command." + :type 'regexp + :group 'ebnf2ps) + + (defcustom ebnf-eps-prefix "ebnf--" "*Specify EPS prefix file name. @@ -1704,6 +1800,12 @@ :group 'ebnf2ps) +(defcustom ebnf-stop-on-error nil + "*Non-nil means signal error and stop. Nil means signal error and continue." + :type 'boolean + :group 'ebnf2ps) + + (defcustom ebnf-yac-ignore-error-recovery nil "*Non-nil means ignore error recovery. @@ -1763,6 +1865,34 @@ ;;;###autoload +(defun ebnf-print-directory (&optional directory) + "Generate and print a PostScript syntactic chart image of DIRECTORY. + +If DIRECTORY is nil, it's used `default-directory'. + +The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are +processed. + +See also `ebnf-print-buffer'." + (interactive + (list (read-file-name "Directory containing EBNF files (print): " + nil default-directory))) + (ebnf-directory 'ebnf-print-buffer directory)) + + +;;;###autoload +(defun ebnf-print-file (file &optional do-not-kill-buffer-when-done) + "Generate and print a PostScript syntactic chart image of the file FILE. + +If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't +killed after process termination. + +See also `ebnf-print-buffer'." + (interactive "fEBNF file to generate PostScript and print from: ") + (ebnf-file 'ebnf-print-buffer file do-not-kill-buffer-when-done)) + + +;;;###autoload (defun ebnf-print-buffer (&optional filename) "Generate and print a PostScript syntactic chart image of the buffer. @@ -1789,6 +1919,34 @@ ;;;###autoload +(defun ebnf-spool-directory (&optional directory) + "Generate and spool a PostScript syntactic chart image of DIRECTORY. + +If DIRECTORY is nil, it's used `default-directory'. + +The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are +processed. + +See also `ebnf-spool-buffer'." + (interactive + (list (read-file-name "Directory containing EBNF files (spool): " + nil default-directory))) + (ebnf-directory 'ebnf-spool-buffer directory)) + + +;;;###autoload +(defun ebnf-spool-file (file &optional do-not-kill-buffer-when-done) + "Generate and spool a PostScript syntactic chart image of the file FILE. + +If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't +killed after process termination. + +See also `ebnf-spool-buffer'." + (interactive "fEBNF file to generate PostScript and spool from: ") + (ebnf-file 'ebnf-spool-buffer file do-not-kill-buffer-when-done)) + + +;;;###autoload (defun ebnf-spool-buffer () "Generate and spool a PostScript syntactic chart image of the buffer. Like `ebnf-print-buffer' except that the PostScript image is saved in a @@ -1810,6 +1968,34 @@ ;;;###autoload +(defun ebnf-eps-directory (&optional directory) + "Generate EPS files from EBNF files in DIRECTORY. + +If DIRECTORY is nil, it's used `default-directory'. + +The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are +processed. + +See also `ebnf-eps-buffer'." + (interactive + (list (read-file-name "Directory containing EBNF files (EPS): " + nil default-directory))) + (ebnf-directory 'ebnf-eps-buffer directory)) + + +;;;###autoload +(defun ebnf-eps-file (file &optional do-not-kill-buffer-when-done) + "Generate an EPS file from EBNF file FILE. + +If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't +killed after EPS generation. + +See also `ebnf-eps-buffer'." + (interactive "fEBNF file to generate EPS file from: ") + (ebnf-file 'ebnf-eps-buffer file do-not-kill-buffer-when-done)) + + +;;;###autoload (defun ebnf-eps-buffer () "Generate a PostScript syntactic chart image of the buffer in a EPS file. @@ -1883,7 +2069,8 @@ " ;;; ebnf2ps.el version %s -\(setq ebnf-special-font %s +\(setq ebnf-special-show-delimiter %S + ebnf-special-font %s ebnf-special-shape %s ebnf-special-shadow %S ebnf-special-border-width %S @@ -1910,6 +2097,7 @@ ebnf-non-terminal-shadow %S ebnf-non-terminal-border-width %S ebnf-non-terminal-border-color %S + ebnf-production-name-p %S ebnf-sort-production %s ebnf-production-font %s ebnf-arrow-shape %s @@ -1925,6 +2113,7 @@ ebnf-syntax %s ebnf-iso-alternative-p %S ebnf-iso-normalize-p %S + ebnf-file-suffix-regexp %S ebnf-eps-prefix %S ebnf-entry-percentage %S ebnf-color-p %S @@ -1932,6 +2121,7 @@ ebnf-line-color %S ebnf-debug-ps %S ebnf-use-float-format %S + ebnf-stop-on-error %S ebnf-yac-ignore-error-recovery %S ebnf-ignore-empty-rule %S ebnf-optimize %S) @@ -1939,6 +2129,7 @@ ;;; ebnf2ps.el - end of settings " ebnf-version + ebnf-special-show-delimiter (ps-print-quote ebnf-special-font) (ps-print-quote ebnf-special-shape) ebnf-special-shadow @@ -1966,6 +2157,7 @@ ebnf-non-terminal-shadow ebnf-non-terminal-border-width ebnf-non-terminal-border-color + ebnf-production-name-p (ps-print-quote ebnf-sort-production) (ps-print-quote ebnf-production-font) (ps-print-quote ebnf-arrow-shape) @@ -1981,6 +2173,7 @@ (ps-print-quote ebnf-syntax) ebnf-iso-alternative-p ebnf-iso-normalize-p + ebnf-file-suffix-regexp ebnf-eps-prefix ebnf-entry-percentage ebnf-color-p @@ -1988,6 +2181,7 @@ ebnf-line-color ebnf-debug-ps ebnf-use-float-format + ebnf-stop-on-error ebnf-yac-ignore-error-recovery ebnf-ignore-empty-rule ebnf-optimize)) @@ -2007,7 +2201,8 @@ (defconst ebnf-style-custom-list - '(ebnf-special-font + '(ebnf-special-show-delimiter + ebnf-special-font ebnf-special-shape ebnf-special-shadow ebnf-special-border-width @@ -2034,6 +2229,7 @@ ebnf-non-terminal-shadow ebnf-non-terminal-border-width ebnf-non-terminal-border-color + ebnf-production-name-p ebnf-sort-production ebnf-production-font ebnf-arrow-shape @@ -2049,6 +2245,7 @@ ebnf-syntax ebnf-iso-alternative-p ebnf-iso-normalize-p + ebnf-file-suffix-regexp ebnf-eps-prefix ebnf-entry-percentage ebnf-color-p @@ -2056,6 +2253,7 @@ ebnf-line-color ebnf-debug-ps ebnf-use-float-format + ebnf-stop-on-error ebnf-yac-ignore-error-recovery ebnf-ignore-empty-rule ebnf-optimize) @@ -2066,6 +2264,7 @@ '(;; EBNF default (default nil + (ebnf-special-show-delimiter . t) (ebnf-special-font . '(7 Courier "Black" "Gray95" bold italic)) (ebnf-special-shape . 'bevel) (ebnf-special-shadow . nil) @@ -2093,6 +2292,7 @@ (ebnf-non-terminal-shadow . nil) (ebnf-non-terminal-border-width . 1.0) (ebnf-non-terminal-border-color . "Black") + (ebnf-production-name-p . t) (ebnf-sort-production . nil) (ebnf-production-font . '(10 Helvetica "Black" "White" bold)) (ebnf-arrow-shape . 'hollow) @@ -2108,6 +2308,7 @@ (ebnf-syntax . 'ebnf) (ebnf-iso-alternative-p . nil) (ebnf-iso-normalize-p . nil) + (ebnf-file-suffix-regexp . "\.[Bb][Nn][Ff]$") (ebnf-eps-prefix . "ebnf--") (ebnf-entry-percentage . 0.5) (ebnf-color-p . (or (fboundp 'x-color-values) ; Emacs @@ -2116,6 +2317,7 @@ (ebnf-line-color . "Black") (ebnf-debug-ps . nil) (ebnf-use-float-format . t) + (ebnf-stop-on-error . nil) (ebnf-yac-ignore-error-recovery . nil) (ebnf-ignore-empty-rule . nil) (ebnf-optimize . nil)) @@ -2125,6 +2327,10 @@ (ebnf-justify-sequence . 'left) (ebnf-lex-comment-char . ?\#) (ebnf-lex-eop-char . ?\;)) + ;; ABNF default + (abnf + default + (ebnf-syntax . 'abnf)) ;; ISO EBNF default (iso-ebnf default @@ -2138,19 +2344,31 @@ Each element has the following form: - (CUSTOM INHERITS (VAR . VALUE)...) - -CUSTOM is a symbol name style. -INHERITS is a symbol name style from which the current style inherits the -context. If INHERITS is nil, means that there is no inheritance. -VAR is a valid ebnf2ps symbol custom variable. See `ebnf-style-custom-list' -for valid symbol variable. -VALUE is a sexp which it'll be evaluated to set the value to VAR. So, don't -forget to quote symbols and constant lists. See `default' style for an -example. - -Don't handle this variable directly. Use functions `ebnf-insert-style' and -`ebnf-merge-style'.") + (NAME INHERITS (VAR . VALUE)...) + +Where: + +NAME is a symbol name style. + +INHERITS is a symbol name style from which the current style inherits + the context. If INHERITS is nil, means that there is no + inheritance. + + This is a simple inheritance of style; so if you declare that a + style A inherits from a style B, all settings of B is applied + first and then the settings of A is applied. This is useful + when you wish to modify some aspects of an existing style, but + at same time wish to keep it unmodified. + +VAR is a valid ebnf2ps symbol custom variable. + See `ebnf-style-custom-list' for valid symbol variable. + +VALUE is a sexp which it'll be evaluated to set the value to VAR. + So, don't forget to quote symbols and constant lists. + See `default' style for an example. + +Don't handle this variable directly. Use functions `ebnf-insert-style', +`ebnf-delete-style' and `ebnf-merge-style'.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -2159,8 +2377,10 @@ ;;;###autoload (defun ebnf-insert-style (name inherits &rest values) - "Insert a new style NAME with inheritance INHERITS and values VALUES." - (interactive) + "Insert a new style NAME with inheritance INHERITS and values VALUES. + +See `ebnf-style-database' documentation." + (interactive "SStyle name: \nSStyle inherits from: \nXStyle values: ") (and (assoc name ebnf-style-database) (error "Style name already exists: %s" name)) (or (assoc inherits ebnf-style-database) @@ -2171,9 +2391,28 @@ ;;;###autoload +(defun ebnf-delete-style (name) + "Delete style NAME. + +See `ebnf-style-database' documentation." + (interactive "SDelete style name: ") + (or (assoc name ebnf-style-database) + (error "Style name doesn't exist: %s" name)) + (let ((db ebnf-style-database)) + (while db + (and (eq (nth 1 (car db)) name) + (error "Style name `%s' is inherited by `%s' style" + name (nth 0 (car db)))) + (setq db (cdr db)))) + (setq ebnf-style-database (assq-delete-all name ebnf-style-database))) + + +;;;###autoload (defun ebnf-merge-style (name &rest values) - "Merge values of style NAME with style VALUES." - (interactive) + "Merge values of style NAME with style VALUES. + +See `ebnf-style-database' documentation." + (interactive "SStyle name: \nXStyle values: ") (let ((style (or (assoc name ebnf-style-database) (error "Style name does'nt exist: %s" name))) (merge (ebnf-check-style-values values)) @@ -2193,10 +2432,12 @@ ;;;###autoload (defun ebnf-apply-style (style) - "Set STYLE to current style. - -It returns the old style symbol." - (interactive) + "Set STYLE as the current style. + +It returns the old style symbol. + +See `ebnf-style-database' documentation." + (interactive "SApply style: ") (prog1 ebnf-current-style (and (ebnf-apply-style1 style) @@ -2207,18 +2448,22 @@ (defun ebnf-reset-style (&optional style) "Reset current style. -It returns the old style symbol." - (interactive) +It returns the old style symbol. + +See `ebnf-style-database' documentation." + (interactive "SReset style: ") (setq ebnf-stack-style nil) (ebnf-apply-style (or style 'default))) ;;;###autoload (defun ebnf-push-style (&optional style) - "Push the current style and set STYLE to current style. - -It returns the old style symbol." - (interactive) + "Push the current style and set STYLE as the current style. + +It returns the old style symbol. + +See `ebnf-style-database' documentation." + (interactive "SPush style: ") (prog1 ebnf-current-style (setq ebnf-stack-style (cons ebnf-current-style ebnf-stack-style)) @@ -2228,9 +2473,11 @@ ;;;###autoload (defun ebnf-pop-style () - "Pop a style and set it to current style. - -It returns the old style symbol." + "Pop a style and set it as the current style. + +It returns the old style symbol. + +See `ebnf-style-database' documentation." (interactive) (prog1 (ebnf-apply-style (car ebnf-stack-style)) @@ -2249,7 +2496,7 @@ (defun ebnf-check-style-values (values) (let (style) (while values - (and (memq (car values) ebnf-style-custom-list) + (and (memq (caar values) ebnf-style-custom-list) (setq style (cons (car values) style))) (setq values (cdr values))) (nreverse style))) @@ -2297,14 +2544,18 @@ (defconst ebnf-arrow-shape-alist - '((none . 0) - (semi-up . 1) - (semi-down . 2) - (simple . 3) - (transparent . 4) - (hollow . 5) - (full . 6) - (user . 7)) + '((none . 0) + (semi-up . 1) + (semi-down . 2) + (simple . 3) + (transparent . 4) + (hollow . 5) + (full . 6) + (semi-up-hollow . 7) + (semi-up-full . 8) + (semi-down-hollow . 9) + (semi-down-full . 10) + (user . 11)) "Alist associating values for `ebnf-arrow-shape'. See documentation for `ebnf-arrow-shape'.") @@ -2464,19 +2715,39 @@ /ArrowPath{c newpath moveto Arrow closepath}bind def +/UpPath +{c newpath moveto + hT2 neg 0 rmoveto + 0 hT4 rlineto + hT2 hT4 neg rlineto + closepath +}bind def + +/DownPath +{c newpath moveto + hT2 neg 0 rmoveto + 0 hT4 neg rlineto + hT2 hT4 rlineto + closepath +}bind def + %>Right Arrow: RA % \\ % *---+ % / /RA-vector -[{} % 0 - none - {hT2 neg hT4 rlineto} % 1 - semi-up - {Down} % 2 - semi-down - {Arrow} % 3 - simple - {Gstroke ArrowPath} % 4 - transparent - {Gstroke ArrowPath 1 FillGray} % 5 - hollow - {Gstroke ArrowPath LineColor FillRGB} % 6 - full - {Gstroke gsave UserArrow grestore} % 7 - user +[{} % 0 - none + {hT2 neg hT4 rlineto} % 1 - semi-up + {Down} % 2 - semi-down + {Arrow} % 3 - simple + {Gstroke ArrowPath} % 4 - transparent + {Gstroke ArrowPath 1 FillGray} % 5 - hollow + {Gstroke ArrowPath LineColor FillRGB} % 6 - full + {Gstroke UpPath 1 FillGray} % 7 - semi-up-hollow + {Gstroke UpPath LineColor FillRGB} % 8 - semi-up-full + {Gstroke DownPath 1 FillGray} % 9 - semi-down-hollow + {Gstroke DownPath LineColor FillRGB} % 10 - semi-down-full + {Gstroke gsave UserArrow grestore} % 11 - user ]def /RA @@ -3168,10 +3439,11 @@ {xyp neg yp add /yw exch def xp add T sub /xw exch def - /Effect EffectP def - /fP F ForegroundP SetRGB BackgroundP aload pop true BG S - /Effect 0 def - ( :) S false BG + dup length 0 gt % empty string ==> no production name + {/Effect EffectP def + /fP F ForegroundP SetRGB BackgroundP aload pop true BG S + /Effect 0 def + ( :) S false BG}if xw yw moveto hT EL RA xp yw moveto @@ -3909,11 +4181,15 @@ (defun ebnf-generate-production (production) (ebnf-message-info "Generating") (run-hooks 'ebnf-production-hook) - (ps-output-string (ebnf-node-name production)) + (ps-output-string (if ebnf-production-name-p + (ebnf-node-name production) + "")) (ps-output " " (ebnf-format-float (ebnf-node-width production) - (+ ebnf-basic-height + (+ (if ebnf-production-name-p + ebnf-basic-height + 0.0) (ebnf-node-entry (ebnf-node-production production)))) " BOP\n") (ebnf-node-generation (ebnf-node-production production)) @@ -4102,6 +4378,35 @@ ;; Internal functions +(defun ebnf-directory (fun &optional directory) + "Process files in DIRECTORY applying function FUN on each file. + +If DIRECTORY is nil, it's used `default-directory'. + +The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are +processed." + (let ((files (directory-files (or directory default-directory) + t ebnf-file-suffix-regexp))) + (while files + (set-buffer (find-file-noselect (car files))) + (funcall fun) + (setq buffer-backed-up t) ; Do not back it up. + (save-buffer) ; Just save new version. + (kill-buffer (current-buffer)) + (setq files (cdr files))))) + + +(defun ebnf-file (fun file &optional do-not-kill-buffer-when-done) + "Process file FILE applying function FUN. + +If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't +killed after process termination." + (set-buffer (find-file-noselect file)) + (funcall fun) + (or do-not-kill-buffer-when-done + (kill-buffer (current-buffer)))) + + ;; function `ebnf-range-regexp' is used to avoid a bug of `skip-chars-forward' ;; on version 20.4.1, that is, it doesn't accept ranges like "\240-\377" (or ;; "\177-\237"), but it accepts the character sequence from \240 to \377 (or @@ -4143,6 +4448,7 @@ (defun ebnf-generate-region (from to gen-func) (run-hooks 'ebnf-hook) (let ((ebnf-limit (max from to)) + (error-msg "SYNTAX") the-point) (save-excursion (save-restriction @@ -4150,20 +4456,38 @@ (condition-case data (let ((tree (ebnf-parse-and-sort (min from to)))) (when gen-func - (funcall gen-func - (ebnf-dimensions - (ebnf-optimize - (ebnf-eliminate-empty-rules tree)))))) + (setq error-msg "EMPTY RULES" + tree (ebnf-eliminate-empty-rules tree)) + (setq error-msg "OPTMIZE" + tree (ebnf-optimize tree)) + (setq error-msg "DIMENSIONS" + tree (ebnf-dimensions tree)) + (setq error-msg "GENERATION") + (funcall gen-func tree)) + (setq error-msg nil)) ; here it's ok ;; handler ((quit error) (ding) - (setq the-point (max (1- (point)) (point-min))) - (message (error-message-string data))))))) + (setq the-point (max (1- (point)) (point-min)) + error-msg (concat error-msg ": " + (error-message-string data) + (if (string= error-msg "SYNTAX") + (format ". At %d in buffer \"%s\"." + the-point + (buffer-name)) + (format ". In buffer \"%s\"." + (buffer-name)))))))))) (cond - (the-point - (goto-char the-point)) + ;; error occurred + (error-msg + (goto-char the-point) + (if ebnf-stop-on-error + (error error-msg) + (message error-msg))) + ;; generated output OK (gen-func nil) + ;; syntax checked OK (t (message "EBNF syntactic analysis: NO ERRORS."))))) @@ -4267,6 +4591,15 @@ (ebnf-font-select font 'line-height)) +(defconst ebnf-syntax-alist + ;; 0.syntax 1.parser 2.initializer + '((iso-ebnf ebnf-iso-parser ebnf-iso-initialize) + (yacc ebnf-yac-parser ebnf-yac-initialize) + (abnf ebnf-abn-parser ebnf-abn-initialize) + (ebnf ebnf-bnf-parser ebnf-bnf-initialize)) + "Alist associating ebnf syntax with a parser and a initializer.") + + (defun ebnf-begin-job () (ps-printing-region nil nil nil) (if ebnf-use-float-format @@ -4276,15 +4609,10 @@ ebnf-message-float "%s")) (ebnf-otz-initialize) ;; to avoid compilation gripes when calling autoloaded functions - (funcall (cond ((eq ebnf-syntax 'iso-ebnf) - (setq ebnf-parser-func 'ebnf-iso-parser) - 'ebnf-iso-initialize) - ((eq ebnf-syntax 'yacc) - (setq ebnf-parser-func 'ebnf-yac-parser) - 'ebnf-yac-initialize) - (t - (setq ebnf-parser-func 'ebnf-bnf-parser) - 'ebnf-bnf-initialize))) + (let ((init (or (assoc ebnf-syntax ebnf-syntax-alist) + (assoc 'ebnf ebnf-syntax-alist)))) + (setq ebnf-parser-func (nth 1 init)) + (funcall (nth 2 init))) (and ebnf-terminal-regexp ; ensures that it's a string or nil (not (stringp ebnf-terminal-regexp)) (setq ebnf-terminal-regexp nil)) @@ -4588,12 +4916,16 @@ (ebnf-message-info "Calculating dimensions") (ebnf-node-dimension-func (ebnf-node-production production)) (let* ((prod (ebnf-node-production production)) - (height (+ ebnf-font-height-P + (height (+ (if ebnf-production-name-p + ebnf-font-height-P + 0.0) + ebnf-line-width ebnf-line-width ebnf-basic-height (ebnf-node-height prod)))) (ebnf-node-entry production height) (ebnf-node-height production height) (ebnf-node-width production (+ (ebnf-node-width prod) + ebnf-line-width ebnf-horizontal-space)))) @@ -4850,7 +5182,7 @@ ;; [one-or-more width-fun dim-fun entry height width element separator] ;; [zero-or-more width-fun dim-fun entry height width element separator] -(defun ebnf-list-width (or-more width) +(defun ebnf-element-width (or-more width) (setq width (- width ebnf-horizontal-space)) (ebnf-node-list or-more (ebnf-justify-list or-more @@ -4881,7 +5213,10 @@ ;; right justify terms ((eq ebnf-justify-sequence 'right) (ebnf-justify node seq seq-width width nil)) - ;; centralize terms + ;; centralize terms -- element + ((vectorp seq) + (ebnf-adjust-width seq width)) + ;; centralize terms -- list (t (let ((the-width (/ (- width seq-width) (length seq))) (lis seq)) @@ -5040,10 +5375,11 @@ 0.0 0.0 (let ((len (length name))) - (cond ((> len 2) name) - ((= len 2) (concat " " name)) - ((= len 1) (concat " " name " ")) - (t " "))) + (cond ((> len 3) name) + ((= len 3) (concat name " ")) + ((= len 2) (concat " " name " ")) + ((= len 1) (concat " " name " ")) + (t " "))) ebnf-default-p)) @@ -5063,7 +5399,7 @@ (defun ebnf-make-or-more1 (gen-func dim-func list-part sep-part) (vector gen-func - 'ebnf-list-width + 'ebnf-element-width dim-func 0.0 0.0 @@ -5119,14 +5455,25 @@ exception)) -(defun ebnf-make-repeat (times primary) +(defun ebnf-make-repeat (times primary &optional upper) (vector 'ebnf-generate-repeat 'ignore 'ebnf-repeat-dimension 0.0 0.0 0.0 - (concat times " *") + (cond ((and times upper) ; L * U, L * L + (if (string= times upper) + (if (string= times "") + " * " + times) + (concat times " * " upper))) + (times ; L * + (concat times " *")) + (upper ; * U + (concat "* " upper)) + (t ; * + " * ")) primary)) @@ -5198,13 +5545,13 @@ ))))) -(defun ebnf-token-repeat (times repeat) +(defun ebnf-token-repeat (times repeat &optional upper) (if (null (cdr repeat)) ;; n * EMPTY ==> EMPTY repeat ;; n * term (cons (car repeat) - (ebnf-make-repeat times (cdr repeat))))) + (ebnf-make-repeat times (cdr repeat) upper)))) (defun ebnf-token-optional (body) @@ -5263,6 +5610,12 @@ ;; To make this file smaller, some commands go in a separate file. ;; But autoload them here to make the separation invisible. +(autoload 'ebnf-abn-parser "ebnf-abn" + "ABNF parser.") + +(autoload 'ebnf-abn-initialize "ebnf-abn" + "Initialize ABNF token table.") + (autoload 'ebnf-bnf-parser "ebnf-bnf" "EBNF parser.")
--- a/src/ChangeLog Thu Feb 26 00:37:31 2004 +0000 +++ b/src/ChangeLog Thu Feb 26 00:39:34 2004 +0000 @@ -1,3 +1,32 @@ +2004-02-26 Kim F. Storm <storm@cua.dk> + + * xdisp.c (handle_single_display_prop): Handle left-fringe and + right-fringe similar to a display margin image. Specifically, + the characters having the fringe prop are no longer shown, and + we use IT_IMAGE/next_element_from_image with image_id = -1 to + do this. Set fringe bitmap face_id in it->face_id. + (produce_image_glyph): Handle image_id < 0 as "no image" case, but + still realize it->face (i.e. the fringe bitmap face). + +2004-02-25 Miles Bader <miles@gnu.org> + + * xdisp.c (check_it): Check string/string_pos consistency. + (init_iterator): Initialize string-related fields properly. + +2004-02-11 Miles Bader <miles@gnu.org> + + * xdisp.c (produce_image_glyph): Force negative descents to zero. + +2004-02-10 Miles Bader <miles@gnu.org> + + * xfns.c (lookup_image): Remove xassert(!interrupt_input_blocked); + BLOCK_INPUT can be nested, so it doesn't make much sense. + +2004-02-24 Michael Mauger <mmaug@yahoo.com> + + * w32fns.c (slurp_file, xbm_scan, xbm_load_image) + (xbm_read_bitmap_data): Use unsigned char for image data. + 2004-02-23 Luc Teirlinck <teirllm@auburn.edu> * abbrev.c (Finsert_abbrev_table_description): Doc fix.
--- a/src/w32fns.c Thu Feb 26 00:37:31 2004 +0000 +++ b/src/w32fns.c Thu Feb 26 00:39:34 2004 +0000 @@ -8243,7 +8243,7 @@ ***********************************************************************/ static Lisp_Object x_find_image_file P_ ((Lisp_Object)); -static char *slurp_file P_ ((char *, int *)); +static unsigned char *slurp_file P_ ((char *, int *)); /* Find image file FILE. Look in data-directory, then @@ -8279,13 +8279,13 @@ with xmalloc holding FILE's contents. Value is null if an error occurred. *SIZE is set to the size of the file. */ -static char * +static unsigned char * slurp_file (file, size) char *file; int *size; { FILE *fp = NULL; - char *buf = NULL; + unsigned char *buf = NULL; struct stat st; if (stat (file, &st) == 0 @@ -8316,13 +8316,13 @@ XBM images ***********************************************************************/ -static int xbm_scan P_ ((char **, char *, char *, int *)); +static int xbm_scan P_ ((unsigned char **, unsigned char *, char *, int *)); static int xbm_load P_ ((struct frame *f, struct image *img)); static int xbm_load_image P_ ((struct frame *f, struct image *img, - char *, char *)); + unsigned char *, unsigned char *)); static int xbm_image_p P_ ((Lisp_Object object)); -static int xbm_read_bitmap_data P_ ((char *, char *, int *, int *, - unsigned char **)); +static int xbm_read_bitmap_data P_ ((unsigned char *, unsigned char *, + int *, int *, unsigned char **)); static int xbm_file_p P_ ((Lisp_Object)); @@ -8511,11 +8511,11 @@ static int xbm_scan (s, end, sval, ival) - char **s, *end; + unsigned char **s, *end; char *sval; int *ival; { - int c; + unsigned int c; loop: @@ -8645,11 +8645,11 @@ static int xbm_read_bitmap_data (contents, end, width, height, data) - char *contents, *end; + unsigned char *contents, *end; int *width, *height; unsigned char **data; { - char *s = contents; + unsigned char *s = contents; char buffer[BUFSIZ]; int padding_p = 0; int v10 = 0; @@ -8827,7 +8827,7 @@ xbm_load_image (f, img, contents, end) struct frame *f; struct image *img; - char *contents, *end; + unsigned char *contents, *end; { int rc; unsigned char *data; @@ -8915,7 +8915,7 @@ if (STRINGP (file_name)) { Lisp_Object file; - char *contents; + unsigned char *contents; int size; struct gcpro gcpro1;
--- a/src/xdisp.c Thu Feb 26 00:37:31 2004 +0000 +++ b/src/xdisp.c Thu Feb 26 00:39:34 2004 +0000 @@ -1900,10 +1900,14 @@ xassert (STRINGP (it->string)); xassert (IT_STRING_CHARPOS (*it) >= 0); } - else if (it->method == next_element_from_buffer) - { - /* Check that character and byte positions agree. */ - xassert (IT_CHARPOS (*it) == BYTE_TO_CHAR (IT_BYTEPOS (*it))); + else + { + xassert (IT_STRING_CHARPOS (*it) < 0); + if (it->method == next_element_from_buffer) + { + /* Check that character and byte positions agree. */ + xassert (IT_CHARPOS (*it) == BYTE_TO_CHAR (IT_BYTEPOS (*it))); + } } if (it->dpvec) @@ -2016,6 +2020,8 @@ it->current.overlay_string_index = -1; it->current.dpvec_index = -1; it->base_face_id = base_face_id; + it->string = Qnil; + IT_STRING_CHARPOS (*it) = IT_STRING_BYTEPOS (*it) = -1; /* The window in which we iterate over current_buffer: */ XSETWINDOW (it->window, w); @@ -3482,43 +3488,6 @@ } #endif /* HAVE_WINDOW_SYSTEM */ } - else if (CONSP (prop) - && (EQ (XCAR (prop), Qleft_fringe) - || EQ (XCAR (prop), Qright_fringe)) - && CONSP (XCDR (prop))) - { - unsigned face_id = DEFAULT_FACE_ID; - - /* `(left-fringe BITMAP FACE)'. */ - if (FRAME_TERMCAP_P (it->f) || FRAME_MSDOS_P (it->f)) - return 0; - -#ifdef HAVE_WINDOW_SYSTEM - value = XCAR (XCDR (prop)); - if (!NUMBERP (value) - || !valid_fringe_bitmap_id_p (XINT (value))) - return 0; - - if (CONSP (XCDR (XCDR (prop)))) - { - Lisp_Object face_name = XCAR (XCDR (XCDR (prop))); - face_id = lookup_named_face (it->f, face_name, 'A'); - if (face_id < 0) - return 0; - } - - if (EQ (XCAR (prop), Qleft_fringe)) - { - it->left_user_fringe_bitmap = XINT (value); - it->left_user_fringe_face_id = face_id; - } - else - { - it->right_user_fringe_bitmap = XINT (value); - it->right_user_fringe_face_id = face_id; - } -#endif /* HAVE_WINDOW_SYSTEM */ - } else if (!it->string_from_display_prop_p) { /* `((margin left-margin) VALUE)' or `((margin right-margin) @@ -3537,6 +3506,64 @@ text properties change there. */ it->stop_charpos = position->charpos; + if (CONSP (prop) + && (EQ (XCAR (prop), Qleft_fringe) + || EQ (XCAR (prop), Qright_fringe)) + && CONSP (XCDR (prop))) + { + unsigned face_id = DEFAULT_FACE_ID; + + /* Save current settings of IT so that we can restore them + when we are finished with the glyph property value. */ + + /* `(left-fringe BITMAP FACE)'. */ + if (FRAME_TERMCAP_P (it->f) || FRAME_MSDOS_P (it->f)) + return 0; + +#ifdef HAVE_WINDOW_SYSTEM + value = XCAR (XCDR (prop)); + if (!NUMBERP (value) + || !valid_fringe_bitmap_id_p (XINT (value))) + return 0; + + if (CONSP (XCDR (XCDR (prop)))) + { + Lisp_Object face_name = XCAR (XCDR (XCDR (prop))); + + face_id = lookup_named_face (it->f, face_name, 'A'); + if (face_id < 0) + return 0; + } + + push_it (it); + + it->area = TEXT_AREA; + it->what = IT_IMAGE; + it->image_id = -1; /* no image */ + it->position = start_pos; + it->object = NILP (object) ? it->w->buffer : object; + it->method = next_element_from_image; + it->face_id = face_id; + + /* Say that we haven't consumed the characters with + `display' property yet. The call to pop_it in + set_iterator_to_next will clean this up. */ + *position = start_pos; + + if (EQ (XCAR (prop), Qleft_fringe)) + { + it->left_user_fringe_bitmap = XINT (value); + it->left_user_fringe_face_id = face_id; + } + else + { + it->right_user_fringe_bitmap = XINT (value); + it->right_user_fringe_face_id = face_id; + } +#endif /* HAVE_WINDOW_SYSTEM */ + return 1; + } + location = Qunbound; if (CONSP (prop) && CONSP (XCAR (prop))) { @@ -17673,17 +17700,31 @@ xassert (it->what == IT_IMAGE); face = FACE_FROM_ID (it->f, it->face_id); + xassert (face); + /* Make sure X resources of the face is loaded. */ + PREPARE_FACE_FOR_DISPLAY (it->f, face); + + if (it->image_id < 0) + { + /* Fringe bitmap. */ + it->nglyphs = 0; + return; + } + img = IMAGE_FROM_ID (it->f, it->image_id); xassert (img); - - /* Make sure X resources of the face and image are loaded. */ - PREPARE_FACE_FOR_DISPLAY (it->f, face); + /* Make sure X resources of the image is loaded. */ prepare_image_for_display (it->f, img); it->ascent = it->phys_ascent = glyph_ascent = image_ascent (img, face); it->descent = it->phys_descent = img->height + 2 * img->vmargin - it->ascent; it->pixel_width = img->width + 2 * img->hmargin; + /* It's quite possible for images to have an ascent greater than + their height, so don't get confused in that case. */ + if (it->descent < 0) + it->descent = 0; + /* If this glyph is alone on the last line, adjust it.ascent to minimum row ascent. */ face_ascent = face->font ? FONT_BASE (face->font) : FRAME_BASELINE_OFFSET (it->f); if (face_ascent > it->ascent)
--- a/src/xfns.c Thu Feb 26 00:37:31 2004 +0000 +++ b/src/xfns.c Thu Feb 26 00:39:34 2004 +0000 @@ -1,5 +1,5 @@ /* Functions for the X window system. - Copyright (C) 1989, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 01, 02, 03 + Copyright (C) 1989, 92, 93, 94, 95, 96, 97, 98, 99, 2000,01,02,03,04 Free Software Foundation. This file is part of GNU Emacs. @@ -5323,7 +5323,6 @@ } UNBLOCK_INPUT; - xassert (!interrupt_input_blocked); } /* We're using IMG, so set its timestamp to `now'. */