Mercurial > emacs
changeset 83091:7f60e040ccfc
Merged in changes from CVS HEAD
Patches applied:
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-177
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-178
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-179
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-180
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-131
| author | Karoly Lorentey <lorentey@elte.hu> |
|---|---|
| date | Sat, 03 Apr 2004 20:24:17 +0000 |
| parents | 72c2a3eb27da (current diff) b8f001fab555 (diff) |
| children | 1029206e72f2 |
| files | ChangeLog etc/TODO lisp/ChangeLog lisp/vc.el lisp/x-dnd.el src/.gdbinit src/.gdbinit-union src/emacs.c src/lisp.h src/xterm.c |
| diffstat | 44 files changed, 1521 insertions(+), 858 deletions(-) [+] |
line wrap: on
line diff
--- a/ChangeLog Sat Apr 03 20:02:51 2004 +0000 +++ b/ChangeLog Sat Apr 03 20:24:17 2004 +0000 @@ -1,3 +1,8 @@ +2004-03-31 Luc Teirlinck <teirllm@auburn.edu> + + * Makefile.in: Mention in comment that `make maintainer-clean' + deletes .elc files. + 2004-03-22 Stefan Monnier <monnier@iro.umontreal.ca> * update-subdirs: Add local variables to prevent byte-compiling.
--- a/INSTALL.CVS Sat Apr 03 20:02:51 2004 +0000 +++ b/INSTALL.CVS Sat Apr 03 20:24:17 2004 +0000 @@ -50,15 +50,15 @@ send it to the proper place. -Note on using SSH to access the CVS repository from inside emacs +Note on using SSH to access the CVS repository from inside Emacs ---------------------------------------------------------------- Write access to the CVS repository requires using SSH v2. -If you execute cvs commands inside emacs, specifically if you use +If you execute cvs commands inside Emacs, specifically if you use pcl-cvs, output from CVS may be lost due to a problem in the -interface between ssh, cvs, and emacs. Corrupted checkins are -also been reported to have happened. +interface between ssh, cvs, and libc. Corrupted checkins have +also been rumored to have happened. To fix the problem, save the following script into a file, make it executable, and set CVS_RSH to the file name of the script:
--- a/Makefile.in Sat Apr 03 20:02:51 2004 +0000 +++ b/Makefile.in Sat Apr 03 20:24:17 2004 +0000 @@ -45,8 +45,9 @@ # make maintainer-clean # Delete everything from the current directory that can be # reconstructed with this Makefile. This typically includes -# everything deleted by distclean, plus more: C source files -# produced by Bison, tags tables, info files, and so on. +# everything deleted by distclean, plus more: .elc files, +# C source files produced by Bison, tags tables, info files, +# and so on. # # make extraclean # Still more severe - delete backup and autosave files, too.
--- a/etc/ChangeLog Sat Apr 03 20:02:51 2004 +0000 +++ b/etc/ChangeLog Sat Apr 03 20:24:17 2004 +0000 @@ -1,3 +1,18 @@ +2004-04-01 Juri Linkov <juri@jurta.org> + + * HELLO: Add Javanese. + +2004-03-29 Vinicius Jose Latorre <viniciusjl@ig.com.br> + + * ps-prin1.ps: Clip the header and footer area, so text will not be + printed outside header or footer, respectively. + (HeaderClip, FooterClip): New PostScript funs. + (HeaderText, FooterText): Adjust PostScript code. + +2004-03-29 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * TODO: Removed drag-and-drop entry (DONE). + 2004-03-19 Kim F. Storm <storm@cua.dk> * TODO: Remove entries for fringe related issues (DONE).
--- a/etc/HELLO Sat Apr 03 20:02:51 2004 +0000 +++ b/etc/HELLO Sat Apr 03 20:24:17 2004 +0000 @@ -19,6 +19,7 @@ Hebrew (,Hraxiz(B) ,Hylem(B Hindi (4$,4!}t%"+0$,15y55B14$,4!.v#"Yv#"20$,15f6 1(B) 4$,4!8v#")0$,15h14$,4!hv#")0$,15n14$,4!zv#!)v#")v#"D0$,15x6-5d6'1(B, 4$,4!8v#")0$,15h14$,4!hv#")0$,15n14$,4!zv# ev#"Rv#")0$,15x6-5U5~14$,4!nv#"W0$,15p1(B 4$,4 J0$,16D1(B Italian (italiano) Ciao, Buon giorno +Javanese (Jawa) System.out.println("Halo, selamat sore!"); Kannada (4$,43Ov#4z0$,1>u14$,44Kv#4zv#4M0$,1?(?M?(14$,43sv#4z0$,1?!1(B) 4$,44Kv#4z0$,1?(14$,44hv#4zv#40$,1?.14$,44qv#4{v#3Q0$,1?8?M>u?>14$,44av#4z0$,1?01(B Lao ((1>RJRERG(B) (1JP:R-04U1(B, 0(1"m1c0Ki1b*!04U1(B Malayalam (4$,46A0$,1@N14$,46E0$,1@R14$,46Bv#6M0$,1@O@^14$,46Fv#6W0$,1@S@"1(B) 4$,46<0$,1@H14$,46A0$,1@N14$,46Kv#6Vv#6)v#6M0$,1@X@m@5@^14$,46Cv#6W0$,1@P@"1(B
--- a/etc/NEWS Sat Apr 03 20:02:51 2004 +0000 +++ b/etc/NEWS Sat Apr 03 20:24:17 2004 +0000 @@ -88,12 +88,22 @@ * Changes in Emacs 21.4 -** M-x compile has been completely overhauled - -It now uses font-lock for turning compiler output into hypertext. Quite a few -more kinds of messages are recognized. Messages that are recognized as -warnings or informational come in orange or green, instead of red. -Informational messages are by default skipped with `next-error'. +** M-x compile has become more robust and reliable + +Quite a few more kinds of messages are recognized. Messages that are +recognized as warnings or informational come in orange or green, instead of +red. Informational messages are by default skipped with `next-error' +(controlled by `compilation-skip-threshold'). + +Location data is collected on the fly as the *compilation* buffer changes. +This means you could modify messages to make them point to different files. +This also means you can not go to locations of messages you may have deleted. + +The variable `compilation-error-regexp-alist' has now become customizable. If +you had added your own regexps to this, you'll probably need to include a +leading `^', otherwise they'll match anywhere on a line. There is now also a +`compilation-mode-font-lock-keywords' and it nicely handles all the checks +that configure outputs and -o options so you see at a glance where you are. The new file etc/compilation.txt gives examples of each type of message. @@ -638,6 +648,13 @@ be selected only when it is active). The default is nil, so that this feature is not enabled. +** On X, when the window manager requires that you click on a frame to +select it (give it focus), the selected window and cursor position +normally changes according to the mouse click position. If you set +the variable x-mouse-click-focus-ignore-position to t, the selected +window and cursor position do not changes when you click on a frame +to give it focus. + +++ ** The new command `describe-char' (C-u C-x =) pops up a buffer with description various information about a character, including its
--- a/etc/TODO Sat Apr 03 20:02:51 2004 +0000 +++ b/etc/TODO Sat Apr 03 20:24:17 2004 +0000 @@ -166,9 +166,6 @@ * Check what hooks would help Emacspeak -- see the defadvising in W3. -* Implement some variety of (non-gtk) drag-and-drop support under X. - Using libdnd might be a good start. - * Add horizontal scroll bars. * Provide an optional feature which computes a scroll bar slider's
--- a/etc/ps-prin1.ps Sat Apr 03 20:02:51 2004 +0000 +++ b/etc/ps-prin1.ps Sat Apr 03 20:24:17 2004 +0000 @@ -1,7 +1,7 @@ % === BEGIN ps-print prologue 1 % version: 6.0 -% Copyright (C) 2000, 2001 Free Software Foundation, Inc. +% Copyright (C) 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc. % % This file is part of GNU Emacs. % @@ -751,6 +751,9 @@ FooterLineHeight FooterLines 1 sub mul add }def +/HeaderClip{HeaderFrameStart moveto HeaderFramePath clip}def +/FooterClip{FooterFrameStart moveto FooterFramePath clip}def + /strcat{ dup length 3 -1 roll dup length dup 4 -1 roll add string dup 0 5 -1 roll putinterval @@ -803,17 +806,21 @@ }def /HeaderText{ + gsave HeaderClip HeaderLinesRight HeaderLinesLeft /HeaderStart HeaderLineHeight HeaderPad HeaderFrameProperties 0 get HeaderOrFooterText + grestore }def /FooterText{ + gsave FooterClip FooterLinesRight FooterLinesLeft /FooterStart FooterLineHeight FooterPad FooterFrameProperties 0 get HeaderOrFooterText + grestore }def /ReportFontInfo{
--- a/lisp/ChangeLog Sat Apr 03 20:02:51 2004 +0000 +++ b/lisp/ChangeLog Sat Apr 03 20:24:17 2004 +0000 @@ -1,3 +1,134 @@ +2004-04-03 Juri Linkov <juri@jurta.org> + + * descr-text.el (describe-property-list): Add `font-lock-face'. + + * dired.el (dired-font-lock-keywords): Fix permission regexps. + +2004-04-02 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * x-dnd.el (x-dnd-handle-moz-url, x-dnd-insert-utf16-text): Use + utf-16le on little endian machines and utf-16be otherwise. + +2004-04-02 David Kastrup <dak@gnu.org> + + * net/browse-url.el (browse-url-generic): Use call-process + instead of start-process to allow browsers that fork and detach. + +2004-04-01 Daniel Pfeiffer <occitan@esperanto.org> + + * compile.el (compilation-current-error): New var. + (compilation-setup, compile-mouse-goto-error) + (compile-goto-error, next-error): Use it. + (compilation-skip-to-next-location): Default to t, which gives + contiguous skipping like old compile (where this was redundant). + (compilation-next-error): Prevent previous-* commands from moving + back to message at or just before point. + +2004-04-01 Nick Roberts <nick@nick.uklinux.net> + + * progmodes/gdb-ui.el (gdb-view-source-function, gdb-view-assembler) + (gdb-source-info): Don't display source at startup, if required. + (gdb-show-main): New option. + (gdba): Update documentation. + (gdb-source): Cover case of auto-display output. + +2004-03-31 Luc Teirlinck <teirllm@auburn.edu> + + * autorevert.el: Delete obsolete autoload's and defvar's. + (auto-revert-check-vc-info): New user option. + (auto-revert-vc-cvs-file-version, auto-revert-vc-buffer-p) + (auto-revert-handler-vc): Delete. + (auto-revert-handler): Treat return value `fast' of + buffer-stale-function specially. Check `auto-revert-check-vc-info'. + + * buff-menu.el (Buffer-menu-mode): Make the buffer-stale-function + return `fast'. + + * files.el (buffer-stale-function): Doc change. + +2004-03-31 Vinicius Jose Latorre <viniciusjl@ig.com.br> + + * printing.el: New tip on Tips section. + (pr-version): New version number (6.7.4). + (pr-shell-file-name): Initialization fix. + +2004-03-31 Juri Linkov <juri@jurta.org> + + * dired.el: Add autoload for `dired-do-touch'. + (dired-touch-program): New var. + (dired-mode-map): Bind `dired-do-touch' to T and add menu-item. + (dired-no-confirm): Add `touch' to docstring. + + * dired-aux.el (dired-do-touch): New fun. + (dired-do-chxxx): Add argument -t for touch operation. + + * dired-x.el (dired-mark-sexp): Replace hard-coded month names by + `dired-move-to-filename-regexp'. + +2004-03-31 H,Ae(Bkan Granath <hakan.granath@kau.se> (tiny change) + + * dired.el (dired-move-to-filename-regexp): Add . to HH:MM. + +2004-03-30 Vinicius Jose Latorre <viniciusjl@ig.com.br> + + * progmodes/ebnf2ps.el (ebnf-eps-finish-and-write): Write a buffer if + and only if the buffer was modified. + +2004-03-30 Kenichi Handa <handa@m17n.org> + + * international/characters.el: Delete pairs for U+2308..U+230B. + +2004-03-29 Nick Roberts <nick@nick.uklinux.net> + + * progmodes/gud.el (gud-gdb-marker-filter): Include "\n" in regexp + to detect the beginning of a level 2 or 3 annotation. + +2004-03-29 Kenichi Handa <handa@m17n.org> + + * international/ucs-tables.el (ucs-insert): Fix the error message. + +2004-03-29 Kenichi Handa <handa@m17n.org> + + * international/mule-util.el (char-displayable-p): Fix generation + of XLFD file name. + + * Makefile.in (setwins, setwins_almost): Change directory to $wd + before finding directories by `find'. + +2004-03-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * subr.el (interactive-form): Delete. Now implemented in C. + + * pcvs.el (cvs-parse-process): Workaround for Darwin. + + * vc.el (vc-version-diff, vc-default-diff-tree): Change `rel' -> `rev'. + (vc-diff-label): New fun. + (vc-diff-internal): Use it. + + * progmodes/gdb-ui.el (gdb-post-prompt): Fix test. + +2004-03-28 Vinicius Jose Latorre <viniciusjl@ig.com.br> + + * progmodes/ebnf-abn.el (ebnf-abn-parser): Handle initial comments. + + * progmodes/ebnf-ebx.el: New file, implement a parser for EBNF used to + specify XML (EBNFX). + + * progmodes/ebnf2ps.el: Doc fix. + (ebnf-version): New version number (4.1). + (ebnf-syntax): Adjust customization. + (ebnf-style-database): Add ebnfx entry. + (ebnf-syntax-alist): Add ebnfx initialization. + (ebnf-ebx-parser, ebnf-ebx-initialize): Autoloaded funs from ebnf-ebx. + + * printing.el: Doc fix. + (pr-version): New version number (6.7.3). + (pr-menu-position): Adjust X and Y positions when mouse-pixel-position + returns nil for mouse position. Reported by Drew Adams + <drew.adams@oracle.com>. + (pr-update-menus): Modify interactive declaration. Reported by Drew + Adams <drew.adams@oracle.com>. + 2004-03-28 Nick Roberts <nick@nick.uklinux.net> * progmodes/gdb-ui.el (gdb-ann3, gdb-send-item) @@ -286,12 +417,14 @@ functions. (auto-revert-buffers): Delete call to auto-revert-buffer-p. - * dired.el (dired-directory-changed-p, dired-buffer-stale-p): New funs. + * dired.el (dired-directory-changed-p): New fun, extracted from + dired-internal-noselect. + (dired-buffer-stale-p): New fun. (dired-internal-noselect): Use dired-directory-changed-p. Eliminate revert messages. (dired-mode): Set buffer-stale-function to dired-buffer-stale-p. -2004-03-23 Kenichi Handa <handa@etlken2> +2004-03-23 Kenichi Handa <handa@m17n.org> * international/characters.el: Setup syntaxes for more parentheses Unicode characters. @@ -940,12 +1073,12 @@ 2004-02-28 Vinicius Jose Latorre <viniciusjl@ig.com.br> - * ebnf-abn.el: Doc fix. - - * ebnf-bnf.el: Doc fix. + * progmodes/ebnf-abn.el: Doc fix. + + * progmodes/ebnf-bnf.el: Doc fix. (ebnf-repeat): Code fix. - * ebnf2ps.el: Doc fix. + * progmodes/ebnf2ps.el: Doc fix. (ebnf-syntax-directory, ebnf-syntax-file): New funs. 2004-02-28 Juri Linkov <juri@jurta.org> @@ -1011,8 +1144,8 @@ 2004-02-25 Vinicius Jose Latorre <viniciusjl@ig.com.br> - * ebnf2ps.el: Doc fix. For compatibility with Emacs 20, define - assq-delete-all if it's not defined. + * progmodes/ebnf2ps.el: Doc fix. For compatibility with Emacs 20, + define assq-delete-all if it's not defined. (ebnf-generate-region): Code fix. * printing.el: Doc fix. @@ -1021,12 +1154,13 @@ 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>. + * progmodes/ebnf-abn.el: New file, implements an ABNF parser. + + * progmodes/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) @@ -1046,18 +1180,19 @@ (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>. + * progmodes/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. + * progmodes/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. + * progmodes/ebnf-bnf.el: Doc fix. (ebnf-bnf-lex): Code fix. - * ebnf-otz.el: Doc fix. + * progmodes/ebnf-otz.el: Doc fix. 2004-02-23 Luc Teirlinck <teirllm@auburn.edu>
--- a/lisp/Makefile.in Sat Apr 03 20:02:51 2004 +0000 +++ b/lisp/Makefile.in Sat Apr 03 20:24:17 2004 +0000 @@ -136,17 +136,17 @@ # Common command to find subdirectories -setwins=subdirs=`find $$wd -type d -print`; \ +setwins=subdirs=`(cd $$wd; find . -type d -print)`; \ for file in $$subdirs; do \ case $$file in */Old | */RCS | */CVS | */CVS/* | */.* | */.*/* | */=* ) ;; \ - *) wins="$$wins $$file" ;; \ + *) wins="$$wins $$wd/$$file" ;; \ esac; \ done -setwins_almost=subdirs=`find $$wd -type d -print`; \ +setwins_almost=subdirs=`(cd $$wd; find . -type d -print)`; \ for file in $$subdirs; do \ case $$file in */Old | */RCS | */CVS | */CVS/* | */.* | */.*/* | */=* | */obsolete | */term ) ;; \ - *) wins="$$wins $$file" ;; \ + *) wins="$$wins $$wd/$$file" ;; \ esac; \ done
--- a/lisp/autorevert.el Sat Apr 03 20:02:51 2004 +0000 +++ b/lisp/autorevert.el Sat Apr 03 20:24:17 2004 +0000 @@ -70,14 +70,8 @@ ;; Dependencies: (require 'timer) -(autoload 'dired-get-filename "dired") -(autoload 'vc-workfile-version "vc-hooks") -(autoload 'vc-mode-line "vc-hooks") -(eval-when-compile - (defvar dired-directory) - (defvar vc-mode) - (require 'cl)) +(eval-when-compile (require 'cl)) ;; Custom Group: @@ -191,6 +185,27 @@ :group 'auto-revert :type 'hook) +(defcustom auto-revert-check-vc-info nil + "If non-nil Auto Revert Mode reliably updates version control info. +Auto Revert Mode updates version control info whenever the buffer +needs reverting, regardless of the value of this variable. +However, the version control state can change without changes to +the work file. If the change is made from the current Emacs +session, all info is updated. But if, for instance, a new +version is checked in from outside the current Emacs session, the +version control number in the mode line, as well as other version +control related information, may not be properly updated. If you +are worried about this, set this variable to a non-nil value. + +This currently works by automatically updating the version +control info every `auto-revert-interval' seconds. Nevertheless, +it should not cause excessive CPU usage on a reasonably fast +machine, if it does not apply to too many version controlled +buffers. CPU usage depends on the version control system" + :group 'auto-revert + :type 'boolean + :version "21.4") + (defvar global-auto-revert-ignore-buffer nil "*When non-nil, Global Auto-Revert Mode will not revert this buffer. @@ -279,87 +294,29 @@ (not (memq major-mode global-auto-revert-ignore-modes))))) -(defun auto-revert-vc-cvs-file-version (file) - "Get version of FILE by reading control file on disk." - (let* ((control "CVS/Entries") - (name (file-name-nondirectory file)) - (path (format "%s/%s" - (file-name-directory file) - control))) - (when (file-exists-p path) - (with-temp-buffer - (insert-file-contents-literally path) - (goto-char (point-min)) - (when (re-search-forward - ;; /file.txt/1.3/Mon Sep 15 18:43:20 2003// - (format "%s/\\([.0-9]+\\)" (regexp-quote name)) - nil t) - (match-string 1)))))) - -(defun auto-revert-vc-buffer-p () - "Check if buffer is version controlled." - (and (boundp 'vc-mode) - (string-match "[0-9]" (or vc-mode "")))) - -(defun auto-revert-handler-vc () - "Check if version controlled buffer needs revert." - ;; [Emacs 1] - ;; 1. File is saved (*) - ;; 2. checkin is done 1.1 -> 1.2 - ;; 3. VC reverts, so that updated version number is shown in mode line - ;; - ;; Suppose the same file has been opened in another Emacs and - ;; autorevert.el is on. - ;; - ;; [Emacs 2] - ;; 1. Step (1) is detected and buffer is reverted. - ;; 2. But check in does not always change the file in dis, but possibly only - ;; control files like CVS/Entries - ;; 3. The buffer is not reverted to update VC version line. - ;; Incorrect version number 1.1 is shown in this Emacs - ;; - (when (featurep 'vc) - (let* ((file (buffer-file-name)) - (backend (vc-backend (buffer-file-name))) - (version-buffer (vc-workfile-version file))) - (when (stringp version-buffer) - (cond - ((eq backend 'CVS) - (let ((version-file - (auto-revert-vc-cvs-file-version (buffer-file-name)))) - (and (stringp version-file) - (not (string-match version-file version-buffer))))) - ((eq backend 'RCS) - ;; TODO: - )))))) - (defun auto-revert-handler () "Revert current buffer, if appropriate. This is an internal function used by Auto-Revert Mode." (unless (buffer-modified-p) (let (revert) - (cond - ((auto-revert-vc-buffer-p) - (when (auto-revert-handler-vc) - (setq revert 'vc))) - ((or (and (buffer-file-name) - (file-readable-p (buffer-file-name)) - (not (verify-visited-file-modtime (current-buffer)))) - (and (or auto-revert-mode global-auto-revert-non-file-buffers) - revert-buffer-function - (boundp 'buffer-stale-function) - (functionp buffer-stale-function) - (funcall buffer-stale-function t))) - (setq revert t))) + (or (and (buffer-file-name) + (file-readable-p (buffer-file-name)) + (not (verify-visited-file-modtime (current-buffer))) + (setq revert t)) + (and (or auto-revert-mode global-auto-revert-non-file-buffers) + revert-buffer-function + (boundp 'buffer-stale-function) + (functionp buffer-stale-function) + (setq revert (funcall buffer-stale-function t)))) (when revert - (when auto-revert-verbose + (when (and auto-revert-verbose + (not (eq revert 'fast))) (message "Reverting buffer `%s'." (buffer-name))) - (revert-buffer 'ignore-auto 'dont-ask 'preserve-modes) - ;; `preserve-modes' avoids changing the (minor) modes. But we - ;; do want to reset the mode for VC, so we do it explicitly. - (vc-find-file-hook) - (if (eq revert 'vc) - (vc-mode-line buffer-file-name)))))) + (revert-buffer 'ignore-auto 'dont-ask 'preserve-modes)) + ;; `preserve-modes' avoids changing the (minor) modes. But we + ;; do want to reset the mode for VC, so we do it manually. + (when (or revert auto-revert-check-vc-info) + (vc-find-file-hook))))) (defun auto-revert-buffers () "Revert buffers as specified by Auto-Revert and Global Auto-Revert Mode.
--- a/lisp/buff-menu.el Sat Apr 03 20:02:51 2004 +0000 +++ b/lisp/buff-menu.el Sat Apr 03 20:24:17 2004 +0000 @@ -185,7 +185,7 @@ (set (make-local-variable 'revert-buffer-function) 'Buffer-menu-revert-function) (set (make-local-variable 'buffer-stale-function) - #'(lambda (&optional noconfirm) t)) + #'(lambda (&optional noconfirm) 'fast)) (setq truncate-lines t) (setq buffer-read-only t) (run-hooks 'buffer-menu-mode-hook))
--- a/lisp/descr-text.el Sat Apr 03 20:02:51 2004 +0000 +++ b/lisp/descr-text.el Sat Apr 03 20:24:17 2004 +0000 @@ -99,8 +99,9 @@ (defun describe-property-list (properties) "Insert a description of PROPERTIES in the current buffer. PROPERTIES should be a list of overlay or text properties. -The `category' and `face' properties are made into widget buttons -that call `describe-text-category' or `describe-face' when pushed." +The `category', `face' and `font-lock-face' properties are made +into widget buttons that call `describe-text-category' or +`describe-face' when pushed." ;; Sort the properties by the size of their value. (dolist (elt (sort (let ((ret nil) (key nil) @@ -110,7 +111,7 @@ (setq key (pop properties) val (pop properties) len 0) - (unless (or (memq key '(category face)) + (unless (or (memq key '(category face font-lock-face)) (widgetp val)) (setq val (pp-to-string val) len (length val))) @@ -128,7 +129,7 @@ :notify `(lambda (&rest ignore) (describe-text-category ',value)) (format "%S" value))) - ((eq key 'face) + ((memq key '(face font-lock-face)) (widget-create 'link :notify `(lambda (&rest ignore) (describe-face ',value))
--- a/lisp/dired-aux.el Sat Apr 03 20:02:51 2004 +0000 +++ b/lisp/dired-aux.el Sat Apr 03 20:24:17 2004 +0000 @@ -186,7 +186,7 @@ (directory-files dir))) (defun dired-do-chxxx (attribute-name program op-symbol arg) - ;; Change file attributes (mode, group, owner) of marked files and + ;; Change file attributes (mode, group, owner, timestamp) of marked files and ;; refresh their file lines. ;; ATTRIBUTE-NAME is a string describing the attribute to the user. ;; PROGRAM is the program used to change the attribute. @@ -203,7 +203,10 @@ (dired-bunch-files 10000 (function dired-check-process) (append - (list operation program new-attribute) + (list operation program) + (if (eq op-symbol 'touch) + '("-t") nil) + (list new-attribute) (if (string-match "gnu" system-configuration) '("--") nil)) files)) @@ -236,6 +239,12 @@ (error "chown not supported on this system")) (dired-do-chxxx "Owner" dired-chown-program 'chown arg)) +(defun dired-do-touch (&optional arg) + "Change the timestamp of the marked (or next ARG) files. +This calls touch." + (interactive "P") + (dired-do-chxxx "Timestamp" dired-touch-program 'touch arg)) + ;; Process all the files in FILES in batches of a convenient size, ;; by means of (FUNCALL FUNCTION ARGS... SOME-FILES...). ;; Batches are chosen to need less than MAX chars for the file names,
--- a/lisp/dired-x.el Sat Apr 03 20:02:51 2004 +0000 +++ b/lisp/dired-x.el Sat Apr 03 20:24:17 2004 +0000 @@ -1517,8 +1517,7 @@ ;; Karsten Wenger <kw@cis.uni-muenchen.de> fixed uid. (setq uid (buffer-substring (+ (point) 1) (progn (forward-word 1) (point)))) - (re-search-forward "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|\ -Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)") + (re-search-forward dired-move-to-filename-regexp) (goto-char (match-beginning 1)) (forward-char -1) (setq size (string-to-int (buffer-substring (save-excursion
--- a/lisp/dired.el Sat Apr 03 20:02:51 2004 +0000 +++ b/lisp/dired.el Sat Apr 03 20:24:17 2004 +0000 @@ -79,6 +79,9 @@ (defvar dired-chmod-program "chmod" "Name of chmod command (usually `chmod').") +(defvar dired-touch-program "touch" + "Name of touch command (usually `touch').") + ;;;###autoload (defcustom dired-ls-F-marks-symlinks nil "*Informs dired about how `ls -lF' marks symbolic links. @@ -315,10 +318,10 @@ ;; Fixme: we could also put text properties on the permission ;; fields with keymaps to frob the permissions, somewhat a la XEmacs. (list (concat dired-re-maybe-mark dired-re-inode-size - "[-d]....\\(w\\)..\\(w\\).") ; group writable - '(1 font-lock-warning-face)) + "[-d]....\\(w\\)....") ; group writable + '(1 font-lock-comment-face)) (list (concat dired-re-maybe-mark dired-re-inode-size - "[-d]....\\(w\\)....") ; world writable + "[-d].......\\(w\\).") ; world writable '(1 font-lock-comment-face)) ;; ;; Subdirectories. @@ -919,6 +922,7 @@ (define-key map "Q" 'dired-do-query-replace-regexp) (define-key map "R" 'dired-do-rename) (define-key map "S" 'dired-do-symlink) + (define-key map "T" 'dired-do-touch) (define-key map "X" 'dired-do-shell-command) (define-key map "Z" 'dired-do-compress) (define-key map "!" 'dired-do-shell-command) @@ -1189,6 +1193,9 @@ (define-key map [menu-bar operate chmod] '(menu-item "Change Mode..." dired-do-chmod :help "Change mode (attributes) of marked files")) + (define-key map [menu-bar operate touch] + '(menu-item "Change Timestamp..." dired-do-touch + :help "Change timestamp of marked files")) (define-key map [menu-bar operate load] '(menu-item "Load" dired-do-load :help "Load marked Emacs Lisp files")) @@ -1630,7 +1637,7 @@ (s " ") (yyyy "[0-9][0-9][0-9][0-9]") (dd "[ 0-3][0-9]") - (HH:MM "[ 0-2][0-9]:[0-5][0-9]") + (HH:MM "[ 0-2][0-9][:.][0-5][0-9]") (seconds "[0-6][0-9]\\([.,][0-9]+\\)?") (zone "[-+][0-2][0-9][0-5][0-9]") (iso-mm-dd "[01][0-9]-[0-3][0-9]") @@ -2333,8 +2340,8 @@ (defvar dired-no-confirm nil "A list of symbols for commands dired should not confirm. Command symbols are `byte-compile', `chgrp', `chmod', `chown', `compress', -`copy', `delete', `hardlink', `load', `move', `print', `shell', `symlink' and -`uncompress'.") +`copy', `delete', `hardlink', `load', `move', `print', `shell', `symlink', +`touch' and `uncompress'.") (defun dired-mark-pop-up (bufname op-symbol files function &rest args) "Return FUNCTION's result on ARGS after showing which files are marked. @@ -2977,6 +2984,10 @@ "Change the owner of the marked (or next ARG) files." t) +(autoload 'dired-do-touch "dired-aux" + "Change the timestamp of the marked (or next ARG) files." + t) + (autoload 'dired-do-print "dired-aux" "Print the marked (or next ARG) files. Uses the shell command coming from variables `lpr-command' and
--- a/lisp/files.el Sat Apr 03 20:02:51 2004 +0000 +++ b/lisp/files.el Sat Apr 03 20:24:17 2004 +0000 @@ -3458,8 +3458,10 @@ "Function to check whether a non-file buffer needs reverting. This should be a function with one optional argument NOCONFIRM. Auto Revert Mode sets NOCONFIRM to t. The function should return -non-nil if the buffer should be reverted. The buffer is current -when this function is called. +non-nil if the buffer should be reverted. A return value of +`fast' means that the need for reverting was not checked, but +that reverting the buffer is fast. The buffer is current when +this function is called. The idea behind the NOCONFIRM argument is that it should be non-nil if the buffer is going to be reverted without asking the
--- a/lisp/international/characters.el Sat Apr 03 20:02:51 2004 +0000 +++ b/lisp/international/characters.el Sat Apr 03 20:24:17 2004 +0000 @@ -1129,8 +1129,6 @@ '("$,1sEsF(B" ; U+2045 U+2046 "$,1s}s~(B" ; U+207D U+207E "$,1t-t.(B" ; U+208D U+208E - "$,1zhzi(B" ; U+2308 U+2309 - "$,1zjzk(B" ; U+230A U+230B "$,1{){*(B" ; U+2329 U+232A "$,1|T|U(B" ; U+23B4 U+23B5 "$,2&H&I(B" ; U+2768 U+2769
--- a/lisp/international/mule-util.el Sat Apr 03 20:02:51 2004 +0000 +++ b/lisp/international/mule-util.el Sat Apr 03 20:24:17 2004 +0000 @@ -384,10 +384,15 @@ ;; Now FONT-PATTERN is a string or a cons of family ;; field pattern and registry field pattern. (or (stringp font-pattern) - (setq font-pattern (concat "-" - (or (car font-pattern) "*") - "-*-" - (cdr font-pattern)))) + (let ((family (or (car font-pattern) "*")) + (registry (or (cdr font-pattern) "*"))) + (or (string-match "-" family) + (setq family (concat "*-" family))) + (or (string-match "-" registry) + (setq registry (concat registry "-*"))) + (setq font-pattern + (format "-%s-*-*-*-*-*-*-*-*-*-*-%s" + family registry)))) (x-list-fonts font-pattern 'default (selected-frame) 1))))) (t (let ((coding (terminal-coding-system)))
--- a/lisp/international/ucs-tables.el Sat Apr 03 20:02:51 2004 +0000 +++ b/lisp/international/ucs-tables.el Sat Apr 03 20:24:17 2004 +0000 @@ -1247,12 +1247,14 @@ "Insert the Emacs character representation of the given Unicode. Interactively, prompts for a hex string giving the code." (interactive "sUnicode (hex): ") - (let ((c (decode-char 'ucs (if (integerp arg) - arg - (string-to-number arg 16))))) + (or (integerp arg) + (setq arg (string-to-number arg 16))) + (let ((c (decode-char 'ucs arg))) (if c (insert c) - (error "Character can't be decoded to UCS")))) + (if (or (< arg 0) (> arg #x10FFFF)) + (error "Not a Unicode character code: 0x%X" arg) + (error "Character U+%04X is not yet supported" arg))))) ;;; Dealing with non-8859 character sets.
--- a/lisp/net/browse-url.el Sat Apr 03 20:02:51 2004 +0000 +++ b/lisp/net/browse-url.el Sat Apr 03 20:24:17 2004 +0000 @@ -1,6 +1,6 @@ ;;; browse-url.el --- pass a URL to a WWW browser -;; Copyright (C) 1995, 96, 97, 98, 99, 2000, 2001 +;; Copyright (C) 1995, 96, 97, 98, 99, 2000, 2001, 2004 ;; Free Software Foundation, Inc. ;; Author: Denis Howe <dbh@doc.ic.ac.uk> @@ -1352,8 +1352,8 @@ (interactive (browse-url-interactive-arg "URL: ")) (if (not browse-url-generic-program) (error "No browser defined (`browse-url-generic-program')")) - (apply 'start-process (concat browse-url-generic-program url) nil - browse-url-generic-program + (apply 'call-process browse-url-generic-program nil + 0 nil (append browse-url-generic-args (list url)))) ;;;###autoload
--- a/lisp/pcvs.el Sat Apr 03 20:02:51 2004 +0000 +++ b/lisp/pcvs.el Sat Apr 03 20:24:17 2004 +0000 @@ -1,6 +1,6 @@ ;;; pcvs.el --- a front-end to CVS -;; Copyright (C) 1991,92,93,94,95,95,97,98,99,2000,02,2003 +;; Copyright (C) 1991,92,93,94,95,95,97,98,99,2000,02,03,2004 ;; Free Software Foundation, Inc. ;; Author: (The PCL-CVS Trust) pcl-cvs@cyclic.com @@ -12,7 +12,7 @@ ;; (Stefan Monnier) monnier@cs.yale.edu ;; (Greg Klanderman) greg@alphatech.com ;; (Jari Aalto+mail.emacs) jari.aalto@poboxes.com -;; Maintainer: (Stefan Monnier) monnier+lists/cvs/pcl@flint.cs.yale.edu +;; Maintainer: (Stefan Monnier) monnier@gnu.org ;; Keywords: CVS, version control, release management ;; This file is part of GNU Emacs. @@ -669,6 +669,14 @@ SUBDIR is the subdirectory (if any) where this command was run. OLD-FIS is the list of fileinfos on which the cvs command was applied and which should be considered up-to-date if they are missing from the output." + (when (eq system-type 'darwin) + ;; Fixup the ^D^H^H inserted at beginning of buffer sometimes on MacOSX + ;; because of the call to `process-send-eof'. + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^\\^D+" nil t) + (let ((inhibit-read-only t)) + (delete-region (match-beginning 0) (match-end 0)))))) (let* ((fileinfos (cvs-parse-buffer 'cvs-parse-table dcd subdir)) last) (with-current-buffer cvs-buffer
--- a/lisp/printing.el Sat Apr 03 20:02:51 2004 +0000 +++ b/lisp/printing.el Sat Apr 03 20:24:17 2004 +0000 @@ -5,13 +5,13 @@ ;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br> ;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br> -;; Time-stamp: <2004/03/10 20:37:21 vinicius> +;; Time-stamp: <2004/03/31 23:14:47 vinicius> ;; Keywords: wp, print, PostScript -;; Version: 6.7.2 +;; Version: 6.7.4 ;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/ -(defconst pr-version "6.7.2" - "printing.el, v 6.7.2 <2004/02/29 vinicius> +(defconst pr-version "6.7.4" + "printing.el, v 6.7.4 <2004/03/31 vinicius> Please send all bug fixes and enhancements to Vinicius Jose Latorre <vinicius@cpqd.com.br> @@ -187,6 +187,10 @@ ;; another buffer and, then, print the file or the new static buffer. ;; An example of dynamic buffer is the *Messages* buffer. ;; +;; 4. When running Emacs on Windows with cygwin, check if the +;; `pr-shell-file-name' variable is set to the proper shell. This shell +;; will execute the commands to preview/print the buffer, file or directory. +;; ;; ;; Using `printing' ;; ---------------- @@ -2304,7 +2308,8 @@ (defcustom pr-shell-file-name - (if (eq pr-path-style 'windows) + (if (and (not pr-cygwin-system) + ps-windows-system) "cmdproxy.exe" shell-file-name) "*Specify file name to load inferior shells from." @@ -4572,8 +4577,8 @@ (defun pr-menu-position (entry index horizontal) (let ((pos (cdr (pr-e-mouse-pixel-position)))) (list - (list (car pos) ; X - (- (cdr pos) ; Y + (list (or (car pos) 0) ; X + (- (or (cdr pos) 0) ; Y (* (pr-menu-index entry index) pr-menu-char-height))) (selected-frame)))) ; frame ) @@ -4582,9 +4587,9 @@ (defun pr-menu-position (entry index horizontal) (let ((pos (cdr (pr-e-mouse-pixel-position)))) (list - (list (- (car pos) ; X + (list (- (or (car pos) 0) ; X (* horizontal pr-menu-char-width)) - (- (cdr pos) ; Y + (- (or (cdr pos) 0) ; Y (* (pr-menu-index entry index) pr-menu-char-height))) (selected-frame)))) ; frame )) @@ -4656,7 +4661,7 @@ non-nil, update text printer menu iff `pr-txt-printer-menu-modified' is non-nil, and update PostScript File menus iff `pr-ps-utility-menu-modified' is non-nil." - (interactive) + (interactive "P") (pr-update-var 'pr-ps-name pr-ps-printer-alist) (pr-update-var 'pr-txt-name pr-txt-printer-alist) (pr-update-var 'pr-ps-utility pr-ps-utility-alist)
--- a/lisp/progmodes/compile.el Sat Apr 03 20:02:51 2004 +0000 +++ b/lisp/progmodes/compile.el Sat Apr 03 20:24:17 2004 +0000 @@ -227,7 +227,7 @@ ("`\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)'" nil nil (2 compilation-info-face) (3 compilation-line-face nil t) - (1 (compilation-error-properties 2 3 nil nil nil 2 nil) + (1 (compilation-error-properties 2 3 nil nil nil 0 nil) append))) (mips-1 @@ -1076,11 +1076,17 @@ (if (or noconfirm (yes-or-no-p (format "Restart compilation? "))) (apply 'compilation-start compilation-arguments)))) +;; This points to the location from where the next error will be found. +;; The global commands next/previous/first-error... as well as +;; (mouse-)goto-error use this. +(defvar compilation-current-error nil) + ;; A function name can't be a hook, must be something with a value. (defconst compilation-turn-on-font-lock 'turn-on-font-lock) (defun compilation-setup (&optional minor) "Prepare the buffer for the compilation parsing commands to work." + (make-local-variable 'compilation-current-error) (make-local-variable 'compilation-error-screen-columns) (setq compilation-last-buffer (current-buffer)) (if minor @@ -1233,7 +1239,7 @@ ;; count this message only if none of the above are true (setq n (,1+ n))))) -(defun compilation-next-error (n &optional different-file) +(defun compilation-next-error (n &optional different-file pt) "Move point to the next error in the compilation buffer. Prefix arg N says how many error messages to move forwards (or backwards, if negative). @@ -1241,11 +1247,11 @@ (interactive "p") (or (compilation-buffer-p (current-buffer)) (error "Not in a compilation buffer")) + (or pt (setq pt (point))) (setq compilation-last-buffer (current-buffer)) - (let* ((pt (point)) - (msg (get-text-property pt 'message)) - (loc (car msg)) - last) + (let* ((msg (get-text-property pt 'message)) + (loc (car msg)) + last) (if (zerop n) (unless (or msg ; find message near here (setq msg (get-text-property (max (1- pt) 1) 'message))) @@ -1263,13 +1269,15 @@ (setq msg (get-text-property pt 'message)) (setq pt (point))))) (setq last (nth 2 (car msg))) - ;; These loops search only either forwards or backwards - (compilation-loop > next-single-property-change 1- - (if (get-buffer-process (current-buffer)) - "No more %ss yet" - "Moved past last %s")) - (compilation-loop < previous-single-property-change 1+ - "Moved back before first %s")) + (if (>= n 0) + (compilation-loop > next-single-property-change 1- + (if (get-buffer-process (current-buffer)) + "No more %ss yet" + "Moved past last %s")) + ;; don't move "back" to message at or before point + (setq pt (previous-single-property-change pt 'message)) + (compilation-loop < previous-single-property-change 1+ + "Moved back before first %s"))) (goto-char pt) (or msg (error "No %s here" compilation-error)))) @@ -1327,6 +1335,7 @@ (mouse-set-point event) (if (get-text-property (point) 'directory) (dired-other-window (car (get-text-property (point) 'directory))) + (setq compilation-current-error (point)) (next-error 0))) (defun compile-goto-error () @@ -1338,6 +1347,7 @@ (if (get-text-property (point) 'directory) (dired-other-window (car (get-text-property (point) 'directory))) (push-mark) + (setq compilation-current-error (point)) (next-error 0))) ;; Return a compilation buffer. @@ -1393,10 +1403,12 @@ (set-buffer (setq compilation-last-buffer (compilation-find-buffer))) (let* ((columns compilation-error-screen-columns) ; buffer's local value (last 1) - (loc (compilation-next-error (or n 1))) + (loc (compilation-next-error (or n 1) nil + (or compilation-current-error (point-min)))) (end-loc (nth 2 loc)) (marker (point-marker))) - (setq loc (car loc)) + (setq compilation-current-error (point-marker) + loc (car loc)) ;; If loc contains no marker, no error in that file has been visited. If ;; the marker is invalid the buffer has been killed. So, recalculate all ;; markers for that file. @@ -1448,10 +1460,10 @@ This operates on the output from the \\[compile] command." (interactive "p") (set-buffer (setq compilation-last-buffer (compilation-find-buffer))) - (goto-char (point-min)) + (setq compilation-current-error (point-min)) (next-error n)) -(defvar compilation-skip-to-next-location nil +(defvar compilation-skip-to-next-location t "*If non-nil, skip multiple error messages for the same source location.") (defcustom compilation-skip-threshold 1
--- a/lisp/progmodes/ebnf-abn.el Sat Apr 03 20:02:51 2004 +0000 +++ b/lisp/progmodes/ebnf-abn.el Sat Apr 03 20:24:17 2004 +0000 @@ -4,7 +4,7 @@ ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> -;; Time-stamp: <2004/02/28 17:40:41 vinicius> +;; Time-stamp: <2004/03/18 23:49:58 vinicius> ;; Keywords: wp, ebnf, PostScript ;; Version: 1.0 @@ -233,6 +233,8 @@ (setq token (ebnf-abn-lex)) (and (eq token 'end-of-input) (error "Invalid ABNF file format")) + (and (eq token 'end-of-rule) + (setq token (ebnf-abn-lex))) (while (not (eq token 'end-of-input)) (ebnf-message-float "Parsing...%s%%"
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/progmodes/ebnf-ebx.el Sat Apr 03 20:24:17 2004 +0000 @@ -0,0 +1,672 @@ +;;; ebnf-ebx.el --- parser for EBNF used to specify XML (EBNFX) + +;; 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/03/22 08:53:21 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 EBNF used to specify XML (EBNFX). +;; +;; See ebnf2ps.el for documentation. +;; +;; +;; EBNFX Syntax +;; ------------ +;; +;; See the URL: +;; `http://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation' +;; (Extensible Markup Language (XML) 1.0 (Third Edition)) +;; +;; +;; rule ::= symbol '::=' expression +;; /* rules are separated by at least one blank line. */ +;; +;; expression ::= concatenation ('|' concatenation)* +;; +;; concatenation ::= exception* +;; +;; exception ::= term ('-' term)? +;; +;; term ::= factor ('*' | '+' | '?')? +;; +;; factor ::= hex-char+ +;; | '[' '^'? ( char ( '-' char )? )+ ']' +;; | '"' 'string' '"' +;; | "'" "string" "'" +;; | '(' expression ')' +;; | symbol +;; +;; symbol ::= 'upper or lower case letter' +;; ('upper or lower case letter' | '-' | '_')* +;; /* upper and lower 8-bit accentuated characters are included */ +;; +;; hex-char ::= '#x' [0-9A-Fa-f]+ +;; +;; char ::= hex-char | 'any character except control characters' +;; /* 8-bit accentuated characters are included */ +;; +;; any-char ::= char | 'newline' | 'tab' +;; +;; ignore ::= '[' ('wfc' | 'WFC' | 'vc' | 'VC') ':' ( any-char - ']' )* ']' +;; +;; comment ::= '/*' ( any-char - '*/' ) '*/' +;; +;; +;; Below is the Notation section extracted from the URL cited above. +;; +;; 6 Notation +;; +;; The formal grammar of XML is given in this specification using a simple +;; Extended Backus-Naur Form (EBNF) notation. Each rule in the grammar defines +;; one symbol, in the form +;; +;; symbol ::= expression +;; +;; Symbols are written with an initial capital letter if they are the start +;; symbol of a regular language, otherwise with an initial lowercase letter. +;; Literal strings are quoted. +;; +;; Within the expression on the right-hand side of a rule, the following +;; expressions are used to match strings of one or more characters: +;; +;; #xN +;; +;; where N is a hexadecimal integer, the expression matches the character +;; whose number (code point) in ISO/IEC 10646 is N. The number of leading +;; zeros in the #xN form is insignificant. +;; +;; [a-zA-Z], [#xN-#xN] +;; +;; matches any Char with a value in the range(s) indicated (inclusive). +;; +;; [abc], [#xN#xN#xN] +;; +;; matches any Char with a value among the characters enumerated. +;; Enumerations and ranges can be mixed in one set of brackets. +;; +;; [^a-z], [^#xN-#xN] +;; +;; matches any Char with a value outside the range indicated. +;; +;; [^abc], [^#xN#xN#xN] +;; +;; matches any Char with a value not among the characters given. +;; Enumerations and ranges of forbidden values can be mixed in one set of +;; brackets. +;; +;; "string" +;; +;; matches a literal string matching that given inside the double quotes. +;; +;; 'string' +;; +;; matches a literal string matching that given inside the single quotes. +;; +;; These symbols may be combined to match more complex patterns as follows, +;; where A and B represent simple expressions: +;; +;; (expression) +;; +;; expression is treated as a unit and may be combined as described in this +;; list. +;; +;; A? +;; +;; matches A or nothing; optional A. +;; +;; A B +;; +;; matches A followed by B. This operator has higher precedence than +;; alternation; thus A B | C D is identical to (A B) | (C D). +;; +;; A | B +;; +;; matches A or B. +;; +;; A - B +;; +;; matches any string that matches A but does not match B. +;; +;; A+ +;; +;; matches one or more occurrences of A. Concatenation has higher +;; precedence than alternation; thus A+ | B+ is identical to (A+) | (B+). +;; +;; A* +;; +;; matches zero or more occurrences of A. Concatenation has higher +;; precedence than alternation; thus A* | B* is identical to (A*) | (B*). +;; +;; Other notations used in the productions are: +;; +;; /* ... */ +;; +;; comment. +;; +;; [ wfc: ... ] +;; +;; well-formedness constraint; this identifies by name a constraint on +;; well-formed documents associated with a production. +;; +;; [ vc: ... ] +;; +;; validity constraint; this identifies by name a constraint on valid +;; documents associated with a production. +;; +;; +;; Differences Between EBNFX And ebnf2ps EBNFX +;; ------------------------------------------- +;; +;; Besides the characters that EBNFX accepts, ebnf2ps EBNFX accepts also the +;; underscore (_) and minus (-) for rule name and european 8-bit accentuated +;; characters (from \240 to \377) for rule name, string and comment. Also +;; rule name can start with upper case letter. +;; +;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Code: + + +(require 'ebnf-otz) + + +(defvar ebnf-ebx-lex nil + "Value returned by `ebnf-ebx-lex' function.") + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Syntactic analyzer + + +;;; rulelist ::= rule+ + +(defun ebnf-ebx-parser (start) + "EBNFX parser." + (let ((total (+ (- ebnf-limit start) 1)) + (bias (1- start)) + (origin (point)) + rule-list token rule) + (goto-char start) + (setq token (ebnf-ebx-lex)) + (and (eq token 'end-of-input) + (error "Invalid EBNFX file format")) + (and (eq token 'end-of-rule) + (setq token (ebnf-ebx-lex))) + (while (not (eq token 'end-of-input)) + (ebnf-message-float + "Parsing...%s%%" + (/ (* (- (point) bias) 100.0) total)) + (setq token (ebnf-ebx-rule token) + rule (cdr token) + token (car token)) + (or (ebnf-add-empty-rule-list rule) + (setq rule-list (cons rule rule-list)))) + (goto-char origin) + rule-list)) + + +;;; rule ::= symbol '::=' expression + + +(defun ebnf-ebx-rule (token) + (let ((name ebnf-ebx-lex) + (action ebnf-action) + elements) + (setq ebnf-action nil) + (or (eq token 'non-terminal) + (error "Invalid rule name")) + (setq token (ebnf-ebx-lex)) + (or (eq token 'production) + (error "Invalid rule: missing `::='")) + (setq elements (ebnf-ebx-expression)) + (or (memq (car elements) '(end-of-rule end-of-input)) + (error "Invalid rule: there is no end of rule")) + (setq elements (cdr elements)) + (ebnf-eps-add-production name) + (cons (ebnf-ebx-lex) + (ebnf-make-production name elements action)))) + + +;; expression ::= concatenation ('|' concatenation)* + + +(defun ebnf-ebx-expression () + (let (body concatenation) + (while (eq (car (setq concatenation + (ebnf-ebx-concatenation (ebnf-ebx-lex)))) + 'alternative) + (setq body (cons (cdr concatenation) body))) + (ebnf-token-alternative body concatenation))) + + +;; concatenation ::= exception* + + +(defun ebnf-ebx-concatenation (token) + (let ((term (ebnf-ebx-exception token)) + seq) + (or (setq token (car term) + term (cdr term)) + (error "Empty element")) + (setq seq (cons term seq)) + (while (setq term (ebnf-ebx-exception token) + token (car term) + term (cdr term)) + (setq seq (cons term seq))) + (cons token + (if (= (length seq) 1) + ;; sequence with only one element + (car seq) + ;; a real sequence + (ebnf-make-sequence (nreverse seq)))))) + + +;;; exception ::= term ('-' term)? + + +(defun ebnf-ebx-exception (token) + (let ((term (ebnf-ebx-term token))) + (if (eq (car term) 'exception) + (let ((except (ebnf-ebx-term (ebnf-ebx-lex)))) + (cons (car except) + (ebnf-make-except (cdr term) (cdr except)))) + term))) + + + +;;; term ::= factor ('*' | '+' | '?')? + + +(defun ebnf-ebx-term (token) + (let ((factor (ebnf-ebx-factor token))) + (when factor + (setq token (ebnf-ebx-lex)) + (cond ((eq token 'zero-or-more) + (setq factor (ebnf-make-zero-or-more factor) + token (ebnf-ebx-lex))) + ((eq token 'one-or-more) + (setq factor (ebnf-make-one-or-more factor) + token (ebnf-ebx-lex))) + ((eq token 'optional) + (setq factor (ebnf-token-optional factor) + token (ebnf-ebx-lex))))) + (cons token factor))) + + +;;; factor ::= hex-char+ +;;; | '[' '^'? ( char ( '-' char )? )+ ']' +;;; | '"' 'string' '"' +;;; | "'" "string" "'" +;;; | '(' expression ')' +;;; | symbol +;;; +;;; symbol ::= 'upper or lower case letter' +;;; ('upper or lower case letter' | '-' | '_')* +;;; /* upper and lower 8-bit accentuated characters are included */ +;;; +;;; hex-char ::= '#x' [0-9A-Fa-f]+ +;;; +;;; char ::= hex-char | 'any character except control characters' +;;; /* 8-bit accentuated characters are included */ +;;; +;;; any-char ::= char | 'newline' | 'tab' + + +(defun ebnf-ebx-factor (token) + (cond + ;; terminal + ((eq token 'terminal) + (ebnf-make-terminal ebnf-ebx-lex)) + ;; non-terminal + ((eq token 'non-terminal) + (ebnf-make-non-terminal ebnf-ebx-lex)) + ;; group + ((eq token 'begin-group) + (let ((body (ebnf-ebx-expression))) + (or (eq (car body) 'end-group) + (error "Missing `)'")) + (cdr body))) + ;; no element + (t + nil) + )) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Lexical analyzer + + +(defconst ebnf-ebx-token-table (make-vector 256 'error) + "Vector used to map characters to a lexical token.") + + +(defun ebnf-ebx-initialize () + "Initialize EBNFX token table." + ;; control character & control 8-bit character are set to `error' + (let ((char ?\101)) + ;; printable character: A-Z + (while (< char ?\133) + (aset ebnf-ebx-token-table char 'non-terminal) + (setq char (1+ char))) + ;; printable character: a-z + (setq char ?\141) + (while (< char ?\173) + (aset ebnf-ebx-token-table char 'non-terminal) + (setq char (1+ char))) + ;; European 8-bit accentuated characters: + (setq char ?\240) + (while (< char ?\400) + (aset ebnf-ebx-token-table char 'non-terminal) + (setq char (1+ char))) + ;; Override end of line characters: + (aset ebnf-ebx-token-table ?\n 'end-of-rule) ; [NL] linefeed + (aset ebnf-ebx-token-table ?\r 'end-of-rule) ; [CR] carriage return + ;; Override space characters: + (aset ebnf-ebx-token-table ?\013 'space) ; [VT] vertical tab + (aset ebnf-ebx-token-table ?\t 'space) ; [HT] horizontal tab + (aset ebnf-ebx-token-table ?\ 'space) ; [SP] space + ;; Override form feed character: + (aset ebnf-ebx-token-table ?\f 'form-feed) ; [FF] form feed + ;; Override other lexical characters: + (aset ebnf-ebx-token-table ?# 'hash) + (aset ebnf-ebx-token-table ?\" 'double-quote) + (aset ebnf-ebx-token-table ?\' 'single-quote) + (aset ebnf-ebx-token-table ?\( 'begin-group) + (aset ebnf-ebx-token-table ?\) 'end-group) + (aset ebnf-ebx-token-table ?- 'exception) + (aset ebnf-ebx-token-table ?: 'colon) + (aset ebnf-ebx-token-table ?\[ 'begin-square) + (aset ebnf-ebx-token-table ?| 'alternative) + (aset ebnf-ebx-token-table ?* 'zero-or-more) + (aset ebnf-ebx-token-table ?+ 'one-or-more) + (aset ebnf-ebx-token-table ?\? 'optional) + ;; Override comment character: + (aset ebnf-ebx-token-table ?/ 'comment))) + + +;; replace the range "\240-\377" (see `ebnf-range-regexp'). +(defconst ebnf-ebx-non-terminal-chars + (ebnf-range-regexp "-_A-Za-z" ?\240 ?\377)) +(defconst ebnf-ebx-non-terminal-letter-chars + (ebnf-range-regexp "A-Za-z" ?\240 ?\377)) + + +(defun ebnf-ebx-lex () + "Lexical analyser for EBNFX. + +Return a lexical token. + +See documentation for variable `ebnf-ebx-lex'." + (if (>= (point) ebnf-limit) + 'end-of-input + (let (token) + ;; skip spaces and comments + (while (if (> (following-char) 255) + (progn + (setq token 'error) + nil) + (setq token (aref ebnf-ebx-token-table (following-char))) + (cond + ((eq token 'space) + (skip-chars-forward " \013\t" ebnf-limit) + (< (point) ebnf-limit)) + ((eq token 'comment) + (ebnf-ebx-skip-comment)) + ((eq token 'form-feed) + (forward-char) + (setq ebnf-action 'form-feed)) + ((eq token 'end-of-rule) + (ebnf-ebx-skip-end-of-rule)) + ((and (eq token 'begin-square) + (let ((case-fold-search t)) + (looking-at "\\[\\(wfc\\|vc\\):"))) + (ebnf-ebx-skip-constraint)) + (t nil) + ))) + (cond + ;; end of input + ((>= (point) ebnf-limit) + 'end-of-input) + ;; error + ((eq token 'error) + (error "Illegal character")) + ;; end of rule + ((eq token 'end-of-rule) + 'end-of-rule) + ;; terminal: #x [0-9A-Fa-f]+ + ((eq token 'hash) + (setq ebnf-ebx-lex (ebnf-ebx-character)) + 'terminal) + ;; terminal: "string" + ((eq token 'double-quote) + (setq ebnf-ebx-lex (ebnf-ebx-string ?\")) + 'terminal) + ;; terminal: 'string' + ((eq token 'single-quote) + (setq ebnf-ebx-lex (ebnf-ebx-string ?\')) + 'terminal) + ;; terminal: [ ^? ( char ( - char )? )+ ] + ((eq token 'begin-square) + (setq ebnf-ebx-lex (ebnf-ebx-range)) + 'terminal) + ;; non-terminal: NAME + ((eq token 'non-terminal) + (setq ebnf-ebx-lex + (ebnf-buffer-substring ebnf-ebx-non-terminal-chars)) + 'non-terminal) + ;; colon: ::= + ((eq token 'colon) + (or (looking-at "::=") + (error "Missing `::=' token")) + (forward-char 3) + 'production) + ;; miscellaneous: (, ), *, +, ?, |, - + (t + (forward-char) + token) + )))) + + +;; replace the range "\177-\237" (see `ebnf-range-regexp'). +(defconst ebnf-ebx-constraint-chars + (ebnf-range-regexp "^\000-\010\016-\037]" ?\177 ?\237)) + + +(defun ebnf-ebx-skip-constraint () + (or (> (skip-chars-forward ebnf-ebx-constraint-chars ebnf-limit) 0) + (error "Invalid character")) + (or (= (following-char) ?\]) + (error "Missing end of constraint `]'")) + (forward-char) + t) + + + +(defun ebnf-ebx-skip-end-of-rule () + (let (eor-p) + (while (progn + ;; end of rule ==> 2 or more consecutive end of lines + (setq eor-p (or (> (skip-chars-forward "\r\n" ebnf-limit) 1) + eor-p)) + ;; skip spaces + (skip-chars-forward " \013\t" ebnf-limit) + ;; skip comments + (and (= (following-char) ?/) + (ebnf-ebx-skip-comment)))) + (not eor-p))) + + +;; replace the range "\177-\237" (see `ebnf-range-regexp'). +(defconst ebnf-ebx-comment-chars + (ebnf-range-regexp "^\000-\010\016-\037\\*" ?\177 ?\237)) +(defconst ebnf-ebx-filename-chars + (ebnf-range-regexp "^\000-\037\\*" ?\177 ?\237)) + + +(defun ebnf-ebx-skip-comment () + (forward-char) + (or (= (following-char) ?*) + (error "Invalid beginning of comment")) + (forward-char) + (cond + ;; open EPS file + ((and ebnf-eps-executing (= (following-char) ?\[)) + (ebnf-eps-add-context (ebnf-ebx-eps-filename))) + ;; close EPS file + ((and ebnf-eps-executing (= (following-char) ?\])) + (ebnf-eps-remove-context (ebnf-ebx-eps-filename))) + ;; any other action in comment + (t + (setq ebnf-action (aref ebnf-comment-table (following-char)))) + ) + (while (progn + (skip-chars-forward ebnf-ebx-comment-chars ebnf-limit) + (or (= (following-char) ?*) + (error "Missing end of comment")) + (forward-char) + (and (/= (following-char) ?/) + (< (point) ebnf-limit)))) + ;; check for a valid end of comment + (and (>= (point) ebnf-limit) + (error "Missing end of comment")) + (forward-char) + t) + + +(defun ebnf-ebx-eps-filename () + (forward-char) + (let (fname nchar) + (while (progn + (setq fname + (concat fname + (ebnf-buffer-substring ebnf-ebx-filename-chars))) + (and (< (point) ebnf-limit) + (> (setq nchar (skip-chars-forward "*" ebnf-limit)) 0) + (< (point) ebnf-limit) + (/= (following-char) ?/))) + (setq fname (concat fname (make-string nchar ?*)) + nchar nil)) + (if (or (not nchar) (= nchar 0)) + fname + (and (< (point) ebnf-limit) + (= (following-char) ?/) + (setq nchar (1- nchar))) + (concat fname (make-string nchar ?*))))) + + +;; replace the range "\240-\377" (see `ebnf-range-regexp'). +(defconst ebnf-ebx-double-string-chars + (ebnf-range-regexp "\t -!#-~" ?\240 ?\377)) +(defconst ebnf-ebx-single-string-chars + (ebnf-range-regexp "\t -&(-~" ?\240 ?\377)) + + +(defun ebnf-ebx-string (delim) + (buffer-substring-no-properties + (progn + (forward-char) + (point)) + (progn + (skip-chars-forward (if (= delim ?\") + ebnf-ebx-double-string-chars + ebnf-ebx-single-string-chars) + ebnf-limit) + (or (= (following-char) delim) + (error "Missing string delimiter `%c'" delim)) + (prog1 + (point) + (forward-char))))) + + +(defun ebnf-ebx-character () + ;; #x [0-9A-Fa-f]+ + (buffer-substring-no-properties + (point) + (progn + (ebnf-ebx-hex-character) + (point)))) + + +(defun ebnf-ebx-range () + ;; [ ^? ( char ( - char )? )+ ] + (buffer-substring-no-properties + (point) + (progn + (forward-char) + (and (= (following-char) ?^) + (forward-char)) + (and (= (following-char) ?-) + (forward-char)) + (while (progn + (ebnf-ebx-any-character) + (when (= (following-char) ?-) + (forward-char) + (ebnf-ebx-any-character)) + (and (/= (following-char) ?\]) + (< (point) ebnf-limit)))) + (and (>= (point) ebnf-limit) + (error "Missing end of character range `]'")) + (forward-char) + (point)))) + + +(defun ebnf-ebx-any-character () + (let ((char (following-char))) + (cond ((= char ?#) + (ebnf-ebx-hex-character t)) + ((or (and (<= ?\ char) (<= char ?\")) ; # + (and (<= ?$ char) (<= char ?,)) ; - + (and (<= ?. char) (<= char ?\\)) ; ] + (and (<= ?^ char) (<= char ?~)) + (and (<= ?\240 char) (<= char ?\377))) + (forward-char)) + (t + (error "Invalid character `%c'" char))))) + + +(defun ebnf-ebx-hex-character (&optional no-error) + ;; #x [0-9A-Fa-f]+ + (forward-char) + (if (/= (following-char) ?x) + (or no-error + (error "Invalid hexadecimal character")) + (forward-char) + (or (> (skip-chars-forward "0-9A-Fa-f" ebnf-limit) 0) + (error "Invalid hexadecimal character")))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +(provide 'ebnf-ebx) + +;;; arch-tag: bfe2f95b-66bc-4dc6-8b7e-b7831e68f5fb +;;; ebnf-ebx.el ends here
--- a/lisp/progmodes/ebnf2ps.el Sat Apr 03 20:02:51 2004 +0000 +++ b/lisp/progmodes/ebnf2ps.el Sat Apr 03 20:24:17 2004 +0000 @@ -5,9 +5,9 @@ ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> -;; Time-stamp: <2004/02/29 14:06:59 vinicius> +;; Time-stamp: <2004/03/30 21:49:21 vinicius> ;; Keywords: wp, ebnf, PostScript -;; Version: 4.0 +;; Version: 4.1 ;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/ ;; This file is part of GNU Emacs. @@ -27,8 +27,8 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. -(defconst ebnf-version "4.0" - "ebnf2ps.el, v 4.0 <2004/02/28 vinicius> +(defconst ebnf-version "4.1" + "ebnf2ps.el, v 4.1 <2004/03/18 vinicius> Vinicius's last change version. When reporting bugs, please also report the version of Emacs, if any, that ebnf2ps was running with. @@ -320,6 +320,10 @@ ;; setting: ;; `ebnf-yac-ignore-error-recovery'. ;; +;; `ebnfx' ebnf2ps recognizes the syntax described in the URL: +;; `http://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation' +;; ("Extensible Markup Language (XML) 1.0 (Third Edition)") +;; ;; Any other value is treated as `ebnf'. ;; ;; The default value is `ebnf'. @@ -1679,9 +1683,14 @@ setting: `ebnf-yac-ignore-error-recovery'. + `ebnfx' ebnf2ps recognizes the syntax described in the URL: + `http://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation' + (\"Extensible Markup Language (XML) 1.0 (Third Edition)\") + Any other value is treated as `ebnf'." :type '(radio :tag "Syntax" - (const ebnf) (const abnf) (const iso-ebnf) (const yacc)) + (const ebnf) (const abnf) (const iso-ebnf) + (const yacc) (const ebnfx)) :group 'ebnf-syntactic) @@ -2393,6 +2402,10 @@ (yacc default (ebnf-syntax . 'yacc)) + ;; ebnfx default + (ebnfx + default + (ebnf-syntax . 'ebnfx)) ) "Style database. @@ -4650,7 +4663,8 @@ '((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)) + (ebnf ebnf-bnf-parser ebnf-bnf-initialize) + (ebnfx ebnf-ebx-parser ebnf-ebx-initialize)) "Alist associating ebnf syntax with a parser and a initializer.") @@ -4748,52 +4762,53 @@ (defun ebnf-eps-finish-and-write (buffer filename) - (save-excursion - (set-buffer buffer) - (setq ebnf-eps-upper-x (max ebnf-eps-upper-x ebnf-eps-max-width) - ebnf-eps-upper-y (if (zerop ebnf-eps-upper-y) - ebnf-eps-max-height - (+ ebnf-eps-upper-y - ebnf-production-vertical-space - ebnf-eps-max-height))) - ;; prologue - (goto-char (point-min)) - (insert - "%!PS-Adobe-3.0 EPSF-3.0" - "\n%%BoundingBox: 0 0 " - (format "%d %d" (1+ ebnf-eps-upper-x) (1+ ebnf-eps-upper-y)) - "\n%%Title: " filename - "\n%%CreationDate: " (format-time-string "%T %b %d %Y") - "\n%%Creator: " (user-full-name) " (using ebnf2ps v" ebnf-version ")" - "\n%%DocumentNeededResources: font " - (or ebnf-fonts-required - (setq ebnf-fonts-required - (mapconcat 'identity - (ps-remove-duplicates - (mapcar 'ebnf-font-name-select - (list ebnf-production-font - ebnf-terminal-font - ebnf-non-terminal-font - ebnf-special-font - ebnf-except-font - ebnf-repeat-font))) - "\n%%+ font "))) - "\n%%Pages: 0\n%%EndComments\n\n%%BeginProlog\n" - ebnf-eps-prologue) - (ebnf-insert-ebnf-prologue) - (insert ebnf-eps-begin - "\n0 " (ebnf-format-float - (- ebnf-eps-upper-y (* ebnf-font-height-P 0.7))) - " #ebnf2ps#begin\n") - ;; epilogue - (goto-char (point-max)) - (insert ebnf-eps-end) - ;; write file - (message "Saving...") - (setq filename (expand-file-name filename)) - (let ((coding-system-for-write 'raw-text-unix)) - (write-region (point-min) (point-max) filename)) - (message "Wrote %s" filename))) + (when (buffer-modified-p buffer) + (save-excursion + (set-buffer buffer) + (setq ebnf-eps-upper-x (max ebnf-eps-upper-x ebnf-eps-max-width) + ebnf-eps-upper-y (if (zerop ebnf-eps-upper-y) + ebnf-eps-max-height + (+ ebnf-eps-upper-y + ebnf-production-vertical-space + ebnf-eps-max-height))) + ;; prologue + (goto-char (point-min)) + (insert + "%!PS-Adobe-3.0 EPSF-3.0" + "\n%%BoundingBox: 0 0 " + (format "%d %d" (1+ ebnf-eps-upper-x) (1+ ebnf-eps-upper-y)) + "\n%%Title: " filename + "\n%%CreationDate: " (format-time-string "%T %b %d %Y") + "\n%%Creator: " (user-full-name) " (using ebnf2ps v" ebnf-version ")" + "\n%%DocumentNeededResources: font " + (or ebnf-fonts-required + (setq ebnf-fonts-required + (mapconcat 'identity + (ps-remove-duplicates + (mapcar 'ebnf-font-name-select + (list ebnf-production-font + ebnf-terminal-font + ebnf-non-terminal-font + ebnf-special-font + ebnf-except-font + ebnf-repeat-font))) + "\n%%+ font "))) + "\n%%Pages: 0\n%%EndComments\n\n%%BeginProlog\n" + ebnf-eps-prologue) + (ebnf-insert-ebnf-prologue) + (insert ebnf-eps-begin + "\n0 " (ebnf-format-float + (- ebnf-eps-upper-y (* ebnf-font-height-P 0.7))) + " #ebnf2ps#begin\n") + ;; epilogue + (goto-char (point-max)) + (insert ebnf-eps-end) + ;; write file + (message "Saving...") + (setq filename (expand-file-name filename)) + (let ((coding-system-for-write 'raw-text-unix)) + (write-region (point-min) (point-max) filename)) + (message "Wrote %s" filename)))) (defun ebnf-insert-ebnf-prologue () @@ -5688,6 +5703,12 @@ (autoload 'ebnf-yac-initialize "ebnf-yac" "Initializations for Yacc/Bison parser.") +(autoload 'ebnf-ebx-parser "ebnf-ebx" + "EBNFX parser.") + +(autoload 'ebnf-ebx-initialize "ebnf-ebx" + "Initializations for EBNFX parser.") + (autoload 'ebnf-eliminate-empty-rules "ebnf-otz" "Eliminate empty rules.")
--- a/lisp/progmodes/gdb-ui.el Sat Apr 03 20:02:51 2004 +0000 +++ b/lisp/progmodes/gdb-ui.el Sat Apr 03 20:24:17 2004 +0000 @@ -69,9 +69,14 @@ The directory containing FILE becomes the initial working directory and source-file directory for your debugger. -If `gdb-many-windows' is nil (the default value) then gdb starts with -just two windows : the GUD and the source buffer. If it is t the -following layout will appear (keybindings given in relevant buffer) : +If `gdb-many-windows' is nil (the default value) then gdb just +pops up the GUD buffer unless `gdb-show-main' is t. In this case +it starts with two windows: one displaying the GUD buffer and the +other with the source file with the main routine of the debugee. + +If `gdb-many-windows' is t the layout below will appear +regardless of the value of `gdb-show-main'. Keybindings are given +in relevant buffer. --------------------------------------------------------------------- GDB Toolbar @@ -81,7 +86,7 @@ | | --------------------------------------------------------------------- -Source buffer | Input/Output (of debuggee) buffer +Source buffer | Input/Output (of debugee) buffer | (comint-mode) | | @@ -309,7 +314,7 @@ (let ((varnum (match-string 1))) (gdb-enqueue-input (list (concat "server interpreter mi \"-var-evaluate-expression " - varnum "\"\n") + varnum "\"\n") `(lambda () (gdb-var-evaluate-expression-handler ,varnum t))))))) (gdb-set-pending-triggers @@ -672,7 +677,10 @@ (match-string 1 args) (string-to-int (match-string 2 args)))) (setq gdb-current-address (match-string 3 args)) - (setq gdb-view-source t)) + (setq gdb-view-source t) +;; cover for auto-display output which comes *before* +;; stopped annotation + (if (eq (gdb-get-output-sink) 'inferior) (gdb-set-output-sink 'user))) (defun gdb-send-item (item) (if gdb-enable-debug-log (push (cons 'send item) gdb-debug-log)) @@ -778,7 +786,8 @@ (gdb-invalidate-registers) (gdb-invalidate-locals) (gdb-invalidate-threads) - (unless (eq window-system 'mac) + (unless (eq system-type 'darwin) ;Breaks on Darwin's GDB-5.3. + ;; FIXME: with GDB-6 on Darwin, this might very well work. (dolist (frame (frame-list)) (when (string-equal (frame-parameter frame 'name) "Speedbar") (setq gdb-var-changed t) ; force update @@ -1596,24 +1605,38 @@ (defun gdb-view-source-function () (interactive) (if gdb-view-source - (if gud-last-last-frame - (set-window-buffer gdb-source-window - (gud-find-file (car gud-last-last-frame))) - (set-window-buffer gdb-source-window (gud-find-file gdb-main-file)))) + (if (window-live-p gdb-source-window) + (set-window-buffer gdb-source-window + (if gud-last-last-frame + (gud-find-file (car gud-last-last-frame)) + (gud-find-file gdb-main-file))) + (setq gdb-source-window + (display-buffer + (if gud-last-last-frame + (gud-find-file (car gud-last-last-frame)) + (gud-find-file gdb-main-file)))))) (setq gdb-selected-view 'source)) (defun gdb-view-assembler() (interactive) - (set-window-buffer gdb-source-window - (gdb-get-create-buffer 'gdb-assembler-buffer)) + (if (window-live-p gdb-source-window) + (set-window-buffer gdb-source-window + (gdb-get-create-buffer 'gdb-assembler-buffer)) + (setq gdb-source-window + (display-buffer (gdb-get-create-buffer 'gdb-assembler-buffer)))) (setq gdb-selected-view 'assembler)) ;(defun gdb-view-both() ;(interactive) ;(setq gdb-selected-view 'both)) -;; layout for all the windows +(defcustom gdb-show-main nil + "Nil means don't display source file containing the main routine." + :type 'boolean + :group 'gud) + (defun gdb-setup-windows () + "Layout the window pattern for gdb-many-windows." (gdb-display-locals-buffer) (gdb-display-stack-buffer) (delete-other-windows) @@ -1714,20 +1737,20 @@ (if (looking-at "\\S-*") (setq gdb-main-file (match-string 0))) (setq gdb-view-source nil)) - (delete-other-windows) - (switch-to-buffer gud-comint-buffer) (if gdb-many-windows (gdb-setup-windows) - (gdb-display-breakpoints-buffer) - (delete-other-windows) - (split-window) - (other-window 1) - (switch-to-buffer - (if gdb-view-source - (gud-find-file gdb-main-file) - (gdb-get-create-buffer 'gdb-assembler-buffer))) - (setq gdb-source-window (get-buffer-window (current-buffer))) - (other-window 1))) + (gdb-get-create-buffer 'gdb-breakpoints-buffer) + (when gdb-show-main + (switch-to-buffer gud-comint-buffer) + (delete-other-windows) + (split-window) + (other-window 1) + (switch-to-buffer + (if gdb-view-source + (gud-find-file gdb-main-file) + (gdb-get-create-buffer 'gdb-assembler-buffer))) + (setq gdb-source-window (get-buffer-window (current-buffer))) + (other-window 1)))) ;;from put-image (defun gdb-put-string (putstring pos &optional dprop) @@ -1764,9 +1787,9 @@ (gdb-remove-breakpoint-icons start end) (if (display-images-p) (if (>= (car (window-fringes)) 8) - (gdb-put-string + (gdb-put-string nil (1+ start) - `(left-fringe + `(left-fringe ,(or breakpoint-bitmap (setq breakpoint-bitmap (define-fringe-bitmap @@ -1786,7 +1809,7 @@ (if enabled (or breakpoint-enabled-icon (setq breakpoint-enabled-icon - (find-image `((:type xpm :data + (find-image `((:type xpm :data ,breakpoint-xpm-data :ascent 100 :pointer hand) (:type pbm :data
--- a/lisp/progmodes/gud.el Sat Apr 03 20:02:51 2004 +0000 +++ b/lisp/progmodes/gud.el Sat Apr 03 20:24:17 2004 +0000 @@ -477,7 +477,7 @@ ;; gud-marker-acc until we receive the rest of it. Since we ;; know the full marker regexp above failed, it's pretty simple to ;; test for marker starts. - (if (string-match "\032.*\\'" gud-marker-acc) + (if (string-match "\n\\(\032.*\\)?\\'" gud-marker-acc) (progn ;; Everything before the potential marker start can be output. (setq output (concat output (substring gud-marker-acc
--- a/lisp/subr.el Sat Apr 03 20:02:51 2004 +0000 +++ b/lisp/subr.el Sat Apr 03 20:24:17 2004 +0000 @@ -2274,28 +2274,6 @@ (subrp object) (byte-code-function-p object) (eq (car-safe object) 'lambda))) -(defun interactive-form (function) - "Return the interactive form of FUNCTION. -If function is a command (see `commandp'), value is a list of the form -\(interactive SPEC). If function is not a command, return nil." - (setq function (indirect-function function)) - (when (commandp function) - (cond ((byte-code-function-p function) - (when (> (length function) 5) - (let ((spec (aref function 5))) - (if spec - (list 'interactive spec) - (list 'interactive))))) - ((subrp function) - (subr-interactive-form function)) - ((eq (car-safe function) 'lambda) - (setq function (cddr function)) - (when (stringp (car function)) - (setq function (cdr function))) - (let ((form (car function))) - (when (eq (car-safe form) 'interactive) - (copy-sequence form))))))) - (defun assq-delete-all (key alist) "Delete from ALIST all elements whose car is KEY. Return the modified alist.
--- a/lisp/vc.el Sat Apr 03 20:02:51 2004 +0000 +++ b/lisp/vc.el Sat Apr 03 20:24:17 2004 +0000 @@ -7,7 +7,7 @@ ;; Maintainer: Andre Spiegel <spiegel@gnu.org> ;; Keywords: tools -;; $Id: vc.el,v 1.373 2004/03/26 16:17:12 monnier Exp $ +;; $Id: vc.el,v 1.374 2004/03/28 22:00:19 monnier Exp $ ;; This file is part of GNU Emacs. @@ -1677,10 +1677,10 @@ (message "No changes to %s since latest version" file) (vc-version-diff file nil nil))))) -(defun vc-version-diff (file rel1 rel2) - "List the differences between FILE's versions REL1 and REL2. -If REL1 is empty or nil it means to use the current workfile version; -REL2 empty or nil means the current file contents. FILE may also be +(defun vc-version-diff (file rev1 rev2) + "List the differences between FILE's versions REV1 and REV2. +If REV1 is empty or nil it means to use the current workfile version; +REV2 empty or nil means the current file contents. FILE may also be a directory, in that case, generate diffs between the correponding versions of all registered files in or below it." (interactive @@ -1689,7 +1689,7 @@ "File or dir to diff: (default visited file) " "File or dir to diff: ") default-directory buffer-file-name t))) - (rel1-default nil) (rel2-default nil)) + (rev1-default nil) (rev2-default nil)) ;; compute default versions based on the file state (cond ;; if it's a directory, don't supply any version default @@ -1697,54 +1697,54 @@ nil) ;; if the file is not up-to-date, use current version as older version ((not (vc-up-to-date-p file)) - (setq rel1-default (vc-workfile-version file))) + (setq rev1-default (vc-workfile-version file))) ;; if the file is not locked, use last and previous version as default (t - (setq rel1-default (vc-call previous-version file + (setq rev1-default (vc-call previous-version file (vc-workfile-version file))) - (if (string= rel1-default "") (setq rel1-default nil)) - (setq rel2-default (vc-workfile-version file)))) + (if (string= rev1-default "") (setq rev1-default nil)) + (setq rev2-default (vc-workfile-version file)))) ;; construct argument list (list file - (read-string (if rel1-default + (read-string (if rev1-default (concat "Older version: (default " - rel1-default ") ") + rev1-default ") ") "Older version: ") - nil nil rel1-default) - (read-string (if rel2-default + nil nil rev1-default) + (read-string (if rev2-default (concat "Newer version: (default " - rel2-default ") ") + rev2-default ") ") "Newer version (default: current source): ") - nil nil rel2-default)))) + nil nil rev2-default)))) (if (file-directory-p file) ;; recursive directory diff (progn (vc-setup-buffer "*vc-diff*") - (if (string-equal rel1 "") (setq rel1 nil)) - (if (string-equal rel2 "") (setq rel2 nil)) + (if (string-equal rev1 "") (setq rev1 nil)) + (if (string-equal rev2 "") (setq rev2 nil)) (let ((inhibit-read-only t)) (insert "Diffs between " - (or rel1 "last version checked in") + (or rev1 "last version checked in") " and " - (or rel2 "current workfile(s)") + (or rev2 "current workfile(s)") ":\n\n")) (let ((dir (file-name-as-directory file))) (vc-call-backend (vc-responsible-backend dir) - 'diff-tree dir rel1 rel2)) + 'diff-tree dir rev1 rev2)) (vc-exec-after `(let ((inhibit-read-only t)) (insert "\nEnd of diffs.\n")))) ;; Single file diff. It is important that the vc-controlled buffer ;; is still current at this time, because any local settings in that ;; buffer should affect the diff command. - (vc-diff-internal file rel1 rel2)) + (vc-diff-internal file rev1 rev2)) (set-buffer "*vc-diff*") (if (and (zerop (buffer-size)) (not (get-buffer-process (current-buffer)))) (progn - (if rel1 - (if rel2 - (message "No changes to %s between %s and %s" file rel1 rel2) - (message "No changes to %s since %s" file rel1)) + (if rev1 + (if rev2 + (message "No changes to %s between %s and %s" file rev1 rev2) + (message "No changes to %s since %s" file rev1)) (message "No changes to %s since latest version" file)) nil) (pop-to-buffer (current-buffer)) @@ -1758,29 +1758,40 @@ (shrink-window-if-larger-than-buffer))) t)) -(defun vc-diff-internal (file rel1 rel2) - "Run diff to compare FILE's revisions REL1 and REL2. +(defun vc-diff-label (file file-rev rev) + (concat (file-relative-name file) + (format-time-string "\t%d %b %Y %T %z\t" + (nth 5 (file-attributes file-rev))) + rev)) + +(defun vc-diff-internal (file rev1 rev2) + "Run diff to compare FILE's revisions REV1 and REV2. Diff output goes to the *vc-diff* buffer. The exit status of the diff command is returned. This function takes care to set up a proper coding system for diff output. If both revisions are available as local files, then it also does not actually call the backend, but performs a local diff." - (if (or (not rel1) (string-equal rel1 "")) - (setq rel1 (vc-workfile-version file))) - (if (string-equal rel2 "") - (setq rel2 nil)) - (let ((file-rel1 (vc-version-backup-file file rel1)) - (file-rel2 (if (not rel2) + (if (or (not rev1) (string-equal rev1 "")) + (setq rev1 (vc-workfile-version file))) + (if (string-equal rev2 "") + (setq rev2 nil)) + (let ((file-rev1 (vc-version-backup-file file rev1)) + (file-rev2 (if (not rev2) file - (vc-version-backup-file file rel2))) + (vc-version-backup-file file rev2))) (coding-system-for-read (vc-coding-system-for-diff file))) - (if (and file-rel1 file-rel2) + (if (and file-rev1 file-rev2) (apply 'vc-do-command "*vc-diff*" 1 "diff" nil (append (vc-switches nil 'diff) - (list (file-relative-name file-rel1) - (file-relative-name file-rel2)))) - (vc-call diff file rel1 rel2)))) + ;; Provide explicit labels like RCS or CVS would do + ;; so diff-mode refers to `file' rather than to + ;; `file-rev1' when trying to find/apply/undo hunks. + (list "-L" (vc-diff-label file file-rev1 rev1) + "-L" (vc-diff-label file file-rev2 rev2) + (file-relative-name file-rev1) + (file-relative-name file-rev2)))) + (vc-call diff file rev1 rev2)))) (defun vc-switches (backend op) @@ -1804,9 +1815,9 @@ (defmacro vc-diff-switches-list (backend) `(vc-switches ',backend 'diff)) (make-obsolete 'vc-diff-switches-list 'vc-switches "21.4") -(defun vc-default-diff-tree (backend dir rel1 rel2) +(defun vc-default-diff-tree (backend dir rev1 rev2) "List differences for all registered files at and below DIR. -The meaning of REL1 and REL2 is the same as for `vc-version-diff'." +The meaning of REV1 and REV2 is the same as for `vc-version-diff'." ;; This implementation does an explicit tree walk, and calls ;; vc-BACKEND-diff directly for each file. An optimization ;; would be to use `vc-diff-internal', so that diffs can be local, @@ -1821,7 +1832,7 @@ `(let ((coding-system-for-read (vc-coding-system-for-diff ',f))) (message "Looking at %s" ',f) (vc-call-backend ',(vc-backend f) - 'diff ',f ',rel1 ',rel2)))))) + 'diff ',f ',rev1 ',rev2)))))) (defun vc-coding-system-for-diff (file) "Return the coding system for reading diff output for FILE."
--- a/lisp/x-dnd.el Sat Apr 03 20:02:51 2004 +0000 +++ b/lisp/x-dnd.el Sat Apr 03 20:24:17 2004 +0000 @@ -337,7 +337,12 @@ DATA is the moz-url, which is formatted as two strings separated by \r\n. The first string is the URL, the second string is the title of that URL. DATA is encoded in utf-16. Decode the URL and call `x-dnd-handle-uri-list'." - (let* ((string (decode-coding-string data 'utf-16le)) ;; ALWAYS LE??? + ;; Mozilla and applications based on it (Galeon for example) uses + ;; text/unicode, but it is impossible to tell if it is le or be. Use what + ;; the machine Emacs runs on use. This looses if dropping between machines + ;; with different endian, but it is the best we can do. + (let* ((coding (if (eq (byteorder) ?B) 'utf-16be 'utf-16le)) + (string (decode-coding-string data coding)) (strings (split-string string "[\r\n]" t)) ;; Can one drop more than one moz-url ?? Assume not. (url (car strings)) @@ -352,7 +357,9 @@ (defun x-dnd-insert-utf16-text (window action text) "Decode the UTF-16 text and insert it at point. TEXT is the text as a string, WINDOW is the window where the drop happened." - (x-dnd-insert-text window action (decode-coding-string text 'utf-16le))) + ;; See comment in x-dnd-handle-moz-url about coding. + (let ((coding (if (eq (byteorder) ?B) 'utf-16be 'utf-16le))) + (x-dnd-insert-text window action (decode-coding-string text coding)))) (defun x-dnd-insert-ctext (window action text) "Decode the compound text and insert it at point.
--- a/man/ChangeLog Sat Apr 03 20:02:51 2004 +0000 +++ b/man/ChangeLog Sat Apr 03 20:24:17 2004 +0000 @@ -1,3 +1,8 @@ +2004-04-02 Luc Teirlinck <teirllm@auburn.edu> + + * files.texi (Reverting): Correct description of revert-buffer's + handling of point. + 2004-03-22 Juri Linkov <juri@jurta.org> * emacs.texi (Top): Add `Misc X'.
--- a/man/files.texi Sat Apr 03 20:02:51 2004 +0000 +++ b/man/files.texi Sat Apr 03 20:24:17 2004 +0000 @@ -855,11 +855,10 @@ the current buffer. Since reverting a buffer unintentionally could lose a lot of work, you must confirm this command with @kbd{yes}. - @code{revert-buffer} keeps point at the same distance (measured in -characters) from the beginning of the file. If the file was edited only -slightly, you will be at approximately the same piece of text after -reverting as before. If you have made drastic changes, the same value of -point in the old file may address a totally different piece of text. + @code{revert-buffer} tries to position point in such a way that, if +the file was edited only slightly, you will be at approximately the +same piece of text after reverting as before. However, if you have made +drastic changes, point may wind up in a totally different piece of text. Reverting marks the buffer as ``not modified'' until another change is made.
--- a/src/.gdbinit Sat Apr 03 20:02:51 2004 +0000 +++ b/src/.gdbinit Sat Apr 03 20:24:17 2004 +0000 @@ -1,4 +1,4 @@ -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000, 2001 +# Copyright (C) 1992, 93, 94, 95, 96, 97, 1998, 2000, 01, 2004 # Free Software Foundation, Inc. # # This file is part of GNU Emacs. @@ -38,12 +38,22 @@ # Set up a mask to use. # This should be EMACS_INT, but in some cases that is a macro. # long ought to work in all cases right now. -set $valmask = ((long)1 << gdb_valbits) - 1 -set $nonvalbits = gdb_emacs_intbits - gdb_valbits + +define xgetptr + set $ptr = (gdb_use_union ? $arg0.u.val : $arg0 & $valmask) | gdb_data_seg_bits +end + +define xgetint + set $int = gdb_use_union ? $arg0.s.val : (gdb_use_lsb ? $arg0 : $arg0 << gdb_gctypebits) >> gdb_gctypebits +end + +define xgettype + set $type = gdb_use_union ? $arg0.s.type : (enum Lisp_Type) (gdb_use_lsb ? $arg0 & $tagmask : $arg0 >> gdb_valbits) +end # Set up something to print out s-expressions. define pr -set debug_print ($) + set debug_print ($) end document pr Print the emacs s-expression which is $. @@ -51,115 +61,135 @@ end define xtype -output (enum Lisp_Type) (($ >> gdb_valbits) & 0x7) -echo \n -output ((($ >> gdb_valbits) & 0x7) == Lisp_Misc ? (enum Lisp_Misc_Type) (((struct Lisp_Free *) (($ & $valmask) | gdb_data_seg_bits))->type) : (($ >> gdb_valbits) & 0x7) == Lisp_Vectorlike ? ($size = ((struct Lisp_Vector *) (($ & $valmask) | gdb_data_seg_bits))->size, (enum pvec_type) (($size & PVEC_FLAG) ? $size & PVEC_TYPE_MASK : 0)) : 0) -echo \n + xgettype $ + output $type + echo \n + if $type == Lisp_Misc + xmisctype + else + if $type == Lisp_Vectorlike + xvectype + end + end end document xtype Print the type of $, assuming it is an Emacs Lisp value. If the first type printed is Lisp_Vector or Lisp_Misc, -the second line gives the more precise type. -Otherwise the second line doesn't mean anything. +a second line gives the more precise type. end define xvectype -set $size = ((struct Lisp_Vector *) (($ & $valmask) | gdb_data_seg_bits))->size -output (enum pvec_type) (($size & PVEC_FLAG) ? $size & PVEC_TYPE_MASK : 0) -echo \n + xgetptr $ + set $size = ((struct Lisp_Vector *) $ptr)->size + output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size + echo \n end document xvectype -Print the vector subtype of $, assuming it is a vector or pseudovector. +Print the size or vector subtype of $, assuming it is a vector or pseudovector. end define xmisctype -output (enum Lisp_Misc_Type) (((struct Lisp_Free *) (($ & $valmask) | gdb_data_seg_bits))->type) -echo \n + xgetptr $ + output (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type) + echo \n end document xmisctype Print the specific type of $, assuming it is some misc type. end define xint -print (($ & $valmask) << $nonvalbits) >> $nonvalbits + xgetint $ + print $int end document xint Print $, assuming it is an Emacs Lisp integer. This gets the sign right. end define xptr -print (void *) (($ & $valmask) | gdb_data_seg_bits) + xgetptr $ + print (void *) $ptr end document xptr Print the pointer portion of $, assuming it is an Emacs Lisp value. end define xmarker -print (struct Lisp_Marker *) (($ & $valmask) | gdb_data_seg_bits) + xgetptr $ + print (struct Lisp_Marker *) $ptr end document xmarker Print $ as a marker pointer, assuming it is an Emacs Lisp marker value. end define xoverlay -print (struct Lisp_Overlay *) (($ & $valmask) | gdb_data_seg_bits) + xgetptr $ + print (struct Lisp_Overlay *) $ptr end document xoverlay Print $ as a overlay pointer, assuming it is an Emacs Lisp overlay value. end define xmiscfree -print (struct Lisp_Free *) (($ & $valmask) | gdb_data_seg_bits) + xgetptr $ + print (struct Lisp_Free *) $ptr end document xmiscfree Print $ as a misc free-cell pointer, assuming it is an Emacs Lisp Misc value. end define xintfwd -print (struct Lisp_Intfwd *) (($ & $valmask) | gdb_data_seg_bits) + xgetptr $ + print (struct Lisp_Intfwd *) $ptr end document xintfwd Print $ as an integer forwarding pointer, assuming it is an Emacs Lisp Misc value. end define xboolfwd -print (struct Lisp_Boolfwd *) (($ & $valmask) | gdb_data_seg_bits) + xgetptr $ + print (struct Lisp_Boolfwd *) $ptr end document xboolfwd Print $ as a boolean forwarding pointer, assuming it is an Emacs Lisp Misc value. end define xobjfwd -print (struct Lisp_Objfwd *) (($ & $valmask) | gdb_data_seg_bits) + xgetptr $ + print (struct Lisp_Objfwd *) $ptr end document xobjfwd Print $ as an object forwarding pointer, assuming it is an Emacs Lisp Misc value. end define xbufobjfwd -print (struct Lisp_Buffer_Objfwd *) (($ & $valmask) | gdb_data_seg_bits) + xgetptr $ + print (struct Lisp_Buffer_Objfwd *) $ptr end document xbufobjfwd Print $ as a buffer-local object forwarding pointer, assuming it is an Emacs Lisp Misc value. end define xkbobjfwd -print (struct Lisp_Kboard_Objfwd *) (($ & $valmask) | gdb_data_seg_bits) + xgetptr $ + print (struct Lisp_Kboard_Objfwd *) $ptr end document xkbobjfwd Print $ as a kboard-local object forwarding pointer, assuming it is an Emacs Lisp Misc value. end define xbuflocal -print (struct Lisp_Buffer_Local_Value *) (($ & $valmask) | gdb_data_seg_bits) + xgetptr $ + print (struct Lisp_Buffer_Local_Value *) $ptr end document xbuflocal Print $ as a buffer-local-value pointer, assuming it is an Emacs Lisp Misc value. end define xsymbol -print (struct Lisp_Symbol *) ((((int) $) & $valmask) | gdb_data_seg_bits) -xprintsym $ + xgetptr $ + print (struct Lisp_Symbol *) $ptr + xprintsym $ + echo \n end document xsymbol Print the name and address of the symbol $. @@ -167,9 +197,10 @@ end define xstring -print (struct Lisp_String *) (($ & $valmask) | gdb_data_seg_bits) -output ($->size > 1000) ? 0 : ($->data[0])@($->size_byte < 0 ? $->size : $->size_byte) -echo \n + xgetptr $ + print (struct Lisp_String *) $ptr + output ($->size > 1000) ? 0 : ($->data[0])@($->size_byte < 0 ? $->size : $->size_byte) + echo \n end document xstring Print the contents and address of the string $. @@ -177,8 +208,9 @@ end define xvector -print (struct Lisp_Vector *) (($ & $valmask) | gdb_data_seg_bits) -output ($->size > 50) ? 0 : ($->contents[0])@($->size) + xgetptr $ + print (struct Lisp_Vector *) $ptr + output ($->size > 50) ? 0 : ($->contents[0])@($->size) echo \n end document xvector @@ -187,32 +219,36 @@ end define xprocess -print (struct Lisp_Process *) (($ & $valmask) | gdb_data_seg_bits) -output *$ -echo \n + xgetptr $ + print (struct Lisp_Process *) $ptr + output *$ + echo \n end document xprocess Print the address of the struct Lisp_process which the Lisp_Object $ points to. end define xframe -print (struct frame *) (($ & $valmask) | gdb_data_seg_bits) + xgetptr $ + print (struct frame *) $ptr end document xframe Print $ as a frame pointer, assuming it is an Emacs Lisp frame value. end define xcompiled -print (struct Lisp_Vector *) (($ & $valmask) | gdb_data_seg_bits) -output ($->contents[0])@($->size & 0xff) + xgetptr $ + print (struct Lisp_Vector *) $ptr + output ($->contents[0])@($->size & 0xff) end document xcompiled Print $ as a compiled function pointer, assuming it is an Emacs Lisp compiled value. end define xwindow -print (struct window *) (($ & $valmask) | gdb_data_seg_bits) -printf "%dx%d+%d+%d\n", $->width, $->height, $->left, $->top + xgetptr $ + print (struct window *) $ptr + printf "%dx%d+%d+%d\n", $->width, $->height, $->left, $->top end document xwindow Print $ as a window pointer, assuming it is an Emacs Lisp window value. @@ -220,27 +256,30 @@ end define xwinconfig -print (struct save_window_data *) (($ & $valmask) | gdb_data_seg_bits) + xgetptr $ + print (struct save_window_data *) $ptr end document xwinconfig Print $ as a window configuration pointer, assuming it is an Emacs Lisp window configuration value. end define xsubr -print (struct Lisp_Subr *) (($ & $valmask) | gdb_data_seg_bits) -output *$ -echo \n + xgetptr $ + print (struct Lisp_Subr *) $ptr + output *$ + echo \n end document xsubr Print the address of the subr which the Lisp_Object $ points to. end define xchartable -print (struct Lisp_Char_Table *) (($ & $valmask) | gdb_data_seg_bits) -printf "Purpose: " -output (char*)&((struct Lisp_Symbol *) ((((int) $->purpose) & $valmask) | gdb_data_seg_bits))->name->data -printf " %d extra slots", ($->size & 0x1ff) - 388 -echo \n + xgetptr $ + print (struct Lisp_Char_Table *) $ptr + printf "Purpose: " + xprintsym $->purpose + printf " %d extra slots", ($->size & 0x1ff) - 388 + echo \n end document xchartable Print the address of the char-table $, and its purpose. @@ -248,9 +287,10 @@ end define xboolvector -print (struct Lisp_Bool_Vector *) (($ & $valmask) | gdb_data_seg_bits) -output ($->size > 256) ? 0 : ($->data[0])@(($->size + 7)/ 8) -echo \n + xgetptr $ + print (struct Lisp_Bool_Vector *) $ptr + output ($->size > 256) ? 0 : ($->data[0])@(($->size + 7)/ 8) + echo \n end document xboolvector Print the contents and address of the bool-vector $. @@ -258,9 +298,11 @@ end define xbuffer -print (struct buffer *) (($ & $valmask) | gdb_data_seg_bits) -output ((struct Lisp_String *) ((($->name) & $valmask) | gdb_data_seg_bits))->data -echo \n + xgetptr $ + print (struct buffer *) $ptr + xgetptr $->name + output ((struct Lisp_String *) $ptr)->data + echo \n end document xbuffer Set $ as a buffer pointer, assuming it is an Emacs Lisp buffer value. @@ -268,24 +310,26 @@ end define xhashtable -print (struct Lisp_Hash_Table *) (($ & $valmask) | gdb_data_seg_bits) + xgetptr $ + print (struct Lisp_Hash_Table *) $ptr end document xhashtable Set $ as a hash table pointer, assuming it is an Emacs Lisp hash table value. end define xcons -print (struct Lisp_Cons *) (($ & $valmask) | gdb_data_seg_bits) -output/x *$ -echo \n + xgetptr $ + print (struct Lisp_Cons *) $ptr + output/x *$ + echo \n end document xcons Print the contents of $, assuming it is an Emacs Lisp cons. end define nextcons -p $.cdr -xcons + p $.cdr + xcons end document nextcons Print the contents of the next cell in a list. @@ -293,28 +337,34 @@ (type struct Lisp_Cons) or a pointer to one. end define xcar -print/x ((($ >> gdb_valbits) & 0xf) == Lisp_Cons ? ((struct Lisp_Cons *) (($ & $valmask) | gdb_data_seg_bits))->car : 0) + xgetptr $ + xgettype $ + print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->car : 0) end document xcar Print the car of $, assuming it is an Emacs Lisp pair. end define xcdr -print/x ((($ >> gdb_valbits) & 0xf) == Lisp_Cons ? ((struct Lisp_Cons *) (($ & $valmask) | gdb_data_seg_bits))->cdr : 0) + xgetptr $ + xgettype $ + print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->cdr : 0) end document xcdr Print the cdr of $, assuming it is an Emacs Lisp pair. end define xfloat -print ((struct Lisp_Float *) (($ & $valmask) | gdb_data_seg_bits))->data + xgetptr $ + print ((struct Lisp_Float *) $ptr)->data end document xfloat Print $ assuming it is a lisp floating-point number. end define xscrollbar -print (struct scrollbar *) (($ & $valmask) | gdb_data_seg_bits) + xgetptr $ + print (struct scrollbar *) $ptr output *$ echo \n end @@ -323,10 +373,11 @@ end define xprintsym - set $sym = (struct Lisp_Symbol *) ((((int) $arg0) & $valmask) | gdb_data_seg_bits) - set $sym_name = ((struct Lisp_String *)(($sym->xname & $valmask) | gdb_data_seg_bits)) + xgetptr $arg0 + set $sym = (struct Lisp_Symbol *) $ptr + xgetptr $sym->xname + set $sym_name = (struct Lisp_String *) $ptr output ($sym_name->data[0])@($sym_name->size_byte < 0 ? $sym_name->size : $sym_name->size_byte) - echo \n end document xprintsym Print argument as a symbol. @@ -335,14 +386,16 @@ define xbacktrace set $bt = backtrace_list while $bt - set $type = (enum Lisp_Type) ((*$bt->function >> gdb_valbits) & 0x7) + xgettype (*$bt->function) if $type == Lisp_Symbol - xprintsym *$bt->function + xprintsym (*$bt->function) + echo \n else printf "0x%x ", *$bt->function if $type == Lisp_Vectorlike - set $size = ((struct Lisp_Vector *) ((*$bt->function & $valmask) | gdb_data_seg_bits))->size - output (enum pvec_type) (($size & PVEC_FLAG) ? $size & PVEC_TYPE_MASK : 0) + xgetptr (*$bt->function) + set $size = ((struct Lisp_Vector *) $ptr)->size + output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size else printf "Lisp type %d", $type end @@ -358,16 +411,17 @@ end define xreload - set $valmask = ((long)1 << gdb_valbits) - 1 - set $nonvalbits = gdb_emacs_intbits - gdb_valbits + set $tagmask = (((long)1 << gdb_gctypebits) - 1) + set $valmask = gdb_use_lsb ? ~($tagmask) : ((long)1 << gdb_valbits) - 1 end document xreload When starting Emacs a second time in the same gdb session under - FreeBSD 2.2.5, gdb 4.13, $valmask and $nonvalbits have lost + FreeBSD 2.2.5, gdb 4.13, $valmask have lost their values. (The same happens on current (2000) versions of GNU/Linux with gdb 5.0.) This function reloads them. end +xreload define hook-run xreload
--- a/src/.gdbinit-union Sat Apr 03 20:02:51 2004 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,402 +0,0 @@ -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000, 2001 -# Free Software Foundation, Inc. -# -# 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. - -# Force loading of symbols, enough to give us gdb_valbits etc. -set main - -# Find lwlib source files too. -dir ../lwlib -#dir /gd/gnu/lesstif-0.89.9/lib/Xm - -# Don't enter GDB when user types C-g to quit. -# This has one unfortunate effect: you can't type C-c -# at the GDB to stop Emacs, when using X. -# However, C-z works just as well in that case. -handle 2 noprint pass - -# Don't pass SIGALRM to Emacs. This makes problems when -# debugging. -handle SIGALRM ignore - -# Set up a mask to use. -# This should be EMACS_INT, but in some cases that is a macro. -# long ought to work in all cases right now. -set $valmask = ((long)1 << gdb_valbits) - 1 -set $nonvalbits = gdb_emacs_intbits - gdb_valbits - -# Set up something to print out s-expressions. -define pr -set debug_print ($) -end -document pr -Print the emacs s-expression which is $. -Works only when an inferior emacs is executing. -end - -define xtype -output (enum Lisp_Type) (($.i >> gdb_valbits) & 0x7) -echo \n -output ((($.i >> gdb_valbits) & 0x7) == Lisp_Misc ? (enum Lisp_Misc_Type) (((struct Lisp_Free *) (($.i & $valmask) | gdb_data_seg_bits))->type) : (($.i >> gdb_valbits) & 0x7) == Lisp_Vectorlike ? ($size = ((struct Lisp_Vector *) (($.i & $valmask) | gdb_data_seg_bits))->size, (enum pvec_type) (($size & PVEC_FLAG) ? $size & PVEC_TYPE_MASK : 0)) : 0) -echo \n -end -document xtype -Print the type of $, assuming it is an Emacs Lisp value. -If the first type printed is Lisp_Vector or Lisp_Misc, -the second line gives the more precise type. -Otherwise the second line doesn't mean anything. -end - -define xvectype - set $size = ((struct Lisp_Vector *) (($.i & $valmask) | gdb_data_seg_bits))->size - output (enum pvec_type) (($size & PVEC_FLAG) ? $size & PVEC_TYPE_MASK : 0) - echo \n -end -document xvectype - Print the vector subtype of $, assuming it is a vector or pseudovector. -end - -define xmisctype - output (enum Lisp_Misc_Type) (((struct Lisp_Free *) (($.i & $valmask) | gdb_data_seg_bits))->type) - echo \n -end -document xmisctype - Print the specific type of $, assuming it is some misc type. -end - -define xint - print (($.i & $valmask) << $nonvalbits) >> $nonvalbits -end -document xint - Print $, assuming it is an Emacs Lisp integer. This gets the sign right. -end - -define xptr - print (void *) (($.i & $valmask) | gdb_data_seg_bits) -end -document xptr - Print the pointer portion of $, assuming it is an Emacs Lisp value. -end - -define xmarker - print (struct Lisp_Marker *) (($.i & $valmask) | gdb_data_seg_bits) -end -document xmarker - Print $ as a marker pointer, assuming it is an Emacs Lisp marker value. -end - -define xoverlay - print (struct Lisp_Overlay *) (($.i & $valmask) | gdb_data_seg_bits) -end -document xoverlay - Print $ as a overlay pointer, assuming it is an Emacs Lisp overlay value. -end - -define xmiscfree - print (struct Lisp_Free *) (($.i & $valmask) | gdb_data_seg_bits) -end -document xmiscfree - Print $ as a misc free-cell pointer, assuming it is an Emacs Lisp Misc value. -end - -define xintfwd - print (struct Lisp_Intfwd *) (($.i & $valmask) | gdb_data_seg_bits) -end -document xintfwd - Print $ as an integer forwarding pointer, assuming it is an Emacs Lisp Misc value. -end - -define xboolfwd - print (struct Lisp_Boolfwd *) (($.i & $valmask) | gdb_data_seg_bits) -end -document xboolfwd - Print $ as a boolean forwarding pointer, assuming it is an Emacs Lisp Misc value. -end - -define xobjfwd - print (struct Lisp_Objfwd *) (($.i & $valmask) | gdb_data_seg_bits) -end -document xobjfwd - Print $ as an object forwarding pointer, assuming it is an Emacs Lisp Misc value. -end - -define xbufobjfwd - print (struct Lisp_Buffer_Objfwd *) (($.i & $valmask) | gdb_data_seg_bits) -end -document xbufobjfwd - Print $ as a buffer-local object forwarding pointer, assuming it is an Emacs Lisp Misc value. -end - -define xkbobjfwd - print (struct Lisp_Kboard_Objfwd *) (($.i & $valmask) | gdb_data_seg_bits) -end -document xkbobjfwd - Print $ as a kboard-local object forwarding pointer, assuming it is an Emacs Lisp Misc value. -end - -define xbuflocal - print (struct Lisp_Buffer_Local_Value *) (($.i & $valmask) | gdb_data_seg_bits) -end -document xbuflocal - Print $ as a buffer-local-value pointer, assuming it is an Emacs Lisp Misc value. -end - -define xsymbol - print (struct Lisp_Symbol *) (($.i & $valmask) | gdb_data_seg_bits) - xprintsymptr $ -end -document xsymbol - Print the name and address of the symbol $. - This command assumes that $ is an Emacs Lisp symbol value. -end - -define xstring - print (struct Lisp_String *) (($.i & $valmask) | gdb_data_seg_bits) - output ($->size > 1000) ? 0 : ($->data[0])@($->size_byte < 0 ? $->size : $->size_byte) - echo \n -end -document xstring - Print the contents and address of the string $. - This command assumes that $ is an Emacs Lisp string value. -end - -define xvector - print (struct Lisp_Vector *) (($.i & $valmask) | gdb_data_seg_bits) - output ($->size > 50) ? 0 : ($->contents[0])@($->size) - echo \n -end -document xvector - Print the contents and address of the vector $. - This command assumes that $ is an Emacs Lisp vector value. -end - -define xprocess - print (struct Lisp_Process *) (($.i & $valmask) | gdb_data_seg_bits) - output *$ - echo \n -end -document xprocess - Print the address of the struct Lisp_process which the Lisp_Object $ points to. -end - -define xframe - print (struct frame *) (($.i & $valmask) | gdb_data_seg_bits) -end -document xframe - Print $ as a frame pointer, assuming it is an Emacs Lisp frame value. -end - -define xcompiled - print (struct Lisp_Vector *) (($.i & $valmask) | gdb_data_seg_bits) - output ($->contents[0])@($->size & 0xff) -end -document xcompiled - Print $ as a compiled function pointer, assuming it is an Emacs Lisp compiled value. -end - -define xwindow - print (struct window *) (($.i & $valmask) | gdb_data_seg_bits) - printf "%dx%d+%d+%d\n", $->width, $->height, $->left, $->top -end -document xwindow - Print $ as a window pointer, assuming it is an Emacs Lisp window value. - Print the window's position as "WIDTHxHEIGHT+LEFT+TOP". -end - -define xwinconfig - print (struct save_window_data *) (($.i & $valmask) | gdb_data_seg_bits) -end -document xwinconfig - Print $ as a window configuration pointer, assuming it is an Emacs Lisp window configuration value. -end - -define xsubr - print (struct Lisp_Subr *) (($.i & $valmask) | gdb_data_seg_bits) - output *$ - echo \n -end -document xsubr - Print the address of the subr which the Lisp_Object $ points to. -end - -define xchartable - print (struct Lisp_Char_Table *) (($.i & $valmask) | gdb_data_seg_bits) - printf "Purpose: " - output (char*)&((struct Lisp_Symbol *) (($->purpose.i & $valmask) | gdb_data_seg_bits))->name->data - printf " %d extra slots", ($->size & 0x1ff) - 388 - echo \n -end -document xchartable - Print the address of the char-table $, and its purpose. - This command assumes that $ is an Emacs Lisp char-table value. -end - -define xboolvector - print (struct Lisp_Bool_Vector *) (($.i & $valmask) | gdb_data_seg_bits) - output ($->size > 256) ? 0 : ($->data[0])@(($->size + 7)/ 8) - echo \n -end -document xboolvector - Print the contents and address of the bool-vector $. - This command assumes that $ is an Emacs Lisp bool-vector value. -end - -define xbuffer - print (struct buffer *) (($.i & $valmask) | gdb_data_seg_bits) - output ((struct Lisp_String *) (($->name.i & $valmask) | gdb_data_seg_bits))->data - echo \n -end -document xbuffer - Set $ as a buffer pointer, assuming it is an Emacs Lisp buffer value. - Print the name of the buffer. -end - -define xhashtable - print (struct Lisp_Hash_Table *) (($.i & $valmask) | gdb_data_seg_bits) -end -document xhashtable - Set $ as a hash table pointer, assuming it is an Emacs Lisp hash table value. -end - -define xcons - print (struct Lisp_Cons *) (($.i & $valmask) | gdb_data_seg_bits) - output/x *$ - echo \n -end -document xcons - Print the contents of $, assuming it is an Emacs Lisp cons. -end - -define nextcons - p $.cdr - xcons -end -document nextcons - Print the contents of the next cell in a list. - This assumes that the last thing you printed was a cons cell contents - (type struct Lisp_Cons) or a pointer to one. -end - -define xcar - print/x ((($.i >> gdb_valbits) & 0xf) == Lisp_Cons ? ((struct Lisp_Cons *) (($.i & $valmask) | gdb_data_seg_bits))->car : 0) -end -document xcar - Print the car of $, assuming it is an Emacs Lisp pair. -end - -define xcdr - print/x ((($.i >> gdb_valbits) & 0xf) == Lisp_Cons ? ((struct Lisp_Cons *) (($.i & $valmask) | gdb_data_seg_bits))->cdr : 0) -end -document xcdr - Print the cdr of $, assuming it is an Emacs Lisp pair. -end - -define xfloat - print ((struct Lisp_Float *) (($.i & $valmask) | gdb_data_seg_bits))->data -end -document xfloat - Print $ assuming it is a lisp floating-point number. -end - -define xscrollbar - print (struct scrollbar *) (($.i & $valmask) | gdb_data_seg_bits) - output *$ - echo \n -end -document xscrollbar - Print $ as a scrollbar pointer. -end - -define xprintsym - set $sym = ((struct Lisp_Symbol *) (($arg0.i & $valmask) | gdb_data_seg_bits)) - xprintsymptr $sym -end -document xprintsym - Print argument as a symbol. -end -define xprintsymptr - set $sym = $arg0 - set $sym_name = ((struct Lisp_String *)(($sym->xname.i & $valmask) | gdb_data_seg_bits)) - output ($sym_name->data[0])@($sym_name->size_byte < 0 ? $sym_name->size : $sym_name->size_byte) - echo \n -end - -define xbacktrace - set $bt = backtrace_list - while $bt - set $type = (enum Lisp_Type) (((*$bt->function).i >> gdb_valbits) & 0x7) - if $type == Lisp_Symbol - xprintsym (*$bt->function) - else - printf "0x%x ", (*$bt->function).i - if $type == Lisp_Vectorlike - set $size = ((struct Lisp_Vector *) (((*$bt->function).i & $valmask) | gdb_data_seg_bits))->size - output (enum pvec_type) (($size & PVEC_FLAG) ? $size & PVEC_TYPE_MASK : 0) - else - printf "Lisp type %d", $type - end - echo \n - end - set $bt = $bt->next - end -end -document xbacktrace - Print a backtrace of Lisp function calls from backtrace_list. - Set a breakpoint at Fsignal and call this to see from where - an error was signaled. -end - -define xreload - set $valmask = ((long)1 << gdb_valbits) - 1 - set $nonvalbits = gdb_emacs_intbits - gdb_valbits -end -document xreload - When starting Emacs a second time in the same gdb session under - FreeBSD 2.2.5, gdb 4.13, $valmask and $nonvalbits have lost - their values. (The same happens on current (2000) versions of GNU/Linux - with gdb 5.0.) - This function reloads them. -end - -define hook-run - xreload -end - -# Call xreload if a new Emacs executable is loaded. -define hookpost-run - xreload -end - -set print pretty on -set print sevenbit-strings - -# show environment DISPLAY -# show environment TERM -# set args -geometry 80x40+0+0 - -# Don't let abort actually run, as it will make -# stdio stop working and therefore the `pr' command above as well. -# break abort - -# If we are running in synchronous mode, we want a chance to look around -# before Emacs exits. Perhaps we should put the break somewhere else -# instead... -# break x_error_quitter - -# arch-tag: 08f4d20d-0254-4374-a80c-179d5a517915
--- a/src/ChangeLog Sat Apr 03 20:02:51 2004 +0000 +++ b/src/ChangeLog Sat Apr 03 20:24:17 2004 +0000 @@ -1,3 +1,46 @@ +2004-04-03 Stefan Monnier <monnier@iro.umontreal.ca> + + * .gdbinit-union: Remove. + + * .gdbinit: Make it work for USE_LSB_TAG and !NO_LISP_UNION. + (xgetptr, xgetint, xgettype): New funs. Use them everywhere. + ($nonvalbits): Remove. + ($valmask): Set it by calling xreload to avoid redundancy. + + * emacs.c (gdb_use_union, gdb_use_lsb): New vars. + (gdb_emacs_intbits): Remove. + +2004-03-31 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * data.c (Fbyteorder): Make test work even if unsigned is not 4 bytes. + +2004-03-30 Kenichi Handa <handa@m17n.org> + + * editfns.c (Fformat): Fix initialization of the array info. + +2004-03-30 Kim F. Storm <storm@cua.dk> + + * xterm.c (x_mouse_click_focus_ignore_position): New var. + (syms_of_xterm): DEFVAR_BOOL it. + (ignore_next_mouse_click_timeout): New var. + (handle_one_xevent): Clear it on KeyPress, set it on EnterNotify. + Use it to filter mouse clicks following focus event. + +2004-03-29 David Ponce <david@dponce.com> + + * callint.c (Fcall_interactively): Fix last change. + +2004-03-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * eval.c (Fcommandp): Simplify. + + * data.c (Finteractive_form): Rename from Fsubr_interactive_form. + Extend to handle all kinds of functions. + + * lisp.h (Finteractive_form): Declare. + + * callint.c (Fcall_interactively): Use it. + 2004-03-26 Kim F. Storm <storm@cua.dk> * xdisp.c (syms_of_xdisp): Include `void-variable' in list_of_error @@ -39,7 +82,7 @@ * image.c (Qcenter): Move to xdisp.c. * xdisp.c (Qcenter): Declare here. - (syms_of_xdisp): intern and staticpro it. + (syms_of_xdisp): Intern and staticpro it. (handle_single_display_prop): Allow space display property on all platforms. (display_mode_line): Set mode_line_p before displaying line.
--- a/src/callint.c Sat Apr 03 20:02:51 2004 +0000 +++ b/src/callint.c Sat Apr 03 20:24:17 2004 +0000 @@ -1,5 +1,5 @@ /* Call a Lisp function interactively. - Copyright (C) 1985, 86, 93, 94, 95, 1997, 2000, 02, 2003 + Copyright (C) 1985, 86, 93, 94, 95, 1997, 2000, 02, 03, 2004 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -347,25 +347,17 @@ goto lose; specs = XVECTOR (fun)->contents[COMPILED_INTERACTIVE]; } - else if (!CONSP (fun)) - goto lose; - else if (funcar = XCAR (fun), EQ (funcar, Qautoload)) + else { + Lisp_Object form; GCPRO2 (function, prefix_arg); - do_autoload (fun, function); + form = Finteractive_form (function); UNGCPRO; - goto retry; + if (CONSP (form)) + specs = filter_specs = Fcar (XCDR (form)); + else + goto lose; } - else if (EQ (funcar, Qlambda)) - { - specs = Fassq (Qinteractive, Fcdr (XCDR (fun))); - if (NILP (specs)) - goto lose; - filter_specs = Fnth (make_number (1), specs); - specs = Fcar (Fcdr (specs)); - } - else - goto lose; /* If either SPECS or STRING is set to a string, use it. */ if (STRINGP (specs))
--- a/src/data.c Sat Apr 03 20:02:51 2004 +0000 +++ b/src/data.c Sat Apr 03 20:24:17 2004 +0000 @@ -1,5 +1,5 @@ /* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter. - Copyright (C) 1985,86,88,93,94,95,97,98,99, 2000, 2001, 2003 + Copyright (C) 1985,86,88,93,94,95,97,98,99, 2000, 2001, 03, 2004 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -761,17 +761,39 @@ return Fcons (make_number (minargs), make_number (maxargs)); } -DEFUN ("subr-interactive-form", Fsubr_interactive_form, Ssubr_interactive_form, 1, 1, 0, - doc: /* Return the interactive form of SUBR or nil if none. -SUBR must be a built-in function. Value, if non-nil, is a list +DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0, + doc: /* Return the interactive form of CMD or nil if none. +CMD must be a command. Value, if non-nil, is a list \(interactive SPEC). */) - (subr) - Lisp_Object subr; + (cmd) + Lisp_Object cmd; { - if (!SUBRP (subr)) - wrong_type_argument (Qsubrp, subr); - if (XSUBR (subr)->prompt) - return list2 (Qinteractive, build_string (XSUBR (subr)->prompt)); + Lisp_Object fun = indirect_function (cmd); + + if (SUBRP (fun)) + { + if (XSUBR (fun)->prompt) + return list2 (Qinteractive, build_string (XSUBR (fun)->prompt)); + } + else if (COMPILEDP (fun)) + { + if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE) + return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE)); + } + else if (CONSP (fun)) + { + Lisp_Object funcar = XCAR (fun); + if (EQ (funcar, Qlambda)) + return Fassq (Qinteractive, Fcdr (XCDR (fun))); + else if (EQ (funcar, Qautoload)) + { + struct gcpro gcpro1; + GCPRO1 (cmd); + do_autoload (fun, cmd); + UNGCPRO; + return Finteractive_form (cmd); + } + } return Qnil; } @@ -2887,7 +2909,7 @@ () { unsigned i = 0x04030201; - int order = *(char *)&i == 4 ? 66 : 108; + int order = *(char *)&i == 1 ? 108 : 66; return make_number (order); } @@ -3209,7 +3231,7 @@ staticpro (&Qhash_table); defsubr (&Sindirect_variable); - defsubr (&Ssubr_interactive_form); + defsubr (&Sinteractive_form); defsubr (&Seq); defsubr (&Snull); defsubr (&Stype_of);
--- a/src/editfns.c Sat Apr 03 20:02:51 2004 +0000 +++ b/src/editfns.c Sat Apr 03 20:24:17 2004 +0000 @@ -3280,7 +3280,7 @@ int i; info = (struct info *) alloca (nbytes); bzero (info, nbytes); - for (i = 0; i <= nargs; i++) + for (i = 0; i < nargs; i++) info[i].start = -1; discarded = (char *) alloca (SBYTES (args[0])); bzero (discarded, SBYTES (args[0]));
--- a/src/emacs.c Sat Apr 03 20:02:51 2004 +0000 +++ b/src/emacs.c Sat Apr 03 20:24:17 2004 +0000 @@ -1,5 +1,5 @@ /* Fully extensible Emacs, running on Unix, intended for GNU. - Copyright (C) 1985,86,87,93,94,95,97,98,1999,2001,02,2003 + Copyright (C) 1985,86,87,93,94,95,97,98,1999,2001,02,03,2004 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -87,9 +87,18 @@ /* Make these values available in GDB, which doesn't see macros. */ +#ifdef USE_LSB_TAG +int gdb_use_lsb = 1; +#else +int gdb_use_lsb = 0; +#endif +#ifdef NO_UNION_TYPE +int gdb_use_union = 0; +#else +int gdb_use_union = 1; +#endif EMACS_INT gdb_valbits = VALBITS; EMACS_INT gdb_gctypebits = GCTYPEBITS; -EMACS_INT gdb_emacs_intbits = sizeof (EMACS_INT) * BITS_PER_CHAR; #ifdef DATA_SEG_BITS EMACS_INT gdb_data_seg_bits = DATA_SEG_BITS; #else
--- a/src/eval.c Sat Apr 03 20:02:51 2004 +0000 +++ b/src/eval.c Sat Apr 03 20:24:17 2004 +0000 @@ -1,5 +1,5 @@ /* Evaluator for GNU Emacs Lisp interpreter. - Copyright (C) 1985, 86, 87, 93, 94, 95, 99, 2000, 2001, 2002 + Copyright (C) 1985, 86, 87, 93, 94, 95, 99, 2000, 2001, 02, 2004 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -1812,13 +1812,11 @@ /* Lists may represent commands. */ if (!CONSP (fun)) return Qnil; - funcar = Fcar (fun); - if (!SYMBOLP (funcar)) - return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); + funcar = XCAR (fun); if (EQ (funcar, Qlambda)) - return Fassq (Qinteractive, Fcdr (Fcdr (fun))); + return Fassq (Qinteractive, Fcdr (XCDR (fun))); if (EQ (funcar, Qautoload)) - return Fcar (Fcdr (Fcdr (Fcdr (fun)))); + return Fcar (Fcdr (Fcdr (XCDR (fun)))); else return Qnil; }
--- a/src/lisp.h Sat Apr 03 20:02:51 2004 +0000 +++ b/src/lisp.h Sat Apr 03 20:24:17 2004 +0000 @@ -2034,6 +2034,7 @@ extern Lisp_Object Qinteger; extern void circular_list_error P_ ((Lisp_Object)); +EXFUN (Finteractive_form, 1); /* Defined in frame.c */ extern Lisp_Object Qframep;
--- a/src/xterm.c Sat Apr 03 20:02:51 2004 +0000 +++ b/src/xterm.c Sat Apr 03 20:24:17 2004 +0000 @@ -216,6 +216,17 @@ static int toolkit_scroll_bar_interaction; +/* Non-zero means to not move point as a result of clicking on a + frame to focus it (when focus-follows-mouse is nil). */ + +int x_mouse_click_focus_ignore_position; + +/* Non-zero timeout value means ignore next mouse click if it arrives + before that timeout elapses (i.e. as part of the same sequence of + events resulting from clicking on a frame to select it). */ + +static unsigned long ignore_next_mouse_click_timeout; + /* Mouse movement. Formerly, we used PointerMotionHintMask (in standard_event_mask) @@ -748,13 +759,13 @@ if (p->overlay_p) { - clipmask = XCreatePixmapFromBitmapData (display, + clipmask = XCreatePixmapFromBitmapData (display, FRAME_X_DISPLAY_INFO (f)->root_window, - bits, p->wd, p->h, + bits, p->wd, p->h, 1, 0, 1); gcv.clip_mask = clipmask; gcv.clip_x_origin = p->x; - gcv.clip_y_origin = p->y; + gcv.clip_y_origin = p->y; XChangeGC (display, gc, GCClipMask | GCClipXOrigin | GCClipYOrigin, &gcv); } @@ -5733,7 +5744,7 @@ else { current_count += - handle_one_xevent (dpyinfo, xev, ¤t_finish, + handle_one_xevent (dpyinfo, xev, ¤t_finish, current_hold_quit); } } @@ -6175,6 +6186,8 @@ case KeyPress: + ignore_next_mouse_click_timeout = 0; + #if defined (USE_X_TOOLKIT) || defined (USE_GTK) /* Dispatch KeyPress events when in menu. */ if (popup_activated ()) @@ -6534,6 +6547,9 @@ f = x_any_window_to_frame (dpyinfo, event.xcrossing.window); + if (f && x_mouse_click_focus_ignore_position) + ignore_next_mouse_click_timeout = event.xmotion.time + 200; + #if 0 if (event.xcrossing.focus) { @@ -6777,7 +6793,21 @@ #if defined (USE_X_TOOLKIT) || defined (USE_GTK) if (! popup_activated ()) #endif - construct_mouse_click (&inev, &event, f); + { + if (ignore_next_mouse_click_timeout) + { + if (event.type == ButtonPress + && (int)(event.xbutton.time - ignore_next_mouse_click_timeout) > 0) + { + ignore_next_mouse_click_timeout = 0; + construct_mouse_click (&inev, &event, f); + } + if (event.type == ButtonRelease) + ignore_next_mouse_click_timeout = 0; + } + else + construct_mouse_click (&inev, &event, f); + } } } else @@ -6925,7 +6955,7 @@ any_help_event_p = 1; gen_help_event (help_echo_string, frame, help_echo_window, help_echo_object, help_echo_pos); - } + } else { help_echo_string = Qnil; @@ -8241,7 +8271,7 @@ f->win_gravity = NorthWestGravity; } x_calc_absolute_position (f); - + BLOCK_INPUT; x_wm_set_size_hint (f, (long) 0, 0); @@ -10365,7 +10395,7 @@ get_bits_and_offset (dpyinfo->visual->green_mask, &dpyinfo->green_bits, &dpyinfo->green_offset); } - + /* See if a private colormap is requested. */ if (dpyinfo->visual == DefaultVisualOfScreen (dpyinfo->screen)) { @@ -10790,6 +10820,7 @@ x_noop_count = 0; last_tool_bar_item = -1; any_help_event_p = 0; + ignore_next_mouse_click_timeout = 0; #ifdef USE_GTK current_count = -1; @@ -10877,6 +10908,16 @@ to 4.1, set this to nil. */); x_use_underline_position_properties = 1; + DEFVAR_BOOL ("x-mouse-click-focus-ignore-position", + &x_mouse_click_focus_ignore_position, + doc: /* Non-nil means that a mouse click to focus a frame does not move point. +This variable is only used when the window manager requires that you +click on a frame to select it (give it focus). In that case, a value +of nil, means that the selected window and cursor position changes to +reflect the mouse click position, while a non-nil value means that the +selected window or cursor position is preserved. */); + x_mouse_click_focus_ignore_position = 0; + DEFVAR_LISP ("x-toolkit-scroll-bars", &Vx_toolkit_scroll_bars, doc: /* What X toolkit scroll bars Emacs uses. A value of nil means Emacs doesn't use X toolkit scroll bars.