Mercurial > hg > xemacs-beta
changeset 826:6728e641994e
[xemacs-hg @ 2002-05-05 11:30:15 by ben]
syntax cache, 8-bit-format, lots of code cleanup
README.packages: Update info about --package-path.
i.c: Create an inheritable event and pass it on to XEmacs, so that ^C
can be handled properly. Intercept ^C and signal the event.
"Stop Build" in VC++ now works.
bytecomp-runtime.el: Doc string changes.
compat.el: Some attempts to redo this to
make it truly useful and fix the "multiple versions interacting
with each other" problem. Not yet done. Currently doesn't work.
files.el: Use with-obsolete-variable to avoid warnings in new revert-buffer code.
xemacs.mak: Split up CFLAGS into a version without flags specifying the C
library. The problem seems to be that minitar depends on zlib,
which depends specifically on libc.lib, not on any of the other C
libraries. Unless you compile with libc.lib, you get errors --
specifically, no _errno in the other libraries, which must make it
something other than an int. (#### But this doesn't seem to obtain
in XEmacs, which also uses zlib, and can be linked with any of the
C libraries. Maybe zlib is used differently and doesn't need
errno, or maybe XEmacs provides an int errno; ... I don't
understand.
Makefile.in.in: Fix so that packages are around when testing.
abbrev.c, alloc.c, buffer.c, buffer.h, bytecode.c, callint.c, casefiddle.c, casetab.c, casetab.h, charset.h, chartab.c, chartab.h, cmds.c, console-msw.h, console-stream.c, console-x.c, console.c, console.h, data.c, device-msw.c, device.c, device.h, dialog-msw.c, dialog-x.c, dired-msw.c, dired.c, doc.c, doprnt.c, dumper.c, editfns.c, elhash.c, emacs.c, eval.c, event-Xt.c, event-gtk.c, event-msw.c, event-stream.c, events.c, events.h, extents.c, extents.h, faces.c, file-coding.c, file-coding.h, fileio.c, fns.c, font-lock.c, frame-gtk.c, frame-msw.c, frame-x.c, frame.c, frame.h, glade.c, glyphs-gtk.c, glyphs-msw.c, glyphs-msw.h, glyphs-x.c, glyphs.c, glyphs.h, gui-msw.c, gui-x.c, gui.h, gutter.h, hash.h, indent.c, insdel.c, intl-win32.c, intl.c, keymap.c, lisp-disunion.h, lisp-union.h, lisp.h, lread.c, lrecord.h, lstream.c, lstream.h, marker.c, menubar-gtk.c, menubar-msw.c, menubar-x.c, menubar.c, minibuf.c, mule-ccl.c, mule-charset.c, mule-coding.c, mule-wnnfns.c, nas.c, objects-msw.c, objects-x.c, opaque.c, postgresql.c, print.c, process-nt.c, process-unix.c, process.c, process.h, profile.c, rangetab.c, redisplay-gtk.c, redisplay-msw.c, redisplay-output.c, redisplay-x.c, redisplay.c, redisplay.h, regex.c, regex.h, scrollbar-msw.c, search.c, select-x.c, specifier.c, specifier.h, symbols.c, symsinit.h, syntax.c, syntax.h, syswindows.h, tests.c, text.c, text.h, tooltalk.c, ui-byhand.c, ui-gtk.c, unicode.c, win32.c, window.c: Another big Ben patch.
-- FUNCTIONALITY CHANGES:
add partial support for 8-bit-fixed, 16-bit-fixed, and
32-bit-fixed formats. not quite done yet. (in particular, needs
functions to actually convert the buffer.) NOTE: lots of changes
to regex.c here. also, many new *_fmt() inline funs that take an
Internal_Format argument.
redo syntax cache code. make the cache per-buffer; keep the cache
valid across calls to functions that use it. also keep it valid
across insertions/deletions and extent changes, as much as is
possible. eliminate the junky regex-reentrancy code by passing in
the relevant lisp info to the regex routines as local vars.
add general mechanism in extents code for signalling extent changes.
fix numerous problems with the case-table implementation; yoshiki
never properly transferred many algorithms from old-style to
new-style case tables.
redo char tables to support a default argument, so that mapping
only occurs over changed args. change many chartab functions to
accept Lisp_Object instead of Lisp_Char_Table *.
comment out the code in font-lock.c by default, because
font-lock.el no longer uses it. we should consider eliminating it
entirely.
Don't output bell as ^G in console-stream when not a TTY.
add -mswindows-termination-handle to interface with i.c, so we can
properly kill a build.
add more error-checking to buffer/string macros.
add some additional buffer_or_string_() funs.
-- INTERFACE CHANGES AFFECTING MORE CODE:
switch the arguments of write_c_string and friends to be
consistent with write_fmt_string, which must have printcharfun
first.
change BI_* macros to BYTE_* for increased clarity; similarly for
bi_* local vars.
change VOID_TO_LISP to be a one-argument function. eliminate
no-longer-needed CVOID_TO_LISP.
-- char/string macro changes:
rename MAKE_CHAR() to make_emchar() for slightly less confusion
with make_char(). (The former generates an Emchar, the latter a
Lisp object. Conceivably we should rename make_char() -> wrap_char()
and similarly for make_int(), make_float().)
Similar changes for other *CHAR* macros -- we now consistently use
names with `emchar' whenever we are working with Emchars. Any
remaining name with just `char' always refers to a Lisp object.
rename macros with XSTRING_* to string_* except for those that
reference actual fields in the Lisp_String object, following
conventions used elsewhere.
rename set_string_{data,length} macros (the only ones to work with
a Lisp_String_* instead of a Lisp_Object) to set_lispstringp_*
to make the difference clear.
try to be consistent about caps vs. lowercase in macro/inline-fun
names for chars and such, which wasn't the case before. we now
reserve caps either for XFOO_ macros that reference object fields
(e.g. XSTRING_DATA) or for things that have non-function semantics,
e.g. directly modifying an arg (BREAKUP_EMCHAR) or evaluating an
arg (any arg) more than once. otherwise, use lowercase.
here is a summary of most of the macros/inline funs changed by all
of the above changes:
BYTE_*_P -> byte_*_p
XSTRING_BYTE -> string_byte
set_string_data/length -> set_lispstringp_data/length
XSTRING_CHAR_LENGTH -> string_char_length
XSTRING_CHAR -> string_emchar
INTBYTE_FIRST_BYTE_P -> intbyte_first_byte_p
INTBYTE_LEADING_BYTE_P -> intbyte_leading_byte_p
charptr_copy_char -> charptr_copy_emchar
LEADING_BYTE_* -> leading_byte_*
CHAR_* -> EMCHAR_*
*_CHAR_* -> *_EMCHAR_*
*_CHAR -> *_EMCHAR
CHARSET_BY_ -> charset_by_*
BYTE_SHIFT_JIS* -> byte_shift_jis*
BYTE_BIG5* -> byte_big5*
REP_BYTES_BY_FIRST_BYTE -> rep_bytes_by_first_byte
char_to_unicode -> emchar_to_unicode
valid_char_p -> valid_emchar_p
Change intbyte_strcmp -> qxestrcmp_c (duplicated functionality).
-- INTERFACE CHANGES AFFECTING LESS CODE:
use DECLARE_INLINE_HEADER in various places.
remove '#ifdef emacs' from XEmacs-only files.
eliminate CHAR_TABLE_VALUE(), which duplicated the functionality
of get_char_table().
add BUFFER_TEXT_LOOP to simplify iterations over buffer text.
define typedefs for signed and unsigned types of fixed sizes
(INT_32_BIT, UINT_32_BIT, etc.).
create ALIGN_FOR_TYPE as a higher-level interface onto ALIGN_SIZE;
fix code to use it.
add charptr_emchar_len to return the text length of the character
pointed to by a ptr; use it in place of
charcount_to_bytecount(..., 1). add emchar_len to return the text
length of a given character.
add types Bytexpos and Charxpos to generalize Bytebpos/Bytecount
and Charbpos/Charcount, in code (particularly, the extents code
and redisplay code) that works with either kind of index. rename
redisplay struct params with names such as `charbpos' to
e.g. `charpos' when they are e.g. a Charxpos, not a Charbpos.
eliminate xxDEFUN in place of DEFUN; no longer necessary with
changes awhile back to doc.c.
split up big ugly combined list of EXFUNs in lisp.h on a
file-by-file basis, since other prototypes are similarly split.
rewrite some "*_UNSAFE" macros as inline funs and eliminate the
_UNSAFE suffix.
move most string code from lisp.h to text.h; the string code and
text.h code is now intertwined in such a fashion that they need
to be in the same place and partially interleaved. (you can't
create forward references for inline funs)
automated/lisp-tests.el, automated/symbol-tests.el, automated/test-harness.el: Fix test harness to output FAIL messages to stderr when in
batch mode.
Fix up some problems in lisp-tests/symbol-tests that were
causing spurious failures.
line wrap: on
line diff
--- a/ChangeLog Thu May 02 14:35:32 2002 +0000 +++ b/ChangeLog Sun May 05 11:33:57 2002 +0000 @@ -1,3 +1,7 @@ +2002-05-05 Ben Wing <ben@xemacs.org> + + * README.packages: Update info about --package-path. + 2002-04-22 Hrvoje Niksic <hniksic@xemacs.org> * etc/photos/hniksic.png, etc/photos/hniksic.png: Update.
--- a/README.packages Thu May 02 14:35:32 2002 +0000 +++ b/README.packages Sun May 05 11:33:57 2002 +0000 @@ -10,27 +10,41 @@ The XEmacs Packages Quick Start Guide ------------------------------------- -This text is intended to help you get started installing a new XEmacs -and its packages from start. For details see the 'Startup Paths' and -'Packages' sections of the XEmacs info manual. +This text is intended to help you get started installing a new XEmacs and +its packages. For more details see the 'Startup Paths' and 'Packages' +sections of the XEmacs info manual. * Real Real Quickstart FAQ -------------------------- Q. Do I need to have the packages to compile XEmacs? -A. No, XEmacs will build and install just fine without any packages - installed. However, only the most basic editing functions will be - available with no packages installed, so installing packages is an + +A. Theoretically, no -- XEmacs will build and install just fine without any + packages installed. However, only the most basic editing functions will + be available with no packages installed, so installing packages is an essential part of making your installed XEmacs _useful_. Q. I really liked the old way that packages were bundled and do not want to mess with packages at all. + A. You can grab all the packages at once like you used to with old XEmacs versions, skip to the 'Sumo Tarball' section below. +Q. How do I tell XEmacs where to find the packages? + +A. Normally, you put the packages under $prefix/lib/packages, where + $prefix is specified using the `--prefix' parameter to `configure'. + (See `Package hierarchies' below). However, if you have the packages + somewhere else (e.g. you're a developer and are compiling the packages + yourself, and want your own private copy of everything), use the + `--package-path' parameter, something like this: + + configure --package-path="~/.xemacs::/src/xemacs/site-packages:/src/xemacs/xemacs-packages:/src/xemacs/mule-packages" ... + Q. After installing, I want XEmacs to do `foo', but when I invoke it (or click the toolbar button or select the menu item), nothing (or an error) happens, and it used to work. + A. See the first FAQ; you may be missing a package that is essential to you. You can either track it down and install it, or install the `Sumo Tarball' (see the second FAQ). @@ -44,7 +58,7 @@ backwards compatibility as quirks are worked out over the coming releases. -* Some Package Theory +* Some package theory --------------------- In order to reduce the size and increase the maintainability of XEmacs, @@ -60,20 +74,35 @@ * Package hierarchies --------------------- -On Startup XEmacs looks for packages in so called package hierarchies. -These can be specified by the 'package-path' parameter to the -'configure' script. However by default there are three system wide -hierarchies. ("$prefix" defaults to "/usr/local") +On Startup XEmacs looks for packages in so-called package hierarchies. +Normally, there are three system wide hierarchies, like this: -$prefix/lib/xemacs/xemacs-packages +$prefix/lib/xemacs/xemacs-packages/ Normal packages go here. -$prefix/lib/xemacs/mule-packages +$prefix/lib/xemacs/mule-packages/ Mule packages go here and are only searched by MULE-enabled XEmacsen. $prefix/lib/xemacs/site-packages/ Local and 3rd party packages go here. +This is what you get when you untar the SUMO tarballs under +$prefix/lib/xemacs. + +$prefix is specified using the `--prefix' parameter to `configure', and +defaults to `usr/local'. + +If your packages are located in the above directories, XEmacs will +automatically find them at startup; however, if you have your packages +somewhere else (e.g. you're a developer and are compiling the packages +yourself, and want your own private copy of everything), you can tell +XEmacs specifically where to look for the packages by using the +`--package-path' parameter to the 'configure' script. Normally, it looks +like this: + +configure --package-path="~/.xemacs::/src/xemacs/site-packages:/src/xemacs/xemacs-packages:/src/xemacs/mule-packages" ... + +See `configure.usage' for more info about the format of this parameter. * Where to get the packages ---------------------------
--- a/lib-src/ChangeLog Thu May 02 14:35:32 2002 +0000 +++ b/lib-src/ChangeLog Sun May 05 11:33:57 2002 +0000 @@ -1,3 +1,12 @@ +2002-05-05 Ben Wing <ben@xemacs.org> + + * i.c: + * i.c (skip_executable_name): + * i.c (main): + Create an inheritable event and pass it on to XEmacs, so that ^C + can be handled properly. Intercept ^C and signal the event. + "Stop Build" in VC++ now works. + 2002-04-14 Ben Wing <ben@xemacs.org> * make-docfile.c:
--- a/lib-src/i.c Thu May 02 14:35:32 2002 +0000 +++ b/lib-src/i.c Sun May 05 11:33:57 2002 +0000 @@ -1,5 +1,6 @@ /* I-connector utility Copyright (C) 2000 Kirill M. Katsnelson + Copyright (C) 2002 Ben Wing. This file is part of XEmacs. @@ -84,13 +85,23 @@ CloseHandle (h_thread); } -/* - * Get command line, skip over the executable name, return the rest. - */ +static HANDLE external_event; + +static BOOL +ctrl_c_handler (unsigned long type) +{ + SetEvent (external_event); + return FALSE; +} + +/* Skip over the executable name in the given command line. Correctly + handles quotes in the name. Return NULL upon error. If + REQUIRE_FOLLOWING is non-zero, it's an error if no argument follows the + executable name. */ + static LPTSTR -get_command (void) +skip_executable_name (LPTSTR cl, int require_following) { - LPTSTR cl = GetCommandLine (); int ix; while (1) @@ -107,6 +118,8 @@ { cl += ix; cl += _tcsspn (cl, _T(" \t")); + if (!require_following) + return cl; return *cl ? cl : NULL; } } @@ -133,8 +146,8 @@ PROCESS_INFORMATION pi; I_connector I_in, I_out, I_err; DWORD exit_code; - - LPTSTR command = get_command (); + LPTSTR command = skip_executable_name (GetCommandLine (), 1); + if (command == NULL) { usage (); @@ -156,15 +169,68 @@ CreatePipe (&I_err.source, &si.hStdError, NULL, 0); make_inheritable (&si.hStdError); - if (CreateProcess (NULL, command, NULL, NULL, TRUE, 0, - NULL, NULL, &si, &pi) == 0) - { - _ftprintf (stderr, _T("Error %d launching `%s'\n"), - GetLastError (), command); - return 2; - } + { + SECURITY_ATTRIBUTES sa; + LPTSTR new_command = + (LPTSTR) malloc (666 + sizeof (TCHAR) * _tcslen (command)); + LPTSTR past_exe; + + if (!new_command) + { + _ftprintf (stderr, _T ("Out of memory when launching `%s'\n"), + command); + return 2; + } + + past_exe = skip_executable_name (command, 0); + if (!past_exe) + { + usage (); + return 1; + } + + /* Since XEmacs isn't a console application, it can't easily be + terminated using ^C. Therefore, we set up a communication path with + it so that when a ^C is sent to us (using GenerateConsoleCtrlEvent), + we in turn signals it to commit suicide. (This is cleaner than using + TerminateProcess()). This makes (e.g.) the "Stop Build" command + from VC++ correctly terminate XEmacs. + + #### This will cause problems if i.exe is used for commands other + than XEmacs. We need to make behavior this a command-line + option. */ - CloseHandle (pi.hThread); + /* Create the event as inheritable so that we can use it to communicate + with the child process */ + sa.nLength = sizeof (sa); + sa.bInheritHandle = TRUE; + sa.lpSecurityDescriptor = NULL; + external_event = CreateEvent (&sa, FALSE, FALSE, NULL); + if (!external_event) + { + _ftprintf (stderr, _T ("Error %d creating signal event for `%s'\n"), + GetLastError (), command); + return 2; + } + + SetConsoleCtrlHandler ((PHANDLER_ROUTINE) ctrl_c_handler, TRUE); + _tcsncpy (new_command, command, past_exe - command); + _stprintf (new_command + (past_exe - command), + /* start with space in case no args past command name */ + " -mswindows-termination-handle %d ", (long) external_event); + _tcscat (new_command, past_exe); + + if (CreateProcess (NULL, new_command, NULL, NULL, TRUE, 0, + NULL, NULL, &si, &pi) == 0) + { + _ftprintf (stderr, _T("Error %d launching `%s'\n"), + GetLastError (), command); + return 2; + } + + CloseHandle (pi.hThread); + } + /* Start pump in each I-connector */ start_pump (&I_in);
--- a/lisp/ChangeLog Thu May 02 14:35:32 2002 +0000 +++ b/lisp/ChangeLog Sun May 05 11:33:57 2002 +0000 @@ -1,3 +1,52 @@ +2002-05-05 Ben Wing <ben@xemacs.org> + + * bytecomp-runtime.el (with-obsolete-variable): + * bytecomp-runtime.el (with-obsolete-function): + Doc string changes. + + * compat.el: + * compat.el (compat-current-package): + * compat.el (compat-current-package)): New. + * compat.el (compat-define-compat-functions): New. + * compat.el (compat-define-group): + * compat.el (compat-define-functions): Removed. + * compat.el (compat-defun): New. + * compat.el (compat-define-function): New. + * compat.el (compat-wrap-runtime): New. + * compat.el (compat-wrap): New. + * compat.el (compat): Removed. + * compat.el (overlays): + * compat.el (overlayp): New. + * compat.el (make-overlay): New. + * compat.el (move-overlay): New. + * compat.el (delete-overlay): New. + * compat.el (overlay-start): New. + * compat.el (overlay-end): New. + * compat.el (overlay-buffer): New. + * compat.el (overlay-properties): New. + * compat.el (overlays-at): New. + * compat.el (overlays-in): New. + * compat.el (next-overlay-change): New. + * compat.el (previous-overlay-change): New. + * compat.el (overlay-lists): New. + * compat.el (overlay-recenter): New. + * compat.el (overlay-get): New. + * compat.el (overlay-put): New. + * compat.el ('delete-extent): New. + * compat.el ('extent-end-position): New. + * compat.el ('extent-start-position): New. + * compat.el ('set-extent-endpoints): New. + * compat.el ('set-extent-property): New. + * compat.el ('make-extent): New. + * compat.el (extent-property): New. + * compat.el (extent-at): New. + * compat.el (map-extents): New. Some attempts to redo this to + make it truly useful and fix the "multiple versions interacting + with each other" problem. Not yet done. Currently doesn't work. + + * files.el (revert-buffer-internal): + Use with-obsolete-variable to avoid warnings in new revert-buffer code. + 2002-05-02 Steve Youngs <youngs@xemacs.org> * package-get.el (package-get): Use 'warn' instead of 'lwarn'.
--- a/lisp/bytecomp-runtime.el Thu May 02 14:35:32 2002 +0000 +++ b/lisp/bytecomp-runtime.el Sun May 05 11:33:57 2002 +0000 @@ -477,13 +477,15 @@ (put 'with-obsolete-variable 'lisp-indent-function 1) (defmacro with-obsolete-variable (symbol &rest body) "Evaluate BODY but do not warn about usage of obsolete variable SYMBOL. -SYMBOL must be quoted. See also `with-obsolete-function'." +SYMBOL must be quoted and can be a list of SYMBOLS. See also +`with-obsolete-function'." `(with-byte-compiler-warnings-suppressed 'obsolete ,@body)) (put 'with-obsolete-function 'lisp-indent-function 1) (defmacro with-obsolete-function (symbol &rest body) "Evaluate BODY but do not warn about usage of obsolete function SYMBOL. -SYMBOL must be quoted. See also `with-obsolete-variable'." +SYMBOL must be quoted and can be a list of SYMBOLS. See also +`with-obsolete-variable'." `(with-byte-compiler-warnings-suppressed 'obsolete ,@body))
--- a/lisp/compat.el Thu May 02 14:35:32 2002 +0000 +++ b/lisp/compat.el Sun May 05 11:33:57 2002 +0000 @@ -1,6 +1,6 @@ ;;; compat.el --- Mechanism for non-intrusively providing compatibility funs. -;; Copyright (C) 2000 Ben Wing. +;; Copyright (C) 2000, 2002 Ben Wing. ;; Author: Ben Wing <ben@xemacs.org> ;; Maintainer: Ben Wing @@ -31,6 +31,63 @@ ;;; Commentary: +;; The idea is to provide emulation of API's in a namespace-clean way. Lots of packages are filled with declarations such as + +;; (defalias 'gnus-overlay-get 'extent-property) + +; There should be a single package to provide such compatibility code. The +; tricky part is how to do it in a clean way, without packages interfering +; with each other. + +; The basic usage of compat is: + +; (1) Each package copies compat.el and renames it, e.g. gnus-compat.el. + +; (2) `compat' defines various API's that can be activated. To use them in a +; file, first place code like this at the top of the file: + +;(let ((compat-current-package 'Gnus)) +; (require 'gnus-compat)) + +; then wrap the rest of the code like this: + +; (Gnus-compat-wrap '(overlays events) + +;;; Commentary + +;; blah + +;;; Code + +;(defun random-module-my-fun (bar baz) +; ... +; (overlay-put overlay 'face 'bold) +; ... +;) +; +;(defun ... +;) +; +; +; +; +;) ;; end of (Gnus-compat) + +;;;; random-module.el ends here + +; (3) What this does is implement the requested API's (in this case, the +; overlay API from GNU Emacs and event API from XEmacs) in whichever +; version of Emacs is running, with names such as +; `Gnus-compat-overlay-put', and then it uses `macrolet' to map the +; generic names in the wrapped code into namespace-clean names. The +; result of loading `gnus-compat' leaves around only functions beginning +; with `Gnus-compat' (or whatever prefix was specified in +; `compat-current-package'). This way, various packages, with various +; versions of `compat' as part of them, can coexist, with each package +; running the version of `compat' that it's been tested with. The use of +; `macrolet' ensures that only code that's lexically wrapped -- not code +; that's called from that code -- is affected by the API mapping. + ;; Typical usage: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -41,10 +98,9 @@ ;(compat-define-functions 'fsf-compat -;(defun overlayp (object) -; "Return t if OBJECT is an overlay." -; (and (extentp object) -; (extent-property object 'overlay))) +;(defun overlay-put (overlay prop value) +; "Set property PROP to VALUE in overlay OVERLAY." +; (set-extent-property overlay prop value)) ;(defun make-overlay (beg end &optional buffer front-advance rear-advance) ; ...) @@ -60,17 +116,129 @@ ;; 2. Wrap modules that use the compatibility functions like this: ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;(compat 'fsf-compat - +;(let ((compat-current-package 'gnus)) +; (require 'gnus-compat)) +; +;(gnus-compat 'fsf-compat +; +;; Code: +;; +;; ;(defun random-module-my-fun (bar baz) -; (if (fboundp 'overlays-in) (overlays-in bar baz))) - -;... - +; ... +; (overlay-put overlay 'face 'bold) +; ... +;) +; +;(defun ... +;) +; +; +; +; ;) ;; end of (compat 'fsf-compat) ;;;; random-module.el ends here +(defvar compat-current-package) + +(eval-when-compile + (setq compat-current-package 'compat)) + +;; #### not yet working +'( + +(defmacro compat-define-compat-functions (&rest body) + "Define the functions of the `compat' package in a namespace-clean way. +This relies on `compat-current-package' being set. If `compat-current-package' +is equal to the symbol `foo', and within BODY is something like + +\(defmacro compat-define-group (group) + ... +) + +then this turns into + +\(defmacro foo-compat-define-group (group) + ... +) + +and all calls are replaced accordingly. + + + + +Functions such as +compatibility functions in GROUP. +You should simply wrap this around the code that defines the functions. +Any functions and macros defined at top level using `defun' or `defmacro' +will be noticed and added to GROUP. Other top-level code will be executed +normally. All code and definitions in this group can safely reference any +other functions in this group -- the code is effectively wrapped in a +`compat' call. You can call `compat-define-functions' more than once, if +necessary, for a single group. + +What actually happens is that the functions and macros defined here are in +fact defined using names prefixed with GROUP. To use these functions, +wrap any calling code with the `compat' macro, which lexically renames +the function and macro calls appropriately." + (let ((prefix (if (boundp 'compat-current-package) + compat-current-package + (error + "`compat-current-package' must be defined when loading this module"))) + (defs-to-munge '(defun defmacro)) + mappings) + (if (symbolp prefix) (setq prefix (symbol-name prefix))) + ;; first, note all defuns and defmacros + (let (fundef + (body-tail body)) + (while body-tail + (setq fundef (car body-tail)) + (when (and (consp fundef) (memq (car fundef) defs-to-munge)) + (push (cons (second fundef) (third fundef)) mappings)) + (setq body-tail (cdr body-tail)))) + ;; now, munge the definitions with the new names + (let (fundef + (body-tail body) + result + defs) + (while body-tail + (setq fundef (car body-tail)) + (push + (cond ((and (consp fundef) (memq (car fundef) defs-to-munge)) + (nconc (list (car fundef) + (intern (concat prefix "-" + (symbol-name (second fundef)))) + (third fundef)) + (nthcdr 3 fundef))) + (t fundef)) + result) + (setq body-tail (cdr body-tail))) + (setq result (nreverse result)) + ;; now, generate the munged code, with the references to the functions + ;; macroletted + (mapc + #'(lambda (acons) + (let ((fun (car acons)) + (args (cdr acons))) + (push + (list fun args + (nconc + (list 'list + (list 'quote + (intern (concat prefix "-" + (symbol-name fun))))) + args)) + defs))) + mappings) + ;; it would be cleaner to use `lexical-let' instead of `let', but that + ;; causes function definitions to have obnoxious, unreadable junk in + ;; them. #### Move `lexical-let' into C!!! + `(macrolet ((compat-current-package () ,compat-current-package) + ,@defs) + ,@result)))) + +(compat-define-compat-functions (defun compat-hash-table (group) (get group 'compat-table)) @@ -78,9 +246,9 @@ (defun compat-make-hash-table (group) (put group 'compat-table (make-hash-table))) -(defmacro compat-define-group (group) +(defmacro compat-define-group (group &rest body) "Define GROUP as a group of compatibility functions. -Individual functions are defined using `compat-define-functions'. +This macro should wrap individual Individual functions are defined using `compat-define-functions'. Once defined, the functions can be used by wrapping your code in the `compat' macro. @@ -94,9 +262,12 @@ (let ((group (eval group))) (clrhash (compat-hash-table group)))) -(defmacro compat-define-functions (group &rest body) - "Define compatibility functions in GROUP. -You should simply wrap this around the code that defines the functions. +(defmacro compat-defun (args &rest body) + +(defmacro compat-define-function (props name arglist &rest body) + "Define a compatibility function. +PROPS are properties controlling how the function should be defined. +control how the should simply wrap this around the code that defines the functions. Any functions and macros defined at top level using `defun' or `defmacro' will be noticed and added to GROUP. Other top-level code will be executed normally. All code and definitions in this group can safely reference any @@ -108,14 +279,14 @@ fact defined using names prefixed with GROUP. To use these functions, wrap any calling code with the `compat' macro, which lexically renames the function and macro calls appropriately." - (let ((group (eval group))) + (let ((group (eval group)) + (defs-to-munge '(defun defmacro)) + ) (let (fundef (body-tail body)) (while body-tail (setq fundef (car body-tail)) - (when (and (consp fundef) (eq (car fundef) 'defun)) - (puthash (second fundef) (third fundef) (compat-hash-table group))) - (when (and (consp fundef) (eq (car fundef) 'defmacro)) + (when (and (consp fundef) (memq (car fundef) defs-to-munge)) (puthash (second fundef) (third fundef) (compat-hash-table group))) (setq body-tail (cdr body-tail)))) (let (fundef @@ -124,14 +295,8 @@ (while body-tail (setq fundef (car body-tail)) (push - (cond ((and (consp fundef) (eq (car fundef) 'defun)) - (nconc (list 'defun - (intern (concat (symbol-name group) "-" - (symbol-name (second fundef)))) - (third fundef)) - (nthcdr 3 fundef))) - ((and (consp fundef) (eq (car fundef) 'defmacro)) - (nconc (list 'defmacro + (cond ((and (consp fundef) (memq (car fundef) defs-to-munge)) + (nconc (list (car fundef) (intern (concat (symbol-name group) "-" (symbol-name (second fundef)))) (third fundef)) @@ -139,7 +304,7 @@ (t fundef)) result) (setq body-tail (cdr body-tail))) - (nconc (list 'compat (list 'quote group)) (nreverse result))))) + (nconc (list 'compat-wrap (list 'quote group)) (nreverse result))))) (defvar compat-active-groups nil) @@ -154,10 +319,121 @@ (return t))) groups)))) -(defmacro compat (group &rest body) - "Make use of compatibility functions and macros in GROUP. +(defmacro compat-wrap-runtime (groups &rest body)) + +(defmacro compat-wrap (groups &rest body) + "Make use of compatibility functions and macros in GROUPS. +GROUPS is a symbol, an API group, or list of API groups. Each API group +defines a set of functions, macros, variables, etc. and that will (or +should ideally) work on all recent versions of both GNU Emacs and XEmacs, +and (to some extent, depending on how the functions were designed) on older +version. When this function is used, it will generally not be named +`compat-wrap', but have some name such as `Gnus-compat-wrap', if this is +wrapping something in `gnus'. (The renaming happened when the `compat' +package was loaded -- see discussion at top). + +To use `compat' in your package (assume your package is `gnus'), you first +have to do a bit if setup. + +-- Copy and rename compat.el, e.g. to `gnus-compat.el'. The name must be + globally unique across everything on the load path (that means all + packages). +-- Incude this file in your package. It will not interfere with any other + versions of compat (earlier, later, etc.) provided in other packages + and similarly renamed. + +To make use of the API's provided: + +-- First place code like this at the top of the file, after the copyright + notices and comments: + +\(let ((compat-current-package 'Gnus)) + (require 'gnus-compat)) + +-- then wrap the rest of the code like this, assuming you want access to + the GNU Emacs overlays API, and the XEmacs events API: + +\(Gnus-compat-wrap '(overlays xem-events) + +... +... +... + +\(defun gnus-random-fun (overlay baz) + ... + (overlay-put overlay 'face 'bold) + ... +) + +... +... + +\(defun gnus-random-fun-2 (event) + (interactive "e") + (let ((x (event-x event)) + (y (event-y event))) + ... + ) + ) + +) ;; end of (Gnus-compat) + +;;;; random-module.el ends here + +Both the requested API's will be implemented whichever version of Emacs +\(GNU Emacs, XEmacs, etc.) is running, and (with limitations) on older +versions as well. Furthermore, the API's are provided *ONLY* to code +that's actually, lexically wrapped by `compat-wrap' (or its renamed +version). All other code, including code that's called by the wrapped +code, is not affected -- e.g. if we're on XEmacs, and `overlay-put' isn't +normally defined, then it won't be defined in code other than the wrapped +code, even if the wrapped code calls that code. Clever, huh? + +What happens is that the `compat-wrap' actually uses `macrolet' to +inline-substitute calls to `overlay-put' to (in this case) +`Gnus-compat-overlay-put', which was defined when `gnus-compat' was loaded. + +What happens is that is implement the requested API's (in this case, the +overlay API from GNU Emacs and event API from XEmacs) in whichever +version of Emacs is running, with names such as +`Gnus-compat-overlay-put', and then it uses `macrolet' to map the +generic names in the wrapped code into namespace-clean names. The +result of loading `gnus-compat' leaves around only functions beginning +with `Gnus-compat' (or whatever prefix was specified in +`compat-current-package'). This way, various packages, with various +versions of `compat' as part of them, can coexist, with each package +running the version of `compat' that it's been tested with. The use of +`macrolet' ensures that only code that's lexically wrapped -- not code +that's called from that code -- is affected by the API mapping. + +Before using `compat' + +For any file where you want to make use of one or more API's provided by +`compat', first do this: + +Wrap a call to `compat-wrap' around your entire file, like this: + +;; First, you copied compat.el into your package -- we're assuming \"gnus\" -- +;; and renamed it, e.g. gnus-compat.el. Now we load it and tell it to +;; use `Gnus' as the prefix for all stuff it defines. (Use a capital letter +;; or some similar convention so that these names are not so easy to see.) + +\(let ((current-compat-package 'Gnus)) + (require 'gnus-compat)) + +;; The function `compat-wrap' was mapped to `Gnus-compat-wrap'. The idea +;; is that the raw functions beginning with `compat-' are never actually +;; defined. They may appear as function calls inside of functions, but +;; they will always be mapped to something beginning with the given prefix. + +\(Gnus-compat-wrap '(overlays xem-events) + + ... + +) + You should simply wrap this around the code that uses the functions -and macros in GROUP. Typically, a call to `compat' should be placed +and macros in GROUPS. Typically, a call to `compat' should be placed at the top of an ELisp module, with the closing parenthesis at the bottom; use this in place of a `require' statement. Wrapped code can be either function or macro definitions or other ELisp code, and @@ -196,3 +472,264 @@ (macrolet ((fboundp (fun) `(compat-fboundp ',compat-active-groups ,fun)) ,@defs) ,@body)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Define the compat groups ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; overlays ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(compat-define-group 'overlays + +(defun-compat overlayp (object) + "Return t if OBJECT is an overlay." + (and (extentp object) + (extent-property object 'overlay))) + +(defun-compat make-overlay (beg end &optional buffer front-advance rear-advance) + "Create a new overlay with range BEG to END in BUFFER. +If omitted, BUFFER defaults to the current buffer. +BEG and END may be integers or markers. +The fourth arg FRONT-ADVANCE, if non-nil, makes the +front delimiter advance when text is inserted there. +The fifth arg REAR-ADVANCE, if non-nil, makes the +rear delimiter advance when text is inserted there." + (if (null buffer) + (setq buffer (current-buffer)) + (check-argument-type 'bufferp buffer)) + (when (> beg end) + (setq beg (prog1 end (setq end beg)))) + + (let ((overlay (make-extent beg end buffer))) + (set-extent-property overlay 'overlay t) + (if front-advance + (set-extent-property overlay 'start-open t) + (set-extent-property overlay 'start-closed t)) + (if rear-advance + (set-extent-property overlay 'end-closed t) + (set-extent-property overlay 'end-open t)) + + overlay)) + +(defun-compat move-overlay (overlay beg end &optional buffer) + "Set the endpoints of OVERLAY to BEG and END in BUFFER. +If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now. +If BUFFER is omitted, and OVERLAY is in no buffer, put it in the current +buffer." + (check-argument-type 'overlayp overlay) + (if (null buffer) + (setq buffer (extent-object overlay))) + (if (null buffer) + (setq buffer (current-buffer))) + (check-argument-type 'bufferp buffer) + (and (= beg end) + (extent-property overlay 'evaporate) + (delete-overlay overlay)) + (when (> beg end) + (setq beg (prog1 end (setq end beg)))) + (set-extent-endpoints overlay beg end buffer) + overlay) + +(defun-compat delete-overlay (overlay) + "Delete the overlay OVERLAY from its buffer." + (check-argument-type 'overlayp overlay) + (detach-extent overlay) + nil) + +(defun-compat overlay-start (overlay) + "Return the position at which OVERLAY starts." + (check-argument-type 'overlayp overlay) + (extent-start-position overlay)) + +(defun-compat overlay-end (overlay) + "Return the position at which OVERLAY ends." + (check-argument-type 'overlayp overlay) + (extent-end-position overlay)) + +(defun-compat overlay-buffer (overlay) + "Return the buffer OVERLAY belongs to." + (check-argument-type 'overlayp overlay) + (extent-object overlay)) + +(defun-compat overlay-properties (overlay) + "Return a list of the properties on OVERLAY. +This is a copy of OVERLAY's plist; modifying its conses has no effect on +OVERLAY." + (check-argument-type 'overlayp overlay) + (extent-properties overlay)) + +(defun-compat overlays-at (pos) + "Return a list of the overlays that contain position POS." + (overlays-in pos pos)) + +(defun-compat overlays-in (beg end) + "Return a list of the overlays that overlap the region BEG ... END. +Overlap means that at least one character is contained within the overlay +and also contained within the specified region. +Empty overlays are included in the result if they are located at BEG +or between BEG and END." + (if (featurep 'xemacs) + (mapcar-extents #'identity nil nil beg end + 'all-extents-closed-open 'overlay) + (let ((ovls (overlay-lists)) + tmp retval) + (if (< end beg) + (setq tmp end + end beg + beg tmp)) + (setq ovls (nconc (car ovls) (cdr ovls))) + (while ovls + (setq tmp (car ovls) + ovls (cdr ovls)) + (if (or (and (<= (overlay-start tmp) end) + (>= (overlay-start tmp) beg)) + (and (<= (overlay-end tmp) end) + (>= (overlay-end tmp) beg))) + (setq retval (cons tmp retval)))) + retval))) + +(defun-compat next-overlay-change (pos) + "Return the next position after POS where an overlay starts or ends. +If there are no more overlay boundaries after POS, return (point-max)." + (let ((next (point-max)) + tmp) + (map-extents + (lambda (overlay ignore) + (when (or (and (< (setq tmp (extent-start-position overlay)) next) + (> tmp pos)) + (and (< (setq tmp (extent-end-position overlay)) next) + (> tmp pos))) + (setq next tmp)) + nil) + nil pos nil nil 'all-extents-closed-open 'overlay) + next)) + +(defun-compat previous-overlay-change (pos) + "Return the previous position before POS where an overlay starts or ends. +If there are no more overlay boundaries before POS, return (point-min)." + (let ((prev (point-min)) + tmp) + (map-extents + (lambda (overlay ignore) + (when (or (and (> (setq tmp (extent-end-position overlay)) prev) + (< tmp pos)) + (and (> (setq tmp (extent-start-position overlay)) prev) + (< tmp pos))) + (setq prev tmp)) + nil) + nil nil pos nil 'all-extents-closed-open 'overlay) + prev)) + +(defun-compat overlay-lists () + "Return a pair of lists giving all the overlays of the current buffer. +The car has all the overlays before the overlay center; +the cdr has all the overlays after the overlay center. +Recentering overlays moves overlays between these lists. +The lists you get are copies, so that changing them has no effect. +However, the overlays you get are the real objects that the buffer uses." + (or (boundp 'xemacs-internal-overlay-center-pos) + (overlay-recenter (1+ (/ (- (point-max) (point-min)) 2)))) + (let ((pos xemacs-internal-overlay-center-pos) + before after) + (map-extents (lambda (overlay ignore) + (if (> pos (extent-end-position overlay)) + (push overlay before) + (push overlay after)) + nil) + nil nil nil nil 'all-extents-closed-open 'overlay) + (cons (nreverse before) (nreverse after)))) + +(defun-compat overlay-recenter (pos) + "Recenter the overlays of the current buffer around position POS." + (set (make-local-variable 'xemacs-internal-overlay-center-pos) pos)) + +(defun-compat overlay-get (overlay prop) + "Get the property of overlay OVERLAY with property name PROP." + (check-argument-type 'overlayp overlay) + (let ((value (extent-property overlay prop)) + category) + (if (and (null value) + (setq category (extent-property overlay 'category))) + (get category prop) + value))) + +(defun-compat overlay-put (overlay prop value) + "Set one property of overlay OVERLAY: give property PROP value VALUE." + (check-argument-type 'overlayp overlay) + (cond ((eq prop 'evaporate) + (set-extent-property overlay 'detachable value)) + ((eq prop 'before-string) + (set-extent-property overlay 'begin-glyph + (make-glyph (vector 'string :data value)))) + ((eq prop 'after-string) + (set-extent-property overlay 'end-glyph + (make-glyph (vector 'string :data value)))) + ((eq prop 'local-map) + (set-extent-property overlay 'keymap value)) + ((memq prop '(window insert-in-front-hooks insert-behind-hooks + modification-hooks)) + (error "cannot support overlay '%s property under XEmacs" + prop))) + (set-extent-property overlay prop value)) +) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; extents ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defalias-compat 'delete-extent 'delete-overlay) +(defalias-compat 'extent-end-position 'overlay-end) +(defalias-compat 'extent-start-position 'overlay-start) +(defalias-compat 'set-extent-endpoints 'move-overlay) +(defalias-compat 'set-extent-property 'overlay-put) +(defalias-compat 'make-extent 'make-overlay) + +(defun-compat extent-property (extent property &optional default) + (or (overlay-get extent property) default)) + +(defun-compat extent-at (pos &optional object property before at-flag) + (let ((tmp (overlays-at (point))) + ovls) + (if property + (while tmp + (if (extent-property (car tmp) property) + (setq ovls (cons (car tmp) ovls))) + (setq tmp (cdr tmp))) + (setq ovls tmp + tmp nil)) + (car-safe + (sort ovls + (function + (lambda (a b) + (< (- (extent-end-position a) (extent-start-position a)) + (- (extent-end-position b) (extent-start-position b))))))))) + +(defun-compat map-extents (function &optional object from to + maparg flags property value) + (let ((tmp (overlays-in (or from (point-min)) + (or to (point-max)))) + ovls) + (if property + (while tmp + (if (extent-property (car tmp) property) + (setq ovls (cons (car tmp) ovls))) + (setq tmp (cdr tmp))) + (setq ovls tmp + tmp nil)) + (catch 'done + (while ovls + (setq tmp (funcall function (car ovls) maparg) + ovls (cdr ovls)) + (if tmp + (throw 'done tmp)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; extents ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; events ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +) ;; group overlays + +) ;; compat-define-compat-functions + +(fmakunbound 'compat-define-compat-functions) + +) \ No newline at end of file
--- a/lisp/files.el Thu May 02 14:35:32 2002 +0000 +++ b/lisp/files.el Sun May 05 11:33:57 2002 +0000 @@ -2971,21 +2971,22 @@ bmin bmax) (save-excursion (set-buffer newbuf) - (let (buffer-read-only - (buffer-undo-list t) - after-change-function - after-change-functions - before-change-function - before-change-functions) - (if revert-buffer-insert-file-contents-function - (funcall revert-buffer-insert-file-contents-function - file-name nil) - (if (not (file-exists-p file-name)) - (error "File %s no longer exists!" file-name)) - (widen) - (insert-file-contents file-name t nil nil t) - (setq bmin (point-min) - bmax (point-max))))) + (with-obsolete-variable '(before-change-function after-change-function) + (let (buffer-read-only + (buffer-undo-list t) + after-change-function + after-change-functions + before-change-function + before-change-functions) + (if revert-buffer-insert-file-contents-function + (funcall revert-buffer-insert-file-contents-function + file-name nil) + (if (not (file-exists-p file-name)) + (error "File %s no longer exists!" file-name)) + (widen) + (insert-file-contents file-name t nil nil t) + (setq bmin (point-min) + bmax (point-max)))))) (if (not (and (eq bmin (point-min)) (eq bmax (point-max)) (eq (compare-buffer-substrings
--- a/nt/ChangeLog Thu May 02 14:35:32 2002 +0000 +++ b/nt/ChangeLog Sun May 05 11:33:57 2002 +0000 @@ -1,3 +1,20 @@ +2002-05-05 Ben Wing <ben@xemacs.org> + + * xemacs.mak (CFLAGS_NO_LIB): New. + * xemacs.mak (CFLAGS): + * xemacs.mak (ETAGS_DEPS): + * xemacs.mak (LIB_SRC_TOOLS): + Split up CFLAGS into a version without flags specifying the C + library. The problem seems to be that minitar depends on zlib, + which depends specifically on libc.lib, not on any of the other C + libraries. Unless you compile with libc.lib, you get errors -- + specifically, no _errno in the other libraries, which must make it + something other than an int. (#### But this doesn't seem to obtain + in XEmacs, which also uses zlib, and can be linked with any of the + C libraries. Maybe zlib is used differently and doesn't need + errno, or maybe XEmacs provides an int errno; ... I don't + understand. + 2002-03-26 Vin Shelton <acs@xemacs.org> * xemacs.mak: Added special rule to build winclient.exe.
--- a/nt/xemacs.mak Thu May 02 14:35:32 2002 +0000 +++ b/nt/xemacs.mak Sun May 05 11:33:57 2002 +0000 @@ -366,7 +366,9 @@ LIBC_LIB=libc.lib !endif -CFLAGS=-nologo -W3 $(DEBUGFLAGS) $(OPTFLAGS) $(C_LIBFLAG) +CFLAGS_NO_LIB=-nologo -W3 $(DEBUGFLAGS) $(OPTFLAGS) +CFLAGS=$(CFLAGS_NO_LIB) $(C_LIBFLAG) + !if $(HAVE_X_WINDOWS) X_DEFINES=-DHAVE_X_WINDOWS @@ -560,7 +562,7 @@ cd $(NT) $(LIB_SRC)/minitar.exe : $(NT)/minitar.c - $(CCV) -I"$(ZLIB_DIR)" $(LIB_SRC_DEFINES) $(CFLAGS) -Fe$@ $** "$(ZLIB_DIR)\zlib.lib" -link -incremental:no + $(CCV) -I"$(ZLIB_DIR)" $(LIB_SRC_DEFINES) $(CFLAGS_NO_LIB) -Fe$@ $** "$(ZLIB_DIR)\zlib.lib" -link -incremental:no LIB_SRC_TOOLS = \ $(LIB_SRC)/etags.exe \
--- a/src/ChangeLog Thu May 02 14:35:32 2002 +0000 +++ b/src/ChangeLog Sun May 05 11:33:57 2002 +0000 @@ -1,3 +1,881 @@ +2002-05-05 Ben Wing <ben@xemacs.org> + + * Makefile.in.in (batch_test_emacs): + + Fix so that packages are around when testing. + + * abbrev.c (struct abbrev_match_mapper_closure): + * abbrev.c (abbrev_match_mapper): + * abbrev.c (abbrev_match): + * abbrev.c (Fexpand_abbrev): + * alloc.c (deadbeef_memory): + * alloc.c (STRING_FULLSIZE): + * alloc.c (sledgehammer_check_ascii_begin): + * alloc.c (make_uninit_string): + * alloc.c (set_string_char): + * alloc.c (init_string_ascii_begin): + * alloc.c (make_string_nocopy): + * alloc.c (compact_string_chars): + * alloc.c (debug_string_purity_print): + * buffer.c (mark_buffer): + * buffer.c (print_buffer): + * buffer.c (finish_init_buffer): + * buffer.c (Fother_buffer): + * buffer.c (Fkill_buffer): + * buffer.h: + * buffer.h (struct buffer_text): + * buffer.h (struct buffer): + * buffer.h (BYTE_BUF_BEG): + * buffer.h (BYTE_BUF_BEGV): + * buffer.h (BYTE_BUF_ZV): + * buffer.h (BYTE_BUF_Z): + * buffer.h (BYTE_BUF_PT): + * buffer.h (INC_BYTEBPOS): + * buffer.h (make_charbpos): + * buffer.h (BYTE_BUF_FETCH_CHAR_RAW): + * buffer.h (BYTE_BUF_CHARPTR_COPY_EMCHAR): + * buffer.h (SET_BOTH_BUF_BEGV): + * buffer.h (SET_BOTH_BUF_ZV): + * buffer.h (BOTH_BUF_SET_PT): + * buffer.h (BUF_NARROWED): + * buffer.h (BYTE_BUF_CEILING_OF_IGNORE_ACCESSIBLE): + * buffer.h (BYTE_BUF_FLOOR_OF_IGNORE_ACCESSIBLE): + * bytecode.c (optimize_compiled_function): + * bytecode.c (print_compiled_function): + * bytecode.c (Fcompiled_function_annotation): + * callint.c (Fcall_interactively): + * casefiddle.c: + * casefiddle.c (casify_object): + * casefiddle.c (casify_region_internal): + * casetab.c: + * casetab.c (STRING256_P): + * casetab.c (print_case_table): + * casetab.c (allocate_case_table): + * casetab.c (Fmake_case_table): + * casetab.c (case_table_char): + * casetab.c (Fget_case_table): + * casetab.c (Fput_case_table): + * casetab.c (Fput_case_table_pair): + * casetab.c (Fcopy_case_table): + * casetab.c (compute_canon_mapper): + * casetab.c (compute_up_or_eqv_mapper): + * casetab.c (recompute_case_table): + * casetab.c (convert_old_style_syntax_string): + * casetab.c (set_case_table): + * casetab.c (Fset_standard_case_table): + * casetab.c (syms_of_casetab): + * casetab.c (complex_vars_of_casetab): + * casetab.h: + * casetab.h (struct Lisp_Case_Table): + * charset.h: + * charset.h (emchar_charset): + * charset.h (leading_byte_private_p): + * charset.h (private_leading_byte_prefix): + * charset.h (CHARSET_PRIVATE_P): + * charset.h (EMCHAR_FIELD1_MASK): + * charset.h (emchar_field1): + * charset.h (MIN_EMCHAR_FIELD2_OFFICIAL): + * charset.h (MIN_EMCHAR_FIELD1_OFFICIAL): + * charset.h (MIN_EMCHAR_FIELD2_PRIVATE): + * charset.h (MIN_EMCHAR_FIELD1_PRIVATE): + * charset.h (MIN_CHAR_OFFICIAL_TYPE9N): + * charset.h (BREAKUP_EMCHAR_1_UNSAFE): + * charset.h (BREAKUP_EMCHAR): + * chartab.c: + * chartab.c (char_table_entry_hash): + * chartab.c (decode_char_table_range): + * chartab.c (encode_char_table_range): + * chartab.c (struct ptemap): + * chartab.c (print_table_entry): + * chartab.c (print_char_table): + * chartab.c (char_table_equal): + * chartab.c (char_table_hash): + * chartab.c (set_char_table_default): + * chartab.c (fill_char_table): + * chartab.c (Freset_char_table): + * chartab.c (Fmake_char_table): + * chartab.c (get_non_ascii_char_table_value): + * chartab.c (Fchar_table_default): + * chartab.c (Fget_char_table): + * chartab.c (copy_mapper): + * chartab.c (copy_char_table_range): + * chartab.c (get_range_char_table): + * chartab.c (Fget_range_char_table): + * chartab.c (put_char_table): + * chartab.c (Fput_char_table): + * chartab.c (Fremove_char_table): + * chartab.c (map_over_charset_ascii_1): + * chartab.c (map_over_charset_control_1): + * chartab.c (map_over_charset_row): + * chartab.c (map_over_other_charset): + * chartab.c (map_char_table): + * chartab.c (slow_map_char_table_fun): + * chartab.c (Fmap_char_table): + * chartab.c (check_category_char): + * chartab.c (CATEGORY_SET): + * chartab.c (word_boundary_p): + * chartab.c (syms_of_chartab): + * chartab.h: + * chartab.h (struct Lisp_Char_Table): + * cmds.c: + * cmds.c (internal_self_insert): + * console-msw.h: + * console-stream.c (stream_clear_region): + * console-stream.c (stream_ring_bell): + * console-x.c (x_semi_canonicalize_console_connection): + * console.c (find_nonminibuffer_frame_not_on_console_predicate): + * console.h: + * data.c (eq_with_ebola_notice): + * data.c (Faref): + * data.c (Faset): + * device-msw.c (print_devmode): + * device.c (find_nonminibuffer_frame_not_on_device_predicate): + * device.h: + * device.h (struct pixel_to_glyph_translation_cache): + * dialog-msw.c (dialog_proc): + * dialog-x.c (maybe_run_dbox_text_callback): + * dired-msw.c: + * dired-msw.c (mswindows_get_files): + * dired.c: + * dired.c (Fdirectory_files): + * dired.c (file_name_completion): + * dired.c (user_name_completion): + * doc.c (unparesseuxify_doc_string): + * doprnt.c (emacs_doprnt_1): + * dumper.c: + * dumper.c (PDUMP_READ_ALIGNED): + * dumper.c (pdump_structure_size): + * dumper.c (pdump): + * dumper.c (pdump_load_finish): + * editfns.c: + * editfns.c (Fstring_to_char): + * editfns.c (Ftranslate_region): + * editfns.c (Fdelete_region): + * editfns.c (widen_buffer): + * editfns.c (Fnarrow_to_region): + * editfns.c (save_restriction_restore): + * elhash.c (print_hash_table_data): + * elhash.c (print_hash_table): + * elhash.c (Finternal_hash_value): + * emacs.c: + * emacs.c (main_1): + * emacs.c (standard_args): + * eval.c (print_subr): + * eval.c (Fuser_variable_p): + * eval.c (backtrace_specials): + * eval.c (Fbacktrace): + * event-Xt.c (USE_CHARSET): + * event-Xt.c (x_keysym_to_character): + * event-Xt.c (emacs_Xt_format_magic_event): + * event-gtk.c (emacs_gtk_format_magic_event): + * event-msw.c (mswindows_wnd_proc): + * event-msw.c (mswindows_find_frame): + * event-msw.c (FROB): + * event-msw.c (emacs_mswindows_format_magic_event): + * event-stream.c (external_debugging_print_event): + * event-stream.c (command_builder_find_leaf): + * event-stream.c (dribble_out_event): + * events.c (print_event_1): + * events.c (print_event): + * events.c (nth_of_key_sequence_as_event): + * events.c (Fevent_next): + * events.c (Fset_event_next): + * events.h: + * extents.c: + * extents.c (stack_of_extents): + * extents.c (memxpos_to_startind): + * extents.c (buffer_or_string_bytexpos_to_startind): + * extents.c (buffer_or_string_bytexpos_to_endind): + * extents.c (gap_array_adjust_markers): + * extents.c (gap_array_move_gap): + * extents.c (extent_list_locate_from_pos): + * extents.c (extent_list_at): + * extents.c (soe_dump): + * extents.c (soe_move): + * extents.c (extent_endpoint_byte): + * extents.c (extent_endpoint_char): + * extents.c (signal_single_extent_changed): + * extents.c (signal_extent_changed): + * extents.c (signal_extent_property_changed): + * extents.c (extent_attach): + * extents.c (extent_detach): + * extents.c (extent_in_region_p): + * extents.c (map_extents): + * extents.c (adjust_extents): + * extents.c (adjust_extents_for_deletion): + * extents.c (extent_find_end_of_run): + * extents.c (extent_find_beginning_of_run): + * extents.c (extent_fragment_update): + * extents.c (print_extent_1): + * extents.c (print_extent): + * extents.c (extent_remprop): + * extents.c (extent_endpoint_external): + * extents.c (Fextent_length): + * extents.c (Fnext_extent_change): + * extents.c (Fprevious_extent_change): + * extents.c (Fset_extent_parent): + * extents.c (set_extent_endpoints_1): + * extents.c (set_extent_endpoints): + * extents.c (set_extent_openness): + * extents.c (make_extent): + * extents.c (Fmake_extent): + * extents.c (Fset_extent_endpoints): + * extents.c (Fextent_in_region_p): + * extents.c (Fmap_extents): + * extents.c (struct slow_map_extent_children_arg): + * extents.c (slow_map_extent_children_function): + * extents.c (Fmap_extent_children): + * extents.c (struct extent_at_arg): + * extents.c (decode_extent_at_flag): + * extents.c (extent_at): + * extents.c (Fextent_at): + * extents.c (Fextents_at): + * extents.c (struct verify_extents_arg): + * extents.c (verify_extent_modification): + * extents.c (struct process_extents_for_insertion_arg): + * extents.c (process_extents_for_insertion_mapper): + * extents.c (process_extents_for_insertion): + * extents.c (struct process_extents_for_deletion_arg): + * extents.c (process_extents_for_deletion): + * extents.c (report_extent_modification_mapper): + * extents.c (report_extent_modification): + * extents.c (set_extent_invisible): + * extents.c (Fset_extent_face): + * extents.c (Fset_extent_mouse_face): + * extents.c (set_extent_glyph): + * extents.c (Fset_extent_begin_glyph_layout): + * extents.c (Fset_extent_end_glyph_layout): + * extents.c (Fset_extent_priority): + * extents.c (Fset_extent_property): + * extents.c (extent_properties): + * extents.c (ADD_PROP): + * extents.c (Fextent_properties): + * extents.c (do_highlight): + * extents.c (run_extent_copy_paste_internal): + * extents.c (run_extent_copy_function): + * extents.c (run_extent_paste_function): + * extents.c (run_extent_paste_function_char): + * extents.c (insert_extent): + * extents.c (struct add_string_extents_arg): + * extents.c (add_string_extents_mapper): + * extents.c (struct add_string_extents_the_hard_way_arg): + * extents.c (add_string_extents_the_hard_way_mapper): + * extents.c (add_string_extents): + * extents.c (struct splice_in_string_extents_arg): + * extents.c (splice_in_string_extents_mapper): + * extents.c (struct splice_in_string_extents_the_hard_way_arg): + * extents.c (splice_in_string_extents_the_hard_way_mapper): + * extents.c (splice_in_string_extents): + * extents.c (copy_string_extents_mapper): + * extents.c (copy_string_extents): + * extents.c (get_char_property): + * extents.c (get_char_property_char): + * extents.c (Fget_text_property): + * extents.c (Fget_char_property): + * extents.c (struct put_text_prop_arg): + * extents.c (put_text_prop_mapper): + * extents.c (put_text_prop_openness_mapper): + * extents.c (put_text_prop): + * extents.c (Fput_text_property): + * extents.c (Fadd_text_properties): + * extents.c (Fremove_text_properties): + * extents.c (next_single_property_change): + * extents.c (previous_single_property_change): + * extents.h: + * extents.h (struct extent): + * faces.c (print_face): + * faces.c (update_face_inheritance_mapper): + * faces.c (ensure_face_cachel_complete): + * faces.c (face_cachel_charset_font_metric_info): + * file-coding.c (print_coding_system): + * file-coding.c (print_coding_system_in_print_method): + * file-coding.c (chain_print): + * file-coding.c (no_conversion_convert): + * file-coding.c (undecided_print): + * file-coding.c (gzip_print): + * file-coding.h (DECLARE_CODING_SYSTEM_TYPE): + * file-coding.h (DECODE_ADD_BINARY_CHAR): + * fileio.c (Ffile_truename): + * fileio.c (expand_and_dir_to_file): + * fns.c (print_bit_vector): + * fns.c (Flength): + * fns.c (Fstring_lessp): + * fns.c (Fsplit_path): + * fns.c (Ffillarray): + * fns.c (Fbase64_encode_string): + * fns.c (Fbase64_decode_string): + * font-lock.c: + * font-lock.c (find_context): + * frame-gtk.c (gtk_set_frame_text_value): + * frame-msw.c (mswindows_get_mouse_position): + * frame-msw.c (mswindows_get_frame_parent): + * frame-x.c: + * frame-x.c (x_set_frame_text_value): + * frame.c: + * frame.c (allocate_frame_core): + * frame.c (Fignore_event): + * frame.h: + * glade.c (connector): + * glyphs-gtk.c: + * glyphs-gtk.c (convert_EImage_to_GDKImage): + * glyphs-gtk.c (gtk_print_image_instance): + * glyphs-gtk.c (gtk_locate_pixmap_file): + * glyphs-msw.c (mswindows_locate_pixmap_file): + * glyphs-msw.c (mswindows_print_image_instance): + * glyphs-msw.c (charset_of_text): + * glyphs-msw.h: + * glyphs-x.c (LISP_DEVICE_TO_X_SCREEN): + * glyphs-x.c (convert_EImage_to_XImage): + * glyphs-x.c (x_print_image_instance): + * glyphs-x.c (x_locate_pixmap_file): + * glyphs.c (check_instance_cache_mapper): + * glyphs.c (print_image_instance): + * glyphs.c (query_string_font): + * glyphs.c (check_valid_xbm_inline): + * glyphs.c (display_table_entry): + * glyphs.h: + * gui-msw.c (mswindows_handle_gui_wm_command): + * gui-x.c (mark_widget_value_mapper): + * gui-x.c (popup_selection_callback): + * gui.h: + * gutter.h (GUTTER_POS_LOOP): + * hash.h: + * indent.c: + * indent.c (column_at_point): + * indent.c (string_column_at_point): + * indent.c (byte_spaces_at_point): + * indent.c (Fcurrent_indentation): + * indent.c (Fmove_to_column): + * insdel.c (BYTE_BUF_GPT): + * insdel.c (SET_BYTE_BUF_GPT): + * insdel.c (SET_END_SENTINEL): + * insdel.c (set_buffer_point): + * insdel.c (gap_left): + * insdel.c (gap_right): + * insdel.c (move_gap): + * insdel.c (merge_gap_with_end_gap): + * insdel.c (make_gap): + * insdel.c (signal_before_change): + * insdel.c (signal_after_change): + * insdel.c (buffer_insert_string_1): + * insdel.c (buffer_delete_range): + * insdel.c (buffer_replace_char): + * insdel.c (make_string_from_buffer_1): + * insdel.c (init_buffer_text): + * intl-win32.c: + * intl-win32.c (Fmswindows_get_valid_code_pages): + * intl-win32.c (Fmswindows_get_console_code_page): + * intl-win32.c (Fmswindows_set_console_code_page): + * intl-win32.c (Fmswindows_get_console_output_code_page): + * intl-win32.c (Fmswindows_set_console_output_code_page): + * intl-win32.c (Fmswindows_get_code_page_charset): + * intl-win32.c (Fmswindows_get_valid_keyboard_layouts): + * intl-win32.c (Fmswindows_get_keyboard_layout): + * intl-win32.c (Fmswindows_set_keyboard_layout): + * intl-win32.c (mswindows_multibyte_to_unicode_print): + * intl.c: + * intl.c (Fignore_defer_gettext): + * keymap.c (print_keymap): + * keymap.c (keymap_lookup_directly): + * keymap.c (keymap_store): + * keymap.c (define_key_check_and_coerce_keysym): + * keymap.c (Fdefine_key): + * keymap.c (Flookup_key): + * keymap.c (map_keymap_mapper): + * keymap.c (Fkey_description): + * lisp-disunion.h: + * lisp-disunion.h (VALMASK): + * lisp-disunion.h (VOID_TO_LISP): + * lisp-union.h: + * lisp-union.h (union Lisp_Object): + * lisp-union.h (XPNTRVAL): + * lisp-union.h (XREALINT): + * lisp-union.h (INTP): + * lisp.h: + * lisp.h (DECLARE_POINTER_TYPE_ARITH_COUNT): + * lisp.h (MAX_ALIGN_SIZE): + * lisp.h (struct Lisp_String): + * lisp.h (set_lispstringp_length): + * lisp.h (XSET_STRING_LENGTH): + * lisp.h (FLEXIBLE_ARRAY_STRUCT_SIZEOF): + * lisp.h (SYMBOL_IS_KEYWORD): + * lread.c: + * lrecord.h: + * lrecord.h (DECLARE_LRECORD): + * lrecord.h (DECLARE_EXTERNAL_LRECORD): + * lrecord.h (DECLARE_NONRECORD): + * lstream.c (aligned_sizeof_lstream): + * lstream.c (Lstream_really_write): + * lstream.c (make_lisp_buffer_stream_1): + * lstream.c (make_lisp_buffer_input_stream): + * lstream.c (lisp_buffer_reader): + * lstream.c (lisp_buffer_writer): + * lstream.h: + * marker.c (print_marker): + * marker.c (byte_marker_position): + * marker.c (marker_position): + * marker.c (set_byte_marker_position): + * marker.c (set_marker_position): + * marker.c (Fbuffer_has_markers_at): + * menubar-gtk.c (__torn_off_sir): + * menubar-gtk.c (__activate_menu): + * menubar-gtk.c (__generic_button_callback): + * menubar-msw.c: + * menubar-x.c (pre_activate_callback): + * menubar-x.c (command_builder_operate_menu_accelerator): + * menubar-x.c (command_builder_find_menu_accelerator): + * menubar.c: + * menubar.c (Fnormalize_menu_item_name): + * minibuf.c: + * minibuf.c (Ftry_completion): + * minibuf.c (Fall_completions): + * minibuf.c (Fminibuffer_prompt): + * minibuf.c (Fminibuffer_prompt_width): + * minibuf.c (echo_area_append): + * mule-ccl.c: + * mule-ccl.c (CCL_WRITE_CHAR): + * mule-ccl.c (CCL_WRITE_STRING): + * mule-ccl.c (CCL_MAKE_CHAR): + * mule-ccl.c (ccl_driver): + * mule-charset.c (Fmake_charset): + * mule-charset.c (Fcharset_from_attributes): + * mule-coding.c (byte_shift_jis_two_byte_1_p): + * mule-coding.c (byte_shift_jis_two_byte_2_p): + * mule-coding.c (byte_shift_jis_katakana_p): + * mule-coding.c (shift_jis_convert): + * mule-coding.c (Fdecode_shift_jis_char): + * mule-coding.c (Fencode_shift_jis_char): + * mule-coding.c (byte_big5_two_byte_1_p): + * mule-coding.c (byte_big5_two_byte_2_p): + * mule-coding.c (big5_convert): + * mule-coding.c (decode_big5_char): + * mule-coding.c (Fencode_big5_char): + * mule-coding.c (charset_by_attributes_or_create_one): + * mule-coding.c (iso2022_decode): + * mule-coding.c (iso2022_encode): + * mule-coding.c (iso2022_print): + * mule-coding.c (iso2022_detect): + * mule-wnnfns.c (m2w): + * nas.c: + * objects-msw.c (mswindows_string_to_color): + * objects-msw.c (mswindows_font_spec_matches_charset): + * objects-x.c (x_font_instance_properties): + * opaque.c (aligned_sizeof_opaque): + * postgresql.c (print_pgconn): + * postgresql.c (print_pgresult): + * print.c: + * print.c (output_string): + * print.c (write_string_1): + * print.c (write_string): + * print.c (write_c_string): + * print.c (write_eistring): + * print.c (write_fmt_string): + * print.c (write_fmt_string_lisp): + * print.c (stderr_out_lisp): + * print.c (Fterpri): + * print.c (Fprint): + * print.c (print_error_message): + * print.c (print_vector_internal): + * print.c (print_cons): + * print.c (print_string): + * print.c (print_internal): + * print.c (print_float): + * print.c (print_symbol): + * process-nt.c (nt_create_process): + * process-unix.c (close_process_descs_mapfun): + * process.c (print_process): + * process.c (get_process_from_usid): + * process.c (Fstart_process_internal): + * process.c (status_message): + * process.c (status_notify): + * process.c (Fprocess_connection): + * process.c (getenv_internal): + * process.c (putenv_internal): + * process.h: + * profile.c (get_profiling_info_maphash): + * profile.c (mark_profiling_info_maphash): + * rangetab.c (print_range_table): + * rangetab.c (unified_range_table_copy_data): + * rangetab.c (align_the_damn_table): + * redisplay-gtk.c: + * redisplay-gtk.c (separate_textual_runs): + * redisplay-gtk.c (gtk_output_display_block): + * redisplay-msw.c (separate_textual_runs): + * redisplay-msw.c (mswindows_output_display_block): + * redisplay-output.c: + * redisplay-output.c (ADJ_CHARPOS): + * redisplay-output.c (redisplay_move_cursor): + * redisplay-output.c (redisplay_update_line): + * redisplay-x.c (separate_textual_runs): + * redisplay-x.c (x_output_display_block): + * redisplay.c: + * redisplay.c (position_redisplay_data_type): + * redisplay.c (struct prop_block): + * redisplay.c (generate_display_line): + * redisplay.c (add_hscroll_rune): + * redisplay.c (add_emchar_rune_1): + * redisplay.c (add_blank_rune): + * redisplay.c (add_octal_runes): + * redisplay.c (add_control_char_runes): + * redisplay.c (add_disp_table_entry_runes_1): + * redisplay.c (add_propagation_runes): + * redisplay.c (add_glyph_rune): + * redisplay.c (create_text_block): + * redisplay.c (add_margin_blank): + * redisplay.c (generate_modeline): + * redisplay.c (generate_fstring_runes): + * redisplay.c (create_string_text_block): + * redisplay.c (generate_string_display_line): + * redisplay.c (generate_displayable_area): + * redisplay.c (REGEN_INC_FIND_START_END): + * redisplay.c (regenerate_window_extents_only_changed): + * redisplay.c (regenerate_window_incrementally): + * redisplay.c (point_visible): + * redisplay.c (point_at_center): + * redisplay.c (update_internal_cache_list): + * redisplay.c (UPDATE_CACHE_RETURN): + * redisplay.c (pixel_to_glyph_translation): + * redisplay.h: + * redisplay.h (struct rune): + * redisplay.h (struct display_line): + * redisplay.h (struct extent_fragment): + * regex.c: + * regex.c (RE_TRANSLATE_1): + * regex.c (charptr_emchar): + * regex.c (INC_CHARPTR_FMT): + * regex.c (SYNTAX): + * regex.c (EXTEND_BUFFER): + * regex.c (regex_compile): + * regex.c (compile_range): + * regex.c (compile_extended_range): + * regex.c (re_compile_fastmap): + * regex.c (re_search): + * regex.c (re_search_2): + * regex.c (REGEX_PREFETCH): + * regex.c (WORDCHAR_P): + * regex.c (re_match): + * regex.c (re_match_2): + * regex.c (re_match_2_internal): + * regex.c (re_compile_pattern): + * regex.c (re_comp): + * regex.c (make-backup-files): Removed. + * regex.c (version-control): Removed. + * regex.c (trim-versions-without-asking): Removed. + * regex.c (End): Removed. + * regex.h: + * regex.h (RE_LISP_SHORT_CONTEXT_ARGS_DECL): + * scrollbar-msw.c (mswindows_free_scrollbar_instance): + * scrollbar-msw.c (mswindows_handle_scrollbar_event): + * scrollbar-msw.c (mswindows_handle_mousewheel_event): + * search.c: + * search.c (matcher_overflow): + * search.c (compile_pattern_1): + * search.c (compile_pattern): + * search.c (fixup_search_regs_for_buffer): + * search.c (looking_at_1): + * search.c (Fposix_looking_at): + * search.c (string_match_1): + * search.c (fast_string_match): + * search.c (byte_scan_buffer): + * search.c (scan_buffer): + * search.c (byte_find_next_newline_no_quit): + * search.c (byte_find_next_emchar_in_string): + * search.c (find_before_next_newline): + * search.c (skip_chars): + * search.c (search_command): + * search.c (trivial_regexp_p): + * search.c (search_buffer): + * search.c (simple_search): + * search.c (boyer_moore): + * search.c (set_search_regs): + * search.c (wordify): + * search.c (Freplace_match): + * search.c (match_limit): + * search.c (Fmatch_data): + * search.c (Fstore_match_data): + * select-x.c (hack_motif_clipboard_selection): + * select-x.c (Fx_store_cutbuffer_internal): + * specifier.c (print_specifier): + * specifier.c (aligned_sizeof_specifier): + * specifier.c (recompute_cached_specifier_everywhere_mapfun): + * specifier.h: + * specifier.h (DECLARE_SPECIFIER_TYPE): + * symbols.c (Fintern): + * symsinit.h: + * syntax.c: + * syntax.c (struct lisp_parse_state): + * syntax.c (find_defun_start): + * syntax.c (Fset_syntax_table): + * syntax.c (init_syntax_cache): + * syntax.c (update_syntax_cache): + * syntax.c (Fchar_syntax): + * syntax.c (charset_syntax): + * syntax.c (syntax_match): + * syntax.c (Fmatching_paren): + * syntax.c (WORD_BOUNDARY_P): + * syntax.c (scan_words): + * syntax.c (find_start_of_comment): + * syntax.c (find_end_of_comment): + * syntax.c (Fforward_comment): + * syntax.c (scan_lists): + * syntax.c (char_quoted): + * syntax.c (Fbackward_prefix_chars): + * syntax.c (scan_sexps_forward): + * syntax.c (Fparse_partial_sexp): + * syntax.c (copy_to_mirrortab): + * syntax.c (copy_if_not_already_present): + * syntax.c (update_just_this_syntax_table): + * syntax.c (update_syntax_table): + * syntax.c (syms_of_syntax): + * syntax.c (vars_of_syntax): + * syntax.c (complex_vars_of_syntax): + * syntax.h: + * syntax.h (SYNTAX_CODE): + * syntax.h (SYNTAX_FROM_CODE): + * syntax.h (SYNTAX_PREFIX): + * syntax.h (struct syntax_cache): + * syswindows.h: + * tests.c (Ftest_data_format_conversion): + * text.c: + * text.c (convert_emchar_string_into_malloced_string): + * text.c (COPY_TEXT_BETWEEN_FORMATS): + * text.c (copy_buffer_text_out): + * text.c (find_charsets_in_intbyte_string): + * text.c (find_charsets_in_emchar_string): + * text.c (intbyte_string_displayed_columns): + * text.c (emchar_string_displayed_columns): + * text.c (intbyte_string_nonascii_chars): + * text.c (eicpyout_malloc_fmt): + * text.c (skip_ascii): + * text.c (charcount_to_bytecount_fun): + * text.c (charbpos_to_bytebpos_func): + * text.c (bytebpos_to_charbpos_func): + * text.c (buffer_mule_signal_inserted_region): + * text.c (buffer_mule_signal_deleted_region): + * text.c (get_buffer_range_char): + * text.c (get_buffer_range_byte): + * text.c (get_string_pos_char): + * text.c (get_string_range_char): + * text.c (get_buffer_or_string_pos_char): + * text.c (get_buffer_or_string_pos_byte): + * text.c (get_buffer_or_string_range_char): + * text.c (get_buffer_or_string_range_byte): + * text.c (buffer_or_string_accessible_begin_char): + * text.c (buffer_or_string_accessible_end_char): + * text.c (buffer_or_string_accessible_begin_byte): + * text.c (buffer_or_string_accessible_end_byte): + * text.c (buffer_or_string_absolute_begin_char): + * text.c (buffer_or_string_absolute_end_char): + * text.c (buffer_or_string_absolute_begin_byte): + * text.c (buffer_or_string_absolute_end_byte): + * text.c (dfc_convert_to_external_format): + * text.c (dfc_convert_to_internal_format): + * text.c (non_ascii_set_charptr_emchar): + * text.c (non_ascii_charptr_emchar): + * text.c (non_ascii_valid_emchar_p): + * text.c (non_ascii_charptr_copy_emchar): + * text.c (Lstream_get_emchar_1): + * text.c (Fmake_char): + * text.c (Fchar_charset): + * text.c (Fchar_octet): + * text.c (Fsplit_char): + * text.c (lookup_composite_char): + * text.c (Fmake_composite_char): + * text.c (Fcomposite_char_string): + * text.h: + * text.h (rep_bytes_by_first_byte): + * text.h (byte_ascii_p): + * text.h (intbyte_leading_byte_p): + * text.h (emchar_multibyte_p): + * text.h (emchar_ascii_p): + * text.h (assert_valid_charptr): + * text.h (INC_CHARPTR): + * text.h (INC_CHARPTR_FMT): + * text.h (DEC_CHARPTR_FMT): + * text.h (VALIDATE_CHARPTR_BACKWARD): + * text.h (validate_intbyte_string_backward): + * text.h (simple_charptr_copy_emchar): + * text.h (charptr_emchar): + * text.h (valid_emchar_p): + * text.h (CHAR_INTP): + * text.h (eicpy_lstr): + * text.h (eicpy_raw_fmt): + * text.h (eicpy_raw): + * text.h (eicpy_rawz_fmt): + * text.h (eicpy_rawz): + * text.h (eicpyout_alloca): + * text.h (eicat_lstr): + * text.h (GET_STRERROR): + * tooltalk.c (tooltalk_message_callback): + * tooltalk.c (tooltalk_pattern_callback): + * ui-byhand.c (__generic_toolbar_callback): + * ui-byhand.c (__emacs_gtk_ctree_recurse_internal): + * ui-gtk.c (emacs_gtk_object_printer): + * ui-gtk.c (__internal_callback_destroy): + * ui-gtk.c (__internal_callback_marshal): + * ui-gtk.c (emacs_gtk_boxed_printer): + * ui-gtk.c (gtk_type_to_lisp): + * unicode.c (sledgehammer_check_from_table): + * unicode.c (sledgehammer_check_to_table): + * unicode.c (set_unicode_conversion): + * unicode.c (emchar_to_unicode): + * unicode.c (unicode_to_char): + * unicode.c (recalculate_unicode_precedence): + * unicode.c (Fchar_to_unicode): + * unicode.c (encode_unicode_char): + * unicode.c (unicode_convert): + * unicode.c (unicode_print): + * win32.c: + * win32.c (tstr_to_local_file_format): + * win32.c (mswindows_lisp_error_1): + * win32.c (Fmswindows_shell_execute): + * window.c (print_window): + * window.c (print_window_config): + * window.c (Fcurrent_pixel_column): + + Another big Ben patch. + + -- FUNCTIONALITY CHANGES: + + add partial support for 8-bit-fixed, 16-bit-fixed, and + 32-bit-fixed formats. not quite done yet. (in particular, needs + functions to actually convert the buffer.) NOTE: lots of changes + to regex.c here. also, many new *_fmt() inline funs that take an + Internal_Format argument. + + redo syntax cache code. make the cache per-buffer; keep the cache + valid across calls to functions that use it. also keep it valid + across insertions/deletions and extent changes, as much as is + possible. eliminate the junky regex-reentrancy code by passing in + the relevant lisp info to the regex routines as local vars. + + add general mechanism in extents code for signalling extent changes. + + fix numerous problems with the case-table implementation; yoshiki + never properly transferred many algorithms from old-style to + new-style case tables. + + redo char tables to support a default argument, so that mapping + only occurs over changed args. change many chartab functions to + accept Lisp_Object instead of Lisp_Char_Table *. + + comment out the code in font-lock.c by default, because + font-lock.el no longer uses it. we should consider eliminating it + entirely. + + Don't output bell as ^G in console-stream when not a TTY. + + add -mswindows-termination-handle to interface with i.c, so we can + properly kill a build. + + add more error-checking to buffer/string macros. + + add some additional buffer_or_string_() funs. + + -- INTERFACE CHANGES AFFECTING MORE CODE: + + switch the arguments of write_c_string and friends to be + consistent with write_fmt_string, which must have printcharfun + first. + + change BI_* macros to BYTE_* for increased clarity; similarly for + bi_* local vars. + + change VOID_TO_LISP to be a one-argument function. eliminate + no-longer-needed CVOID_TO_LISP. + + -- char/string macro changes: + + rename MAKE_CHAR() to make_emchar() for slightly less confusion + with make_char(). (The former generates an Emchar, the latter a + Lisp object. Conceivably we should rename make_char() -> wrap_char() + and similarly for make_int(), make_float().) + + Similar changes for other *CHAR* macros -- we now consistently use + names with `emchar' whenever we are working with Emchars. Any + remaining name with just `char' always refers to a Lisp object. + + rename macros with XSTRING_* to string_* except for those that + reference actual fields in the Lisp_String object, following + conventions used elsewhere. + + rename set_string_{data,length} macros (the only ones to work with + a Lisp_String_* instead of a Lisp_Object) to set_lispstringp_* + to make the difference clear. + + try to be consistent about caps vs. lowercase in macro/inline-fun + names for chars and such, which wasn't the case before. we now + reserve caps either for XFOO_ macros that reference object fields + (e.g. XSTRING_DATA) or for things that have non-function semantics, + e.g. directly modifying an arg (BREAKUP_EMCHAR) or evaluating an + arg (any arg) more than once. otherwise, use lowercase. + + here is a summary of most of the macros/inline funs changed by all + of the above changes: + + BYTE_*_P -> byte_*_p + XSTRING_BYTE -> string_byte + set_string_data/length -> set_lispstringp_data/length + XSTRING_CHAR_LENGTH -> string_char_length + XSTRING_CHAR -> string_emchar + INTBYTE_FIRST_BYTE_P -> intbyte_first_byte_p + INTBYTE_LEADING_BYTE_P -> intbyte_leading_byte_p + charptr_copy_char -> charptr_copy_emchar + LEADING_BYTE_* -> leading_byte_* + CHAR_* -> EMCHAR_* + *_CHAR_* -> *_EMCHAR_* + *_CHAR -> *_EMCHAR + CHARSET_BY_ -> charset_by_* + BYTE_SHIFT_JIS* -> byte_shift_jis* + BYTE_BIG5* -> byte_big5* + REP_BYTES_BY_FIRST_BYTE -> rep_bytes_by_first_byte + char_to_unicode -> emchar_to_unicode + valid_char_p -> valid_emchar_p + + Change intbyte_strcmp -> qxestrcmp_c (duplicated functionality). + + -- INTERFACE CHANGES AFFECTING LESS CODE: + + use DECLARE_INLINE_HEADER in various places. + + remove '#ifdef emacs' from XEmacs-only files. + + eliminate CHAR_TABLE_VALUE(), which duplicated the functionality + of get_char_table(). + + add BUFFER_TEXT_LOOP to simplify iterations over buffer text. + + define typedefs for signed and unsigned types of fixed sizes + (INT_32_BIT, UINT_32_BIT, etc.). + + create ALIGN_FOR_TYPE as a higher-level interface onto ALIGN_SIZE; + fix code to use it. + + add charptr_emchar_len to return the text length of the character + pointed to by a ptr; use it in place of + charcount_to_bytecount(..., 1). add emchar_len to return the text + length of a given character. + + add types Bytexpos and Charxpos to generalize Bytebpos/Bytecount + and Charbpos/Charcount, in code (particularly, the extents code + and redisplay code) that works with either kind of index. rename + redisplay struct params with names such as `charbpos' to + e.g. `charpos' when they are e.g. a Charxpos, not a Charbpos. + + eliminate xxDEFUN in place of DEFUN; no longer necessary with + changes awhile back to doc.c. + + split up big ugly combined list of EXFUNs in lisp.h on a + file-by-file basis, since other prototypes are similarly split. + + rewrite some "*_UNSAFE" macros as inline funs and eliminate the + _UNSAFE suffix. + + move most string code from lisp.h to text.h; the string code and + text.h code is now intertwined in such a fashion that they need + to be in the same place and partially interleaved. (you can't + create forward references for inline funs) + 2002-04-30 Charles G. Waldman <cgw@xemacs.org> * sysdep.c (sys_siglist): change "signum" to "signal"
--- a/src/Makefile.in.in Thu May 02 14:35:32 2002 +0000 +++ b/src/Makefile.in.in Sun May 05 11:33:57 2002 +0000 @@ -600,7 +600,7 @@ ## We have automated tests!! testdir = ${srcdir}/../tests/automated -batch_test_emacs = ${batch} -l ${testdir}/test-harness.el -f batch-test-emacs ${testdir} +batch_test_emacs = ${batch_packages} -l ${testdir}/test-harness.el -f batch-test-emacs ${testdir} .PHONY: check check-temacs check:
--- a/src/abbrev.c Thu May 02 14:35:32 2002 +0000 +++ b/src/abbrev.c Sun May 05 11:33:57 2002 +0000 @@ -76,9 +76,10 @@ Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook; -struct abbrev_match_mapper_closure { +struct abbrev_match_mapper_closure +{ struct buffer *buf; - Lisp_Char_Table *chartab; + Lisp_Object chartab; Charbpos point; Charcount maxlen; Lisp_Symbol *found; @@ -104,7 +105,7 @@ return 0; } abbrev = symbol_name (sym); - abbrev_length = XSTRING_CHAR_LENGTH (abbrev); + abbrev_length = string_char_length (abbrev); if (abbrev_length > closure->maxlen) { /* This abbrev is too large -- it wouldn't fit. */ @@ -114,7 +115,7 @@ normally want to expand it. OTOH, if the abbrev begins with non-word syntax (e.g. `#if'), it is OK to abbreviate it anywhere. */ if (abbrev_length < closure->maxlen && abbrev_length > 0 - && (WORD_SYNTAX_P (closure->chartab, XSTRING_CHAR (abbrev, 0))) + && (WORD_SYNTAX_P (closure->chartab, string_emchar (abbrev, 0))) && (WORD_SYNTAX_P (closure->chartab, BUF_FETCH_CHAR (closure->buf, closure->point - @@ -160,7 +161,7 @@ closure.buf = buf; closure.point = BUF_PT (buf); closure.maxlen = closure.point - BUF_BEGV (buf); - closure.chartab = XCHAR_TABLE (buf->mirror_syntax_table); + closure.chartab = buf->mirror_syntax_table; closure.found = 0; map_obarray (obarray, abbrev_match_mapper, &closure); @@ -330,7 +331,7 @@ /* OK, we're out of the must-be-fast part. An abbreviation matched. Now find the parameters, insert the expansion, and make it all look pretty. */ - abbrev_length = XSTRING_CHAR_LENGTH (symbol_name (abbrev_symbol)); + abbrev_length = string_char_length (symbol_name (abbrev_symbol)); abbrev_start = point - abbrev_length; expansion = symbol_value (abbrev_symbol); @@ -386,7 +387,7 @@ Charbpos pos = abbrev_start; /* Find the initial. */ while (pos < point - && !WORD_SYNTAX_P (XCHAR_TABLE (buf->mirror_syntax_table), + && !WORD_SYNTAX_P (buf->mirror_syntax_table, BUF_FETCH_CHAR (buf, pos))) pos++; /* Change just that. */
--- a/src/alloc.c Thu May 02 14:35:32 2002 +0000 +++ b/src/alloc.c Sun May 05 11:33:57 2002 +0000 @@ -345,20 +345,10 @@ #ifdef ERROR_CHECK_GC -#if SIZEOF_INT == 4 -typedef unsigned int four_byte_t; -#elif SIZEOF_LONG == 4 -typedef unsigned long four_byte_t; -#elif SIZEOF_SHORT == 4 -typedef unsigned short four_byte_t; -#else -What kind of strange-ass system are we running on? -#endif - static void deadbeef_memory (void *ptr, Bytecount size) { - four_byte_t *ptr4 = (four_byte_t *) ptr; + UINT_32_BIT *ptr4 = (UINT_32_BIT *) ptr; Bytecount beefs = size >> 2; /* In practice, size will always be a multiple of four. */ @@ -1832,8 +1822,7 @@ * (including alignment padding). */ #define STRING_FULLSIZE(size) \ - ALIGN_SIZE (((size) + 1 + sizeof (Lisp_String *)),\ - ALIGNOF (Lisp_String *)) + ALIGN_FOR_TYPE (((size) + 1 + sizeof (Lisp_String *)), Lisp_String *) #define BIG_STRING_FULLSIZE_P(fullsize) ((fullsize) >= STRING_CHARS_BLOCK_SIZE) #define BIG_STRING_SIZE_P(size) (BIG_STRING_FULLSIZE_P (STRING_FULLSIZE(size))) @@ -1908,7 +1897,7 @@ for (i = 0; i < XSTRING_LENGTH (str); i++) { - if (!BYTE_ASCII_P (XSTRING_BYTE (str, i))) + if (!byte_ascii_p (string_byte (str, i))) break; } @@ -1936,12 +1925,12 @@ xzero (*s); set_lheader_implementation (&s->u.lheader, &lrecord_string); - set_string_data (s, BIG_STRING_FULLSIZE_P (fullsize) + set_lispstringp_data (s, BIG_STRING_FULLSIZE_P (fullsize) ? xnew_array (Intbyte, length + 1) : allocate_string_chars_struct (wrap_string (s), fullsize)->chars); - set_string_length (s, length); + set_lispstringp_length (s, length); s->plist = Qnil; set_string_byte (wrap_string (s), length, 0); @@ -2106,7 +2095,7 @@ { Intbyte newstr[MAX_EMCHAR_LEN]; Bytecount bytoff = string_index_char_to_byte (s, i); - Bytecount oldlen = charcount_to_bytecount (XSTRING_DATA (s) + bytoff, 1); + Bytecount oldlen = charptr_emchar_len (XSTRING_DATA (s) + bytoff); Bytecount newlen = set_charptr_emchar (newstr, c); sledgehammer_check_ascii_begin (s); @@ -2126,7 +2115,7 @@ Bytecount j; for (j = (Bytecount) i + 1; j < XSTRING_LENGTH (s); j++) { - if (!BYTE_ASCII_P (XSTRING_DATA (s)[j])) + if (!byte_ascii_p (XSTRING_DATA (s)[j])) break; } XSET_STRING_ASCII_BEGIN (s, min (j, (Bytecount) MAX_STRING_ASCII_BEGIN)); @@ -2208,7 +2197,7 @@ for (i = 0; i < length; i++) { - if (!BYTE_ASCII_P (contents[i])) + if (!byte_ascii_p (contents[i])) break; } XSET_STRING_ASCII_BEGIN (string, min (i, MAX_STRING_ASCII_BEGIN)); @@ -2301,8 +2290,8 @@ set_lheader_implementation (&s->u.lheader, &lrecord_string); SET_C_READONLY_RECORD_HEADER (&s->u.lheader); s->plist = Qnil; - set_string_data (s, (Intbyte *) contents); - set_string_length (s, length); + set_lispstringp_data (s, (Intbyte *) contents); + set_lispstringp_length (s, length); val = wrap_string (s); init_string_ascii_begin (val); sledgehammer_check_ascii_begin (val); @@ -3279,7 +3268,7 @@ memmove (to_s_chars, from_s_chars, fullsize); /* Relocate FROM_S_CHARS's reference */ - set_string_data (string, &(to_s_chars->chars[0])); + set_lispstringp_data (string, &(to_s_chars->chars[0])); from_pos += fullsize; to_pos += fullsize; @@ -3311,11 +3300,11 @@ debug_string_purity_print (Lisp_Object p) { Charcount i; - Charcount s = XSTRING_CHAR_LENGTH (p); + Charcount s = string_char_length (p); stderr_out ("\""); for (i = 0; i < s; i++) { - Emchar ch = XSTRING_CHAR (p, i); + Emchar ch = string_emchar (p, i); if (ch < 32 || ch >= 126) stderr_out ("\\%03o", ch); else if (ch == '\\' || ch == '\"')
--- a/src/buffer.c Thu May 02 14:35:32 2002 +0000 +++ b/src/buffer.c Sun May 05 11:33:57 2002 +0000 @@ -236,6 +236,7 @@ mark_object (buf->extent_info); if (buf->text) mark_object (buf->text->line_number_cache); + mark_buffer_syntax_cache (buf); /* Don't mark normally through the children slot. (Actually, in this case, it doesn't matter.) */ @@ -258,7 +259,7 @@ printing_unreadable_object ("#<buffer %s>", XSTRING_DATA (b->name)); } else if (!BUFFER_LIVE_P (b)) - write_c_string ("#<killed buffer>", printcharfun); + write_c_string (printcharfun, "#<killed buffer>"); else if (escapeflag) write_fmt_string_lisp (printcharfun, "#<buffer %S>", 1, b->name); else @@ -558,7 +559,7 @@ b->last_window_start = 1; b->name = name; - if (XSTRING_BYTE (name, 0) != ' ') + if (string_byte (name, 0) != ' ') b->undo_list = Qnil; else b->undo_list = Qt; @@ -570,6 +571,7 @@ push_buffer_alist (name, buf); init_buffer_markers (b); + init_buffer_syntax_cache (b); b->generated_modeline_string = Fmake_string (make_int (84), make_int (' ')); b->modeline_extent_table = make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, @@ -1005,7 +1007,7 @@ buf = Fcdr (Fcar (tail)); if (EQ (buf, buffer)) continue; - if (XSTRING_BYTE (XBUFFER (buf)->name, 0) == ' ') + if (string_byte (XBUFFER (buf)->name, 0) == ' ') continue; /* If FRAME has a buffer_predicate, disregard buffers that don't fit the predicate. */ @@ -1243,7 +1245,9 @@ Freplace_buffer_in_windows (buf, Qnil, Qall); UNGCPRO; +#ifdef USE_C_FONT_LOCK font_lock_buffer_was_killed (b); +#endif /* Delete any auto-save file, if we saved it in this session. */ if (STRINGP (b->auto_save_file_name) @@ -1274,6 +1278,7 @@ } uninit_buffer_markers (b); + uninit_buffer_syntax_cache (b); kill_buffer_local_variables (b); @@ -1743,7 +1748,6 @@ #define ADD_BOOL(field) \ plist = cons3 (b->text->field ? Qt : Qnil, \ intern_converting_underscores_to_dashes (#field), plist) - ADD_BOOL (entirely_ascii_p); ADD_INT (bufz); ADD_INT (z); ADD_INT (mule_bufmin); @@ -1752,6 +1756,10 @@ ADD_INT (mule_bytmax); ADD_INT (mule_shifter); ADD_BOOL (mule_three_p); + ADD_BOOL (entirely_one_byte_p); + ADD_INT (num_ascii_chars); + ADD_INT (num_8_bit_fixed_chars); + ADD_INT (num_16_bit_fixed_chars); { Lisp_Object pos[16]; int i;
--- a/src/buffer.h Thu May 02 14:35:32 2002 +0000 +++ b/src/buffer.h Sun May 05 11:33:57 2002 +0000 @@ -103,7 +103,20 @@ Charbpos mule_charbpos_cache[16]; Bytebpos mule_bytebpos_cache[16]; - int entirely_ascii_p; + /* True if all chars fit into one byte; + == (format == FORMAT_8_BIT_FIXED || + (format == FORMAT_DEFAULT && num_ascii_chars == bufz - 1)) + kept around to speed up (slightly?) the byte-char conversion routines. */ + int entirely_one_byte_p; + /* Number of ASCII chars in buffer (0 - 127) */ + Charcount num_ascii_chars; + /* Number of chars in buffer that would fit in an 8-bit-fixed buffer. */ + Charcount num_8_bit_fixed_chars; + /* Number of chars in buffer that would fit in an 16-bit-fixed buffer. */ + Charcount num_16_bit_fixed_chars; + + /* Currently we only handle 8 bit fixed and default */ + Internal_Format format; #endif /* Similar to the above, we keep track of positions for which line @@ -178,9 +191,15 @@ object (done this way for ease in marking / finalizing). */ Lisp_Object extent_info; + /* The buffer's syntax cache. This caches a known region where the + `syntax-table' property is unchanged, for quick lookup in the routines + that scan a buffer looking for a particular syntax (regex routines, + parse-partial-sexp, etc.). */ + struct syntax_cache *syntax_cache; + /* ----------------------------------------------------------------- */ /* All the stuff above this line is the responsibility of insdel.c, - with some help from marker.c and extents.c. + with some help from marker.c, extents.c and syntax.c. All the stuff below this line is the responsibility of buffer.c. */ /* In an indirect buffer, this points to the base buffer. @@ -261,6 +280,12 @@ ) +/* All macros below follow the three golden rules of macros (see text.h), + with the following exception: + + -- 'struct buffer *' arguments can be evaluated more than once. +*/ + /*----------------------------------------------------------------------*/ /* Accessor macros for important positions in a buffer */ /*----------------------------------------------------------------------*/ @@ -272,288 +297,190 @@ the positions. */ /* Beginning of buffer. */ -#define BI_BUF_BEG(buf) ((Bytebpos) 1) +#define BYTE_BUF_BEG(buf) ((Bytebpos) 1) #define BUF_BEG(buf) ((Charbpos) 1) /* Beginning of accessible range of buffer. */ -#define BI_BUF_BEGV(buf) ((buf)->begv + 0) +#define BYTE_BUF_BEGV(buf) ((buf)->begv + 0) #define BUF_BEGV(buf) ((buf)->bufbegv + 0) /* End of accessible range of buffer. */ -#define BI_BUF_ZV(buf) ((buf)->zv + 0) +#define BYTE_BUF_ZV(buf) ((buf)->zv + 0) #define BUF_ZV(buf) ((buf)->bufzv + 0) /* End of buffer. */ -#define BI_BUF_Z(buf) ((buf)->text->z + 0) +#define BYTE_BUF_Z(buf) ((buf)->text->z + 0) #define BUF_Z(buf) ((buf)->text->bufz + 0) /* Point. */ -#define BI_BUF_PT(buf) ((buf)->pt + 0) +#define BYTE_BUF_PT(buf) ((buf)->pt + 0) #define BUF_PT(buf) ((buf)->bufpt + 0) +/* Internal format of buffer. */ +#ifdef MULE +#define BUF_FORMAT(buf) ((buf)->text->format) +#else +#define BUF_FORMAT(buf) FORMAT_DEFAULT +#endif + /*----------------------------------------------------------------------*/ -/* Converting between positions and addresses */ +/* Validating byte positions */ /*----------------------------------------------------------------------*/ -/* Convert the address of a byte in the buffer into a position. */ -INLINE_HEADER Bytebpos BI_BUF_PTR_BYTE_POS (struct buffer *buf, Intbyte *ptr); -INLINE_HEADER Bytebpos -BI_BUF_PTR_BYTE_POS (struct buffer *buf, Intbyte *ptr) -{ - return (ptr - buf->text->beg + 1 - - ((ptr - buf->text->beg + 1) > buf->text->gpt - ? buf->text->gap_size : (Bytebpos) 0)); -} - -#define BUF_PTR_BYTE_POS(buf, ptr) \ - bytebpos_to_charbpos (buf, BI_BUF_PTR_BYTE_POS (buf, ptr)) - -/* Address of byte at position POS in buffer. */ -INLINE_HEADER Intbyte * BI_BUF_BYTE_ADDRESS (struct buffer *buf, Bytebpos pos); -INLINE_HEADER Intbyte * -BI_BUF_BYTE_ADDRESS (struct buffer *buf, Bytebpos pos) +/* Address of byte at position POS in buffer, no error checking. */ +DECLARE_INLINE_HEADER ( +Intbyte * +BYTE_BUF_BYTE_ADDRESS_NO_VERIFY (struct buffer *buf, Bytebpos pos) +) { return (buf->text->beg + ((pos >= buf->text->gpt ? (pos + buf->text->gap_size) : pos) - 1)); } -#define BUF_BYTE_ADDRESS(buf, pos) \ - BI_BUF_BYTE_ADDRESS (buf, charbpos_to_bytebpos (buf, pos)) - -/* Address of byte before position POS in buffer. */ -INLINE_HEADER Intbyte * BI_BUF_BYTE_ADDRESS_BEFORE (struct buffer *buf, Bytebpos pos); -INLINE_HEADER Intbyte * -BI_BUF_BYTE_ADDRESS_BEFORE (struct buffer *buf, Bytebpos pos) -{ - return (buf->text->beg + - ((pos > buf->text->gpt ? (pos + buf->text->gap_size) : pos) - - 2)); -} - -#define BUF_BYTE_ADDRESS_BEFORE(buf, pos) \ - BI_BUF_BYTE_ADDRESS_BEFORE (buf, charbpos_to_bytebpos (buf, pos)) - -/*----------------------------------------------------------------------*/ -/* Converting between byte indices and memory indices */ -/*----------------------------------------------------------------------*/ - -INLINE_HEADER int valid_membpos_p (struct buffer *buf, Membpos x); -INLINE_HEADER int -valid_membpos_p (struct buffer *buf, Membpos x) +/* Given a byte position, does it point to the beginning of a character? +*/ +#ifdef MULE +DECLARE_INLINE_HEADER ( +int +VALID_BYTEBPOS_P (struct buffer *buf, Bytebpos x) +) { - return ((x >= 1 && x <= (Membpos) buf->text->gpt) || - (x > (Membpos) (buf->text->gpt + buf->text->gap_size) && - x <= (Membpos) (buf->text->z + buf->text->gap_size))); -} - -INLINE_HEADER Membpos bytebpos_to_membpos (struct buffer *buf, Bytebpos x); -INLINE_HEADER Membpos -bytebpos_to_membpos (struct buffer *buf, Bytebpos x) -{ - return (Membpos) ((x > buf->text->gpt) ? (x + buf->text->gap_size) : x); -} - - -INLINE_HEADER Bytebpos membpos_to_bytebpos (struct buffer *buf, Membpos x); -INLINE_HEADER Bytebpos -membpos_to_bytebpos (struct buffer *buf, Membpos x) -{ -#ifdef ERROR_CHECK_TEXT - assert (valid_membpos_p (buf, x)); -#endif - return (Bytebpos) ((x > (Membpos) buf->text->gpt) ? - x - buf->text->gap_size : - x); + switch (BUF_FORMAT (buf)) + { + case FORMAT_DEFAULT: + return intbyte_first_byte_p (*BYTE_BUF_BYTE_ADDRESS_NO_VERIFY (buf, x)); + case FORMAT_16_BIT_FIXED: + return ((x - 1) & 1) == 0; + case FORMAT_32_BIT_FIXED: + return ((x - 1) & 3) == 0; + default: + return 1; + } } - -#define membpos_to_charbpos(buf, x) \ - bytebpos_to_charbpos (buf, membpos_to_bytebpos (buf, x)) -#define charbpos_to_membpos(buf, x) \ - bytebpos_to_membpos (buf, charbpos_to_bytebpos (buf, x)) - -/* These macros generalize many standard buffer-position functions to - either a buffer or a string. */ - -/* Converting between Membposs and Bytebposs, for a buffer-or-string. - For strings, this is a no-op. For buffers, this resolves - to the standard membpos<->bytebpos converters. */ - -#define buffer_or_string_bytebpos_to_membpos(obj, ind) \ - (BUFFERP (obj) ? bytebpos_to_membpos (XBUFFER (obj), ind) : (Membpos) ind) - -#define buffer_or_string_membpos_to_bytebpos(obj, ind) \ - (BUFFERP (obj) ? membpos_to_bytebpos (XBUFFER (obj), ind) : (Bytebpos) ind) - -/* Converting between Charbpos's and Bytebposs, for a buffer-or-string. - For strings, this maps to the bytecount<->charcount converters. */ - -#define buffer_or_string_charbpos_to_bytebpos(obj, pos) \ - (BUFFERP (obj) ? charbpos_to_bytebpos (XBUFFER (obj), pos) : \ - (Bytebpos) string_index_char_to_byte (obj, pos)) - -#define buffer_or_string_bytebpos_to_charbpos(obj, ind) \ - (BUFFERP (obj) ? bytebpos_to_charbpos (XBUFFER (obj), ind) : \ - (Charbpos) string_index_byte_to_char (obj, ind)) - -/* Similar for Charbpos's and Membposs. */ - -#define buffer_or_string_charbpos_to_membpos(obj, pos) \ - (BUFFERP (obj) ? charbpos_to_membpos (XBUFFER (obj), pos) : \ - (Membpos) string_index_char_to_byte (obj, pos)) - -#define buffer_or_string_membpos_to_charbpos(obj, ind) \ - (BUFFERP (obj) ? membpos_to_charbpos (XBUFFER (obj), ind) : \ - (Charbpos) string_index_byte_to_char (obj, ind)) - -/************************************************************************/ -/* */ -/* working with buffer-level data */ -/* */ -/************************************************************************/ - -/* - - (A) Working with byte indices: - ------------------------------ - - VALID_BYTEBPOS_P(buf, bi): - Given a byte index, does it point to the beginning of a character? - - ASSERT_VALID_BYTEBPOS_UNSAFE(buf, bi): - If error-checking is enabled, assert that the given byte index - is within range and points to the beginning of a character - or to the end of the buffer. Otherwise, do nothing. - - ASSERT_VALID_BYTEBPOS_BACKWARD_UNSAFE(buf, bi): - If error-checking is enabled, assert that the given byte index - is within range and satisfies ASSERT_VALID_BYTEBPOS() and also - does not refer to the beginning of the buffer. (i.e. movement - backwards is OK.) Otherwise, do nothing. - - ASSERT_VALID_BYTEBPOS_FORWARD_UNSAFE(buf, bi): - If error-checking is enabled, assert that the given byte index - is within range and satisfies ASSERT_VALID_BYTEBPOS() and also - does not refer to the end of the buffer. (i.e. movement - forwards is OK.) Otherwise, do nothing. - - VALIDATE_BYTEBPOS_BACKWARD(buf, bi): - Make sure that the given byte index is pointing to the beginning - of a character. If not, back up until this is the case. Note - that there are not too many places where it is legitimate to do - this sort of thing. It's an error if you're passed an "invalid" - byte index. - - VALIDATE_BYTEBPOS_FORWARD(buf, bi): - Make sure that the given byte index is pointing to the beginning - of a character. If not, move forward until this is the case. - Note that there are not too many places where it is legitimate - to do this sort of thing. It's an error if you're passed an - "invalid" byte index. - - INC_BYTEBPOS(buf, bi): - Given a byte index (assumed to point at the beginning of a - character), modify that value so it points to the beginning - of the next character. - - DEC_BYTEBPOS(buf, bi): - Given a byte index (assumed to point at the beginning of a - character), modify that value so it points to the beginning - of the previous character. Unlike for DEC_CHARPTR(), we can - do all the assert()s because there are sentinels at the - beginning of the gap and the end of the buffer. - - BYTEBPOS_INVALID: - A constant representing an invalid Bytebpos. Valid Bytebposs - can never have this value. - - - (B) Converting between Charbpos's and Bytebposs: - -------------------------------------------- - - charbpos_to_bytebpos(buf, bu): - Given a Charbpos, return the equivalent Bytebpos. - - bytebpos_to_charbpos(buf, bi): - Given a Bytebpos, return the equivalent Charbpos. - - make_charbpos(buf, bi): - Given a Bytebpos, return the equivalent Charbpos as a Lisp Object. - */ - - -/*----------------------------------------------------------------------*/ -/* working with byte indices */ -/*----------------------------------------------------------------------*/ - -#ifdef MULE -# define VALID_BYTEBPOS_P(buf, x) \ - INTBYTE_FIRST_BYTE_P (*BI_BUF_BYTE_ADDRESS (buf, x)) #else # define VALID_BYTEBPOS_P(buf, x) 1 #endif -#ifdef ERROR_CHECK_TEXT - -# define ASSERT_VALID_BYTEBPOS_UNSAFE(buf, x) do { \ - assert (BUFFER_LIVE_P (buf)); \ - assert ((x) >= BI_BUF_BEG (buf) && x <= BI_BUF_Z (buf)); \ - assert (VALID_BYTEBPOS_P (buf, x)); \ +/* If error-checking is enabled, assert that the given char position is + within range. Otherwise, do nothing. +*/ +# define ASSERT_VALID_CHARBPOS_UNSAFE(buf, x) do { \ + text_checking_assert (BUFFER_LIVE_P (buf)); \ + text_checking_assert ((x) >= BUF_BEG (buf) && x <= BUF_Z (buf)); \ } while (0) -# define ASSERT_VALID_BYTEBPOS_BACKWARD_UNSAFE(buf, x) do { \ - assert (BUFFER_LIVE_P (buf)); \ - assert ((x) > BI_BUF_BEG (buf) && x <= BI_BUF_Z (buf)); \ - assert (VALID_BYTEBPOS_P (buf, x)); \ + +/* If error-checking is enabled, assert that the given byte position is + within range and points to the beginning of a character or to the end of + the buffer. Otherwise, do nothing. +*/ +# define ASSERT_VALID_BYTEBPOS_UNSAFE(buf, x) do { \ + text_checking_assert (BUFFER_LIVE_P (buf)); \ + text_checking_assert ((x) >= BYTE_BUF_BEG (buf) && x <= BYTE_BUF_Z (buf)); \ + text_checking_assert (VALID_BYTEBPOS_P (buf, x)); \ } while (0) -# define ASSERT_VALID_BYTEBPOS_FORWARD_UNSAFE(buf, x) do { \ - assert (BUFFER_LIVE_P (buf)); \ - assert ((x) >= BI_BUF_BEG (buf) && x < BI_BUF_Z (buf)); \ - assert (VALID_BYTEBPOS_P (buf, x)); \ + +/* If error-checking is enabled, assert that the given byte position is + within range and satisfies ASSERT_VALID_BYTEBPOS() and also does not + refer to the beginning of the buffer. (i.e. movement backwards is OK.) + Otherwise, do nothing. +*/ +# define ASSERT_VALID_BYTEBPOS_BACKWARD_UNSAFE(buf, x) do { \ + text_checking_assert (BUFFER_LIVE_P (buf)); \ + text_checking_assert ((x) > BYTE_BUF_BEG (buf) && x <= BYTE_BUF_Z (buf)); \ + text_checking_assert (VALID_BYTEBPOS_P (buf, x)); \ } while (0) -#else /* not ERROR_CHECK_TEXT */ -# define ASSERT_VALID_BYTEBPOS_UNSAFE(buf, x) -# define ASSERT_VALID_BYTEBPOS_BACKWARD_UNSAFE(buf, x) -# define ASSERT_VALID_BYTEBPOS_FORWARD_UNSAFE(buf, x) - -#endif /* not ERROR_CHECK_TEXT */ - -/* Note that, although the Mule version will work fine for non-Mule - as well (it should reduce down to nothing), we provide a separate - version to avoid compilation warnings and possible non-optimal - results with stupid compilers. */ +/* If error-checking is enabled, assert that the given byte position is + within range and satisfies ASSERT_VALID_BYTEBPOS() and also does not + refer to the end of the buffer. (i.e. movement forwards is OK.) + Otherwise, do nothing. +*/ +# define ASSERT_VALID_BYTEBPOS_FORWARD_UNSAFE(buf, x) do { \ + text_checking_assert (BUFFER_LIVE_P (buf)); \ + text_checking_assert ((x) >= BYTE_BUF_BEG (buf) && x < BYTE_BUF_Z (buf)); \ + text_checking_assert (VALID_BYTEBPOS_P (buf, x)); \ +} while (0) #ifdef MULE -# define VALIDATE_BYTEBPOS_BACKWARD(buf, x) do { \ - Intbyte *VBB_ptr = BI_BUF_BYTE_ADDRESS (buf, x); \ - while (!INTBYTE_FIRST_BYTE_P (*VBB_ptr)) \ - VBB_ptr--, (x)--; \ +/* Make sure that the given byte position is pointing to the beginning of a + character. If not, back up until this is the case. Note that there are + not too many places where it is legitimate to do this sort of thing. + It's an error if you're passed an "invalid" byte position. +*/ +# define VALIDATE_BYTEBPOS_BACKWARD(buf, x) do { \ + switch (BUF_FORMAT (buf)) \ + { \ + case FORMAT_DEFAULT: \ + { \ + Intbyte *VBB_ptr = BYTE_BUF_BYTE_ADDRESS_NO_VERIFY (buf, x); \ + while (!intbyte_first_byte_p (*VBB_ptr)) \ + VBB_ptr--, (x)--; \ + } \ + break; \ + case FORMAT_16_BIT_FIXED: \ + if (((x - 1) & 1) != 0) \ + x--; \ + break; \ + case FORMAT_32_BIT_FIXED: \ + while (((x - 1) & 3) != 0) \ + x--; \ + break; \ + default: \ + break; \ + } \ } while (0) #else # define VALIDATE_BYTEBPOS_BACKWARD(buf, x) #endif -/* Note that, although the Mule version will work fine for non-Mule - as well (it should reduce down to nothing), we provide a separate - version to avoid compilation warnings and possible non-optimal - results with stupid compilers. */ - #ifdef MULE -# define VALIDATE_BYTEBPOS_FORWARD(buf, x) do { \ - Intbyte *VBF_ptr = BI_BUF_BYTE_ADDRESS (buf, x); \ - while (!INTBYTE_FIRST_BYTE_P (*VBF_ptr)) \ - VBF_ptr++, (x)++; \ +/* Make sure that the given byte position is pointing to the beginning of a + character. If not, move forward until this is the case. Note that + there are not too many places where it is legitimate to do this sort of + thing. It's an error if you're passed an "invalid" byte position. +*/ +# define VALIDATE_BYTEBPOS_FORWARD(buf, x) do { \ + switch (BUF_FORMAT (buf)) \ + { \ + case FORMAT_DEFAULT: \ + { \ + Intbyte *VBF_ptr = BYTE_BUF_BYTE_ADDRESS_NO_VERIFY (buf, x); \ + while (!intbyte_first_byte_p (*VBF_ptr)) \ + VBF_ptr++, (x)++; \ + } \ + break; \ + case FORMAT_16_BIT_FIXED: \ + if (((x - 1) & 1) != 0) \ + x++; \ + break; \ + case FORMAT_32_BIT_FIXED: \ + while (((x - 1) & 3) != 0) \ + x++; \ + break; \ + default: \ + break; \ + } \ } while (0) #else # define VALIDATE_BYTEBPOS_FORWARD(buf, x) #endif -/* Note that in the simplest case (no MULE, no ERROR_CHECK_TEXT), - this crap reduces down to simply (x)++. */ +/*----------------------------------------------------------------------*/ +/* Working with byte positions */ +/*----------------------------------------------------------------------*/ + + +/* Given a byte position (assumed to point at the beginning of a + character), modify that value so it points to the beginning of the next + character. + + Note that in the simplest case (no MULE, no ERROR_CHECK_TEXT), + this crap reduces down to simply (x)++. */ #define INC_BYTEBPOS(buf, x) do \ { \ - ASSERT_VALID_BYTEBPOS_FORWARD_UNSAFE (buf, x); \ + ASSERT_VALID_BYTEBPOS_FORWARD_UNSAFE (buf, x); \ /* Note that we do the increment first to \ make sure that the pointer in \ VALIDATE_BYTEBPOS_FORWARD() ends up on \ @@ -562,8 +489,14 @@ VALIDATE_BYTEBPOS_FORWARD (buf, x); \ } while (0) -/* Note that in the simplest case (no MULE, no ERROR_CHECK_TEXT), - this crap reduces down to simply (x)--. */ +/* Given a byte position (assumed to point at the beginning of a + character), modify that value so it points to the beginning of the + previous character. Unlike for DEC_CHARPTR(), we can do all the + assert()s because there are sentinels at the beginning of the gap and + the end of the buffer. + + Note that in the simplest case (no MULE, no ERROR_CHECK_TEXT), this + crap reduces down to simply (x)--. */ #define DEC_BYTEBPOS(buf, x) do \ { \ @@ -576,33 +509,35 @@ VALIDATE_BYTEBPOS_BACKWARD (buf, x); \ } while (0) -INLINE_HEADER Bytebpos prev_bytebpos (struct buffer *buf, Bytebpos x); -INLINE_HEADER Bytebpos +DECLARE_INLINE_HEADER ( +Bytebpos prev_bytebpos (struct buffer *buf, Bytebpos x) +) { DEC_BYTEBPOS (buf, x); return x; } -INLINE_HEADER Bytebpos next_bytebpos (struct buffer *buf, Bytebpos x); -INLINE_HEADER Bytebpos +DECLARE_INLINE_HEADER ( +Bytebpos next_bytebpos (struct buffer *buf, Bytebpos x) +) { INC_BYTEBPOS (buf, x); return x; } +/* A constant representing an invalid Bytebpos. Valid Bytebposes + can never have this value. */ + #define BYTEBPOS_INVALID ((Bytebpos) -1) /*----------------------------------------------------------------------*/ -/* Converting between buffer positions and byte indices */ +/* Converting between byte and character positions */ /*----------------------------------------------------------------------*/ #ifdef MULE -Bytebpos charbpos_to_bytebpos_func (struct buffer *buf, Charbpos x); -Charbpos bytebpos_to_charbpos_func (struct buffer *buf, Bytebpos x); - /* The basic algorithm we use is to keep track of a known region of characters in each buffer, all of which are of the same width. We keep track of the boundaries of the region in both Charbpos and Bytebpos @@ -665,77 +600,303 @@ worth seeing if anything can be gleaned. */ +Bytebpos charbpos_to_bytebpos_func (struct buffer *buf, Charbpos x); +Charbpos bytebpos_to_charbpos_func (struct buffer *buf, Bytebpos x); extern short three_to_one_table[]; -INLINE_HEADER Bytebpos real_charbpos_to_bytebpos (struct buffer *buf, Charbpos x); -INLINE_HEADER Bytebpos -real_charbpos_to_bytebpos (struct buffer *buf, Charbpos x) +#endif /* MULE */ + +/* Given a Charbpos, return the equivalent Bytebpos. */ + +DECLARE_INLINE_HEADER ( +Bytebpos +charbpos_to_bytebpos (struct buffer *buf, Charbpos x) +) { - if (buf->text->entirely_ascii_p) - return (Bytebpos) x; - if (x >= buf->text->mule_bufmin && x <= buf->text->mule_bufmax) - return (buf->text->mule_bytmin + + Bytebpos retval; + ASSERT_VALID_CHARBPOS_UNSAFE (buf, x); +#ifdef MULE + if (buf->text->entirely_one_byte_p) + retval = (Bytebpos) x; + else if (BUF_FORMAT (buf) == FORMAT_16_BIT_FIXED) + retval = (Bytebpos) (x << 1); + else if (BUF_FORMAT (buf) == FORMAT_32_BIT_FIXED) + retval = (Bytebpos) (x << 2); + else if (x >= buf->text->mule_bufmin && x <= buf->text->mule_bufmax) + retval = (buf->text->mule_bytmin + ((x - buf->text->mule_bufmin) << buf->text->mule_shifter) + (buf->text->mule_three_p ? (x - buf->text->mule_bufmin) : (Bytebpos) 0)); else - return charbpos_to_bytebpos_func (buf, x); + retval = charbpos_to_bytebpos_func (buf, x); +#else + retval = (Bytebpos) x; +#endif + ASSERT_VALID_BYTEBPOS_UNSAFE (buf, retval); + return retval; +} + +/* Given a Bytebpos, return the equivalent Charbpos. */ + +DECLARE_INLINE_HEADER ( +Charbpos +bytebpos_to_charbpos (struct buffer *buf, Bytebpos x) +) +{ + Charbpos retval; + ASSERT_VALID_BYTEBPOS_UNSAFE (buf, x); +#ifdef MULE + if (buf->text->entirely_one_byte_p) + retval = (Charbpos) x; + else if (BUF_FORMAT (buf) == FORMAT_16_BIT_FIXED) + retval = (Charbpos) (x >> 1); + else if (BUF_FORMAT (buf) == FORMAT_32_BIT_FIXED) + retval = (Charbpos) (x >> 2); + else if (x >= buf->text->mule_bytmin && x <= buf->text->mule_bytmax) + retval = (buf->text->mule_bufmin + + ((buf->text->mule_three_p + ? three_to_one_table[x - buf->text->mule_bytmin] + : (x - buf->text->mule_bytmin) >> buf->text->mule_shifter))); + else + retval = bytebpos_to_charbpos_func (buf, x); +#else + retval = (Charbpos) x; +#endif + ASSERT_VALID_CHARBPOS_UNSAFE (buf, retval); + return retval; +} + +/* Given a Bytebpos, return the equivalent Charbpos as a Lisp Object. */ + +#define make_charbpos(buf, ind) make_int (bytebpos_to_charbpos (buf, ind)) + +/*----------------------------------------------------------------------*/ +/* Converting between byte and memory positions */ +/*----------------------------------------------------------------------*/ + +DECLARE_INLINE_HEADER ( +int +valid_membpos_p (struct buffer *buf, Membpos x) +) +{ + return ((x >= 1 && x <= (Membpos) buf->text->gpt) || + (x > (Membpos) (buf->text->gpt + buf->text->gap_size) && + x <= (Membpos) (buf->text->z + buf->text->gap_size))); } -INLINE_HEADER Charbpos real_bytebpos_to_charbpos (struct buffer *buf, Bytebpos x); -INLINE_HEADER Charbpos -real_bytebpos_to_charbpos (struct buffer *buf, Bytebpos x) +DECLARE_INLINE_HEADER ( +Membpos +bytebpos_to_membpos (struct buffer *buf, Bytebpos x) +) +{ + ASSERT_VALID_BYTEBPOS_UNSAFE (buf, x); + return (Membpos) ((x > buf->text->gpt) ? (x + buf->text->gap_size) : x); +} + + +DECLARE_INLINE_HEADER ( +Bytebpos +membpos_to_bytebpos (struct buffer *buf, Membpos x) +) +{ + Bytebpos retval; + text_checking_assert (valid_membpos_p (buf, x)); + retval = (Bytebpos) ((x > (Membpos) buf->text->gpt) ? + x - buf->text->gap_size : + x); + ASSERT_VALID_BYTEBPOS_UNSAFE (buf, retval); + return retval; +} + +DECLARE_INLINE_HEADER ( +Charbpos +membpos_to_charbpos (struct buffer *buf, Membpos x) +) { - if (buf->text->entirely_ascii_p) - return (Charbpos) x; - if (x >= buf->text->mule_bytmin && x <= buf->text->mule_bytmax) - return (buf->text->mule_bufmin + - ((buf->text->mule_three_p - ? three_to_one_table[x - buf->text->mule_bytmin] - : (x - buf->text->mule_bytmin) >> buf->text->mule_shifter))); - else - return bytebpos_to_charbpos_func (buf, x); + return bytebpos_to_charbpos (buf, membpos_to_bytebpos (buf, x)); +} + +DECLARE_INLINE_HEADER ( +Membpos +charbpos_to_membpos (struct buffer *buf, Charbpos x) +) +{ + return bytebpos_to_membpos (buf, charbpos_to_bytebpos (buf, x)); +} + +/*----------------------------------------------------------------------*/ +/* Generalized buffer/string position convertors */ +/*----------------------------------------------------------------------*/ + +/* These macros generalize many standard buffer-position functions to + either a buffer or a string. */ + +/* Converting between Memxpos's and Bytexpos's, for a buffer-or-string. + For strings, this is a no-op. For buffers, this resolves + to the standard membpos<->bytebpos converters. */ + +DECLARE_INLINE_HEADER ( +Memxpos buffer_or_string_bytexpos_to_memxpos (Lisp_Object obj, Bytexpos pos) +) +{ + return (BUFFERP (obj) ? bytebpos_to_membpos (XBUFFER (obj), pos) : + (Memxpos) pos); } -#else /* not MULE */ +DECLARE_INLINE_HEADER ( +Bytexpos buffer_or_string_memxpos_to_bytexpos (Lisp_Object obj, Memxpos pos) +) +{ + return (BUFFERP (obj) ? membpos_to_bytebpos (XBUFFER (obj), pos) : + (Bytexpos) pos); +} + +/* Converting between Charxpos's and Bytexpos's, for a buffer-or-string. + For strings, this maps to the bytecount<->charcount converters. */ + +DECLARE_INLINE_HEADER ( +Bytexpos buffer_or_string_charxpos_to_bytexpos (Lisp_Object obj, Charxpos pos) +) +{ + return (BUFFERP (obj) ? charbpos_to_bytebpos (XBUFFER (obj), pos) : + (Bytexpos) string_index_char_to_byte (obj, pos)); +} + +DECLARE_INLINE_HEADER ( +Charxpos buffer_or_string_bytexpos_to_charxpos (Lisp_Object obj, Bytexpos pos) +) +{ + return (BUFFERP (obj) ? bytebpos_to_charbpos (XBUFFER (obj), pos) : + (Charxpos) string_index_byte_to_char (obj, pos)); +} -# define real_charbpos_to_bytebpos(buf, x) ((Bytebpos) x) -# define real_bytebpos_to_charbpos(buf, x) ((Charbpos) x) +/* Similar for Charxpos's and Memxpos's. */ + +DECLARE_INLINE_HEADER ( +Memxpos buffer_or_string_charxpos_to_memxpos (Lisp_Object obj, Charxpos pos) +) +{ + return (BUFFERP (obj) ? charbpos_to_membpos (XBUFFER (obj), pos) : + (Memxpos) string_index_char_to_byte (obj, pos)); +} -#endif /* not MULE */ +DECLARE_INLINE_HEADER ( +Charxpos buffer_or_string_memxpos_to_charxpos (Lisp_Object obj, Memxpos pos) +) +{ + return (BUFFERP (obj) ? membpos_to_charbpos (XBUFFER (obj), pos) : + (Charxpos) string_index_byte_to_char (obj, pos)); +} -#ifdef ERROR_CHECK_TEXT +DECLARE_INLINE_HEADER ( +Internal_Format buffer_or_other_internal_format (Lisp_Object obj) +) +{ + return BUFFERP (obj) ? BUF_FORMAT (XBUFFER (obj)) : FORMAT_DEFAULT; +} + +/* Return the index to the character before the one at X, + in a buffer or string. */ -Bytebpos charbpos_to_bytebpos (struct buffer *buf, Charbpos x); -Charbpos bytebpos_to_charbpos (struct buffer *buf, Bytebpos x); +DECLARE_INLINE_HEADER ( +Bytebpos +prev_bytexpos (Lisp_Object obj, Bytebpos x) +) +{ + return BUFFERP (obj) ? prev_bytebpos (XBUFFER (obj), x) : + prev_string_index (obj, x); +} + +/* Return the index to the character after the one at X, + in a buffer or string. */ -#else /* not ERROR_CHECK_TEXT */ +DECLARE_INLINE_HEADER ( +Bytebpos +next_bytexpos (Lisp_Object obj, Bytebpos x) +) +{ + return BUFFERP (obj) ? next_bytebpos (XBUFFER (obj), x) : + next_string_index (obj, x); +} + +/*----------------------------------------------------------------------*/ +/* Converting between positions and addresses */ +/*----------------------------------------------------------------------*/ -#define charbpos_to_bytebpos real_charbpos_to_bytebpos -#define bytebpos_to_charbpos real_bytebpos_to_charbpos +/* Convert the address of a byte in the buffer into a position. */ +DECLARE_INLINE_HEADER ( +Bytebpos +BYTE_BUF_PTR_BYTE_POS (struct buffer *buf, Intbyte *ptr) +) +{ + Bytebpos retval = (ptr - buf->text->beg + 1 + - ((ptr - buf->text->beg + 1) > buf->text->gpt + ? buf->text->gap_size : (Bytebpos) 0)); + ASSERT_VALID_BYTEBPOS_UNSAFE (buf, retval); + return retval; +} + +#define BUF_PTR_BYTE_POS(buf, ptr) \ + bytebpos_to_charbpos (buf, BYTE_BUF_PTR_BYTE_POS (buf, ptr)) -#endif /* not ERROR_CHECK_TEXT */ +/* Address of byte at position POS in buffer. */ +DECLARE_INLINE_HEADER ( +Intbyte * +BYTE_BUF_BYTE_ADDRESS (struct buffer *buf, Bytebpos pos) +) +{ + ASSERT_VALID_BYTEBPOS_UNSAFE (buf, pos); + return BYTE_BUF_BYTE_ADDRESS_NO_VERIFY (buf, pos); +} + +#define BUF_BYTE_ADDRESS(buf, pos) \ + BYTE_BUF_BYTE_ADDRESS (buf, charbpos_to_bytebpos (buf, pos)) -#define make_charbpos(buf, ind) make_int (bytebpos_to_charbpos (buf, ind)) +/* Address of byte before position POS in buffer. */ +DECLARE_INLINE_HEADER ( +Intbyte * +BYTE_BUF_BYTE_ADDRESS_BEFORE (struct buffer *buf, Bytebpos pos) +) +{ + ASSERT_VALID_BYTEBPOS_UNSAFE (buf, pos); + return (buf->text->beg + + ((pos > buf->text->gpt ? (pos + buf->text->gap_size) : pos) + - 2)); +} + +#define BUF_BYTE_ADDRESS_BEFORE(buf, pos) \ + BYTE_BUF_BYTE_ADDRESS_BEFORE (buf, charbpos_to_bytebpos (buf, pos)) /*----------------------------------------------------------------------*/ /* Converting between buffer bytes and Emacs characters */ /*----------------------------------------------------------------------*/ /* The character at position POS in buffer. */ -#define BI_BUF_FETCH_CHAR(buf, pos) \ - charptr_emchar (BI_BUF_BYTE_ADDRESS (buf, pos)) + +#define BYTE_BUF_FETCH_CHAR(buf, pos) \ + charptr_emchar_fmt (BYTE_BUF_BYTE_ADDRESS (buf, pos), BUF_FORMAT (buf), \ + wrap_buffer (buf)) #define BUF_FETCH_CHAR(buf, pos) \ - BI_BUF_FETCH_CHAR (buf, charbpos_to_bytebpos (buf, pos)) + BYTE_BUF_FETCH_CHAR (buf, charbpos_to_bytebpos (buf, pos)) + +/* The "raw value" of the character at position POS in buffer. + See emchar_to_raw(). */ + +#define BYTE_BUF_FETCH_CHAR_RAW(buf, pos) \ + charptr_emchar_raw_fmt (BYTE_BUF_BYTE_ADDRESS (buf, pos), BUF_FORMAT (buf)) +#define BUF_FETCH_CHAR_RAW(buf, pos) \ + BYTE_BUF_FETCH_CHAR_RAW (buf, charbpos_to_bytebpos (buf, pos)) /* The character at position POS in buffer, as a string. This is equivalent to set_charptr_emchar (str, BUF_FETCH_CHAR (buf, pos)) but is faster for Mule. */ -# define BI_BUF_CHARPTR_COPY_CHAR(buf, pos, str) \ - charptr_copy_char (BI_BUF_BYTE_ADDRESS (buf, pos), str) -#define BUF_CHARPTR_COPY_CHAR(buf, pos, str) \ - BI_BUF_CHARPTR_COPY_CHAR (buf, charbpos_to_bytebpos (buf, pos), str) +# define BYTE_BUF_CHARPTR_COPY_EMCHAR(buf, pos, str) \ + (BUF_FORMAT (buf) == FORMAT_DEFAULT ? \ + charptr_copy_emchar (BYTE_BUF_BYTE_ADDRESS (buf, pos), str) : \ + set_charptr_emchar (str, BYTE_BUF_FETCH_CHAR (buf, pos))) +#define BUF_CHARPTR_COPY_EMCHAR(buf, pos, str) \ + BYTE_BUF_CHARPTR_COPY_EMCHAR (buf, charbpos_to_bytebpos (buf, pos), str) /************************************************************************/ @@ -749,18 +910,18 @@ /*----------------------------------------------------------------------*/ /* Set beginning of accessible range of buffer. */ -#define SET_BOTH_BUF_BEGV(buf, val, bival) \ +#define SET_BOTH_BUF_BEGV(buf, val, bpval) \ do \ { \ - (buf)->begv = (bival); \ + (buf)->begv = (bpval); \ (buf)->bufbegv = (val); \ } while (0) /* Set end of accessible range of buffer. */ -#define SET_BOTH_BUF_ZV(buf, val, bival) \ +#define SET_BOTH_BUF_ZV(buf, val, bpval) \ do \ { \ - (buf)->zv = (bival); \ + (buf)->zv = (bpval); \ (buf)->bufzv = (val); \ } while (0) @@ -770,11 +931,20 @@ specified. However, point is set in lots and lots of places. So we provide the ability to specify both (for efficiency) or just one. */ -#define BOTH_BUF_SET_PT(buf, val, bival) set_buffer_point (buf, val, bival) -#define BI_BUF_SET_PT(buf, bival) \ - BOTH_BUF_SET_PT (buf, bytebpos_to_charbpos (buf, bival), bival) -#define BUF_SET_PT(buf, value) \ - BOTH_BUF_SET_PT (buf, value, charbpos_to_bytebpos (buf, value)) +#define BOTH_BUF_SET_PT(buf, val, bpval) set_buffer_point (buf, val, bpval) +#define BYTE_BUF_SET_PT(buf, bpval) \ +do \ +{ \ + Bytebpos __bpbsp_bpval = (bpval); \ + BOTH_BUF_SET_PT (buf, bytebpos_to_charbpos (buf, __bpbsp_bpval), \ + __bpbsp_bpval); \ +} while (0) +#define BUF_SET_PT(buf, value) \ +do \ +{ \ + Bytebpos __bsp_val = (value); \ + BOTH_BUF_SET_PT (buf, __bsp_val, charbpos_to_bytebpos (buf, __bsp_val)); \ +} while (0) #if 0 /* FSFmacs */ @@ -793,38 +963,72 @@ /* Is this buffer narrowed? */ #define BUF_NARROWED(buf) \ - ((BI_BUF_BEGV (buf) != BI_BUF_BEG (buf)) || \ - (BI_BUF_ZV (buf) != BI_BUF_Z (buf))) + ((BYTE_BUF_BEGV (buf) != BYTE_BUF_BEG (buf)) || \ + (BYTE_BUF_ZV (buf) != BYTE_BUF_Z (buf))) -/* Modification count. */ +/* Modification count */ #define BUF_MODIFF(buf) ((buf)->text->modiff) -/* Saved modification count. */ +/* Saved modification count */ #define BUF_SAVE_MODIFF(buf) ((buf)->text->save_modiff) /* Face changed. */ #define BUF_FACECHANGE(buf) ((buf)->face_change) -#define POINT_MARKER_P(marker) \ - (XMARKER (marker)->buffer != 0 && \ - EQ (marker, XMARKER (marker)->buffer->point_marker)) +DECLARE_INLINE_HEADER ( +int +POINT_MARKER_P (Lisp_Object marker) +) +{ + return (XMARKER (marker)->buffer != 0 && + EQ (marker, XMARKER (marker)->buffer->point_marker)); +} #define BUF_MARKERS(buf) ((buf)->markers) +#ifdef MULE + +DECLARE_INLINE_HEADER ( +Lisp_Object +BUFFER_CATEGORY_TABLE (struct buffer *buf) +) +{ + return buf ? buf->category_table : Vstandard_category_table; +} + +#endif /* MULE */ + +DECLARE_INLINE_HEADER ( +Lisp_Object +BUFFER_SYNTAX_TABLE (struct buffer *buf) +) +{ + return buf ? buf->syntax_table : Vstandard_syntax_table; +} + +DECLARE_INLINE_HEADER ( +Lisp_Object +BUFFER_MIRROR_SYNTAX_TABLE (struct buffer *buf) +) +{ + return buf ? buf->mirror_syntax_table : + XCHAR_TABLE (Vstandard_syntax_table)->mirror_table; +} + /* WARNING: The new definitions of CEILING_OF() and FLOOR_OF() differ semantically from the old ones (in FSF Emacs and XEmacs 19.11 and before). Conversion is as follows: - OLD_BI_CEILING_OF(n) = NEW_BI_CEILING_OF(n) - 1 - OLD_BI_FLOOR_OF(n) = NEW_BI_FLOOR_OF(n + 1) + OLD_BYTE_CEILING_OF(n) = NEW_BYTE_CEILING_OF(n) - 1 + OLD_BYTE_FLOOR_OF(n) = NEW_BYTE_FLOOR_OF(n + 1) The definitions were changed because the new definitions are more consistent with the way everything else works in XEmacs. */ -/* Properties of CEILING_OF and FLOOR_OF (also apply to BI_ variants): +/* Properties of CEILING_OF and FLOOR_OF (also apply to BYTE_ variants): 1) FLOOR_OF (CEILING_OF (n)) = n CEILING_OF (FLOOR_OF (n)) = n @@ -853,11 +1057,9 @@ while (pos < to) { - Bytebpos ceil; - - ceil = BI_BUF_CEILING_OF (buf, pos); + Bytebpos ceil = BYTE_BUF_CEILING_OF (buf, pos); ceil = min (to, ceil); - process_intbyte_string (BI_BUF_BYTE_ADDRESS (buf, pos), ceil - pos); + process_intbyte_string (BYTE_BUF_BYTE_ADDRESS (buf, pos), ceil - pos); pos = ceil; } } @@ -868,40 +1070,64 @@ */ -/* Return the maximum index in the buffer it is safe to scan forwards +/* Return the maximum position in the buffer it is safe to scan forwards past N to. This is used to prevent buffer scans from running into the gap (e.g. search.c). All characters between N and CEILING_OF(N) are located contiguous in memory. Note that the character *at* CEILING_OF(N) is not contiguous in memory. */ -#define BI_BUF_CEILING_OF(b, n) \ - ((n) < (b)->text->gpt && (b)->text->gpt < BI_BUF_ZV (b) ? \ - (b)->text->gpt : BI_BUF_ZV (b)) +#define BYTE_BUF_CEILING_OF(b, n) \ + ((n) < (b)->text->gpt && (b)->text->gpt < BYTE_BUF_ZV (b) ? \ + (b)->text->gpt : BYTE_BUF_ZV (b)) #define BUF_CEILING_OF(b, n) \ - bytebpos_to_charbpos (b, BI_BUF_CEILING_OF (b, charbpos_to_bytebpos (b, n))) + bytebpos_to_charbpos (b, BYTE_BUF_CEILING_OF (b, charbpos_to_bytebpos (b, n))) -/* Return the minimum index in the buffer it is safe to scan backwards +/* Return the minimum position in the buffer it is safe to scan backwards past N to. All characters between FLOOR_OF(N) and N are located contiguous in memory. Note that the character *at* N may not be contiguous in memory. */ -#define BI_BUF_FLOOR_OF(b, n) \ - (BI_BUF_BEGV (b) < (b)->text->gpt && (b)->text->gpt < (n) ? \ - (b)->text->gpt : BI_BUF_BEGV (b)) +#define BYTE_BUF_FLOOR_OF(b, n) \ + (BYTE_BUF_BEGV (b) < (b)->text->gpt && (b)->text->gpt < (n) ? \ + (b)->text->gpt : BYTE_BUF_BEGV (b)) #define BUF_FLOOR_OF(b, n) \ - bytebpos_to_charbpos (b, BI_BUF_FLOOR_OF (b, charbpos_to_bytebpos (b, n))) + bytebpos_to_charbpos (b, BYTE_BUF_FLOOR_OF (b, charbpos_to_bytebpos (b, n))) -#define BI_BUF_CEILING_OF_IGNORE_ACCESSIBLE(b, n) \ - ((n) < (b)->text->gpt && (b)->text->gpt < BI_BUF_Z (b) ? \ - (b)->text->gpt : BI_BUF_Z (b)) +#define BYTE_BUF_CEILING_OF_IGNORE_ACCESSIBLE(b, n) \ + ((n) < (b)->text->gpt && (b)->text->gpt < BYTE_BUF_Z (b) ? \ + (b)->text->gpt : BYTE_BUF_Z (b)) #define BUF_CEILING_OF_IGNORE_ACCESSIBLE(b, n) \ bytebpos_to_charbpos \ - (b, BI_BUF_CEILING_OF_IGNORE_ACCESSIBLE (b, charbpos_to_bytebpos (b, n))) + (b, BYTE_BUF_CEILING_OF_IGNORE_ACCESSIBLE (b, charbpos_to_bytebpos (b, n))) -#define BI_BUF_FLOOR_OF_IGNORE_ACCESSIBLE(b, n) \ - (BI_BUF_BEG (b) < (b)->text->gpt && (b)->text->gpt < (n) ? \ - (b)->text->gpt : BI_BUF_BEG (b)) +#define BYTE_BUF_FLOOR_OF_IGNORE_ACCESSIBLE(b, n) \ + (BYTE_BUF_BEG (b) < (b)->text->gpt && (b)->text->gpt < (n) ? \ + (b)->text->gpt : BYTE_BUF_BEG (b)) #define BUF_FLOOR_OF_IGNORE_ACCESSIBLE(b, n) \ bytebpos_to_charbpos \ - (b, BI_BUF_FLOOR_OF_IGNORE_ACCESSIBLE (b, charbpos_to_bytebpos (b, n))) + (b, BYTE_BUF_FLOOR_OF_IGNORE_ACCESSIBLE (b, charbpos_to_bytebpos (b, n))) + +/* Iterate over contiguous chunks of text in buffer BUF, starting at POS, + of length LEN. Evaluates POS and LEN only once, but BUF multiply. In + each iteration, store the current chunk into RUNPTR/RUNLEN, which will + be automatically declared (don't declare them yourself). This does not + respect the limits of accessibility (BUF_BEGV/BUF_ZV); if you want these + limits respected, you need to impose them yourself. + + NOTE: This must be surrounded with braces! */ + +#define BUFFER_TEXT_LOOP(buf, pos, len, runptr, runlen) \ +Intbyte *runptr; \ +Bytecount runlen; \ +Bytebpos BTL_pos = (pos); \ +Bytebpos BTL_len = (len); \ +for (runptr = BYTE_BUF_BYTE_ADDRESS (buf, BTL_pos), \ + runlen = BYTE_BUF_CEILING_OF_IGNORE_ACCESSIBLE (buf, BTL_pos) - BTL_pos, \ + runlen = min (BTL_len, runlen); \ + BTL_len > 0; \ + BTL_pos += runlen, \ + BTL_len -= runlen, \ + runptr = BYTE_BUF_BYTE_ADDRESS (buf, BTL_pos), \ + runlen = BYTE_BUF_CEILING_OF_IGNORE_ACCESSIBLE (buf, BTL_pos) - BTL_pos, \ + runlen = min (BTL_len, runlen)) /* This structure marks which slots in a buffer have corresponding default values in Vbuffer_defaults. @@ -952,12 +1178,7 @@ /************************************************************************/ /* A "trt" table is a mapping from characters to other characters, - typically used to convert between uppercase and lowercase. For - compatibility reasons, trt tables are currently in the form of - a Lisp string of 256 characters, specifying the conversion for each - of the first 256 Emacs characters (i.e. the 256 Latin-1 characters). - This should be generalized at some point to support conversions for - all of the allowable Mule characters. + typically used to convert between uppercase and lowercase. */ /* The _1 macros are named as such because they assume that you have @@ -965,30 +1186,25 @@ 0 - 255. Bad lossage will happen otherwise. */ #define MAKE_TRT_TABLE() Fmake_char_table (Qgeneric) -INLINE_HEADER Emchar TRT_TABLE_CHAR_1 (Lisp_Object table, Emchar c); -INLINE_HEADER Emchar -TRT_TABLE_CHAR_1 (Lisp_Object table, Emchar ch) +DECLARE_INLINE_HEADER ( +Emchar +TRT_TABLE_OF (Lisp_Object table, Emchar ch) +) { Lisp_Object TRT_char; - TRT_char = get_char_table (ch, XCHAR_TABLE (table)); + TRT_char = get_char_table (ch, table); if (NILP (TRT_char)) return ch; else return XCHAR (TRT_char); } -#define SET_TRT_TABLE_CHAR_1(table, ch1, ch2) \ - Fput_char_table (make_char (ch1), make_char (ch2), table); +#define SET_TRT_TABLE_OF(table, ch1, ch2) \ + Fput_char_table (make_char (ch1), make_char (ch2), table) -INLINE_HEADER Emchar TRT_TABLE_OF (Lisp_Object trt, Emchar c); -INLINE_HEADER Emchar -TRT_TABLE_OF (Lisp_Object trt, Emchar c) -{ - return TRT_TABLE_CHAR_1 (trt, c); -} - -INLINE_HEADER Lisp_Object BUFFER_CASE_TABLE (struct buffer *buf); -INLINE_HEADER Lisp_Object +DECLARE_INLINE_HEADER ( +Lisp_Object BUFFER_CASE_TABLE (struct buffer *buf) +) { return buf ? buf->case_table : Vstandard_case_table; } @@ -1001,18 +1217,20 @@ /* 1 if CH is upper case. */ -INLINE_HEADER int UPPERCASEP (struct buffer *buf, Emchar ch); -INLINE_HEADER int +DECLARE_INLINE_HEADER ( +int UPPERCASEP (struct buffer *buf, Emchar ch) +) { return DOWNCASE_TABLE_OF (buf, ch) != ch; } /* 1 if CH is lower case. */ -INLINE_HEADER int LOWERCASEP (struct buffer *buf, Emchar ch); -INLINE_HEADER int +DECLARE_INLINE_HEADER ( +int LOWERCASEP (struct buffer *buf, Emchar ch) +) { return (UPCASE_TABLE_OF (buf, ch) != ch && DOWNCASE_TABLE_OF (buf, ch) == ch); @@ -1020,18 +1238,20 @@ /* 1 if CH is neither upper nor lower case. */ -INLINE_HEADER int NOCASEP (struct buffer *buf, Emchar ch); -INLINE_HEADER int +DECLARE_INLINE_HEADER ( +int NOCASEP (struct buffer *buf, Emchar ch) +) { return UPCASE_TABLE_OF (buf, ch) == ch; } /* Upcase a character, or make no change if that cannot be done. */ -INLINE_HEADER Emchar UPCASE (struct buffer *buf, Emchar ch); -INLINE_HEADER Emchar +DECLARE_INLINE_HEADER ( +Emchar UPCASE (struct buffer *buf, Emchar ch) +) { return (DOWNCASE_TABLE_OF (buf, ch) == ch) ? UPCASE_TABLE_OF (buf, ch) : ch; }
--- a/src/bytecode.c Thu May 02 14:35:32 2002 +0000 +++ b/src/bytecode.c Sun May 05 11:33:57 2002 +0000 @@ -1798,7 +1798,7 @@ if (STRINGP (f->instructions)) { - /* XSTRING_LENGTH() is more efficient than XSTRING_CHAR_LENGTH(), + /* XSTRING_LENGTH() is more efficient than string_char_length(), which would be slightly more `proper' */ program = alloca_array (Opbyte, 1 + 2 * XSTRING_LENGTH (f->instructions)); optimize_byte_code (f->instructions, f->constants, @@ -1826,7 +1826,7 @@ struct gcpro gcpro1, gcpro2; GCPRO2 (obj, printcharfun); - write_c_string (print_readably ? "#[" : "#<compiled-function ", printcharfun); + write_c_string (printcharfun, print_readably ? "#[" : "#<compiled-function "); #ifdef COMPILED_FUNCTION_ANNOTATION_HACK if (!print_readably) { @@ -1839,7 +1839,7 @@ print_internal (compiled_function_arglist (f), printcharfun, escapeflag); /* COMPILED_INSTRUCTIONS = 1 */ - write_c_string (" ", printcharfun); + write_c_string (printcharfun, " "); { struct gcpro ngcpro1; Lisp_Object instructions = compiled_function_instructions (f); @@ -1848,7 +1848,7 @@ { /* We don't usually want to see that junk in the bytecode. */ write_fmt_string (printcharfun, "\"...(%ld)\"", - (long) XSTRING_CHAR_LENGTH (instructions)); + (long) string_char_length (instructions)); } else print_internal (instructions, printcharfun, escapeflag); @@ -1856,7 +1856,7 @@ } /* COMPILED_CONSTANTS = 2 */ - write_c_string (" ", printcharfun); + write_c_string (printcharfun, " "); print_internal (compiled_function_constants (f), printcharfun, escapeflag); /* COMPILED_STACK_DEPTH = 3 */ @@ -1865,7 +1865,7 @@ /* COMPILED_DOC_STRING = 4 */ if (docp || intp) { - write_c_string (" ", printcharfun); + write_c_string (printcharfun, " "); print_internal (compiled_function_documentation (f), printcharfun, escapeflag); } @@ -1873,13 +1873,13 @@ /* COMPILED_INTERACTIVE = 5 */ if (intp) { - write_c_string (" ", printcharfun); + write_c_string (printcharfun, " "); print_internal (compiled_function_interactive (f), printcharfun, escapeflag); } UNGCPRO; - write_c_string (print_readably ? "]" : ">", printcharfun); + write_c_string (printcharfun, print_readably ? "]" : ">"); } @@ -2221,8 +2221,7 @@ #ifdef COMPILED_FUNCTION_ANNOTATION_HACK -/* Remove the `xx' if you wish to restore this feature */ -xxDEFUN ("compiled-function-annotation", Fcompiled_function_annotation, 1, 1, 0, /* +DEFUN ("compiled-function-annotation", Fcompiled_function_annotation, 1, 1, 0, /* Return the annotation of the compiled-function object FUNCTION, or nil. The annotation is a piece of information indicating where this compiled-function object came from. Generally this will be
--- a/src/callint.c Thu May 02 14:35:32 2002 +0000 +++ b/src/callint.c Sun May 05 11:33:57 2002 +0000 @@ -948,10 +948,10 @@ case '+': default: { - signal_ferror (Qsyntax_error, - "Invalid `interactive' control letter \"%c\" (#o%03o).", - prompt_data[prompt_index], - prompt_data[prompt_index]); + signal_ferror + (Qsyntax_error, + "Invalid `interactive' control letter \"%c\" (#o%03o).", + prompt_data[prompt_index], prompt_data[prompt_index]); } } #undef PROMPT
--- a/src/casefiddle.c Thu May 02 14:35:32 2002 +0000 +++ b/src/casefiddle.c Sun May 05 11:33:57 2002 +0000 @@ -1,5 +1,6 @@ /* XEmacs case conversion functions. Copyright (C) 1985, 1992, 1993, 1994, 1997, 1998 Free Software Foundation, Inc. + Copyright (C) 2002 Ben Wing. This file is part of XEmacs. @@ -48,9 +49,10 @@ if (STRINGP (string_or_char)) { - Lisp_Char_Table *syntax_table = XCHAR_TABLE (buf->mirror_syntax_table); + Lisp_Object syntax_table = buf->mirror_syntax_table; Intbyte *storage = - alloca_array (Intbyte, XSTRING_LENGTH (string_or_char) * MAX_EMCHAR_LEN); + alloca_array (Intbyte, XSTRING_LENGTH (string_or_char) * + MAX_EMCHAR_LEN); Intbyte *newp = storage; Intbyte *oldp = XSTRING_DATA (string_or_char); Intbyte *endp = oldp + XSTRING_LENGTH (string_or_char); @@ -156,7 +158,7 @@ { /* This function can GC */ Charbpos pos, s, e; - Lisp_Char_Table *syntax_table = XCHAR_TABLE (buf->mirror_syntax_table); + Lisp_Object syntax_table = buf->mirror_syntax_table; int mccount; int wordp = 0, wordp_prev;
--- a/src/casetab.c Thu May 02 14:35:32 2002 +0000 +++ b/src/casetab.c Sun May 05 11:33:57 2002 +0000 @@ -24,24 +24,39 @@ was rewritten to use junky FSF char tables. Meanwhile I rewrote it to use more logical char tables. --ben */ -/* Written by Howard Gayle. See some mythical and not-in-the-Emacs- - distribution file chartab.c for details. */ +/* Written by Howard Gayle. */ /* Modified for Mule by Ben Wing. */ -/* #### Someone (Yoshiki?) wrote the following comment, which I don't - understand. +/* The four tables in a case table are downcase, upcase, canon, and eqv. + Each is a char-table. Their workings are rather non-obvious. + + (1) `downcase' is the only obvious table: Map a character to its + lowercase equivalent. - Case tables consist of four char-tables. These are for downcase, - upcase, canonical and equivalent respectively. + (2) `upcase' does *NOT* map a character to its uppercase equivalent, + despite its name. Rather, it maps lowercase characters to their + uppercase equivalent, and uppercase characters to *ANYTHING BUT* their + uppercase equivalent (currently, their lowercase equivalent), and + characters without case to themselves. It is used to determine if a + character "has no case" (no uppercase or lowercase mapping). #### This + is way bogus. Just use the obvious implementation of uppercase mapping + and of NOCASE_P. - The entries are like this: + (3) `canon' maps each character to a "canonical" lowercase, such that if + two different uppercase characters map to the same lowercase character, + or vice versa, both characters will have the same entry in the canon + table. - downcase: a -> a, A -> a. - upcase: a -> A, A -> a. (The latter is for NOCASEP.) - canon: a -> a, A -> a. - eqv: a -> A, A -> a. -*/ + (4) `equiv' lists the "equivalence classes" defined by `canon'. Imagine + that all characters are divided into groups having the same `canon' + entry; these groups are called "equivalence classes" and `equiv' lists + them by linking the characters in each equivalence class together in a + circular list. + + `canon' is used when doing case-insensitive comparisons. `equiv' is + used in the Boyer-Moore search code. + */ #include <config.h> #include "lisp.h" @@ -53,10 +68,9 @@ Lisp_Object Qcase_tablep, Qdowncase, Qupcase; Lisp_Object Vstandard_case_table; -static void compute_trt_inverse (Lisp_Object trt, Lisp_Object inverse); Lisp_Object case_table_char (Lisp_Object ch, Lisp_Object table); -#define STRING256_P(obj) ((STRINGP (obj) && XSTRING_CHAR_LENGTH (obj) == 256)) +#define STRING256_P(obj) ((STRINGP (obj) && string_char_length (obj) == 256)) static Lisp_Object mark_case_table (Lisp_Object obj) @@ -75,8 +89,12 @@ { Lisp_Case_Table *ct = XCASE_TABLE (obj); if (print_readably) - printing_unreadable_object ("#<case-table 0x%x", ct->header.uid); - write_fmt_string (printcharfun, "#<case-table 0x%x>", ct->header.uid); + printing_unreadable_object ("#<case-table 0x%x>", ct->header.uid); + write_fmt_string_lisp + (printcharfun, "#<case-table downcase=%s upcase=%s canon=%s eqv=%s ", 4, + CASE_TABLE_DOWNCASE (ct), CASE_TABLE_UPCASE (ct), + CASE_TABLE_CANON (ct), CASE_TABLE_EQV (ct)); + write_fmt_string (printcharfun, "0x%x>", ct->header.uid); } static const struct lrecord_description case_table_description [] = { @@ -92,17 +110,34 @@ 0, 0, case_table_description, Lisp_Case_Table); static Lisp_Object -allocate_case_table (void) +allocate_case_table (int init_tables) { Lisp_Case_Table *ct = alloc_lcrecord_type (Lisp_Case_Table, &lrecord_case_table); - SET_CASE_TABLE_DOWNCASE (ct, Qnil); - SET_CASE_TABLE_UPCASE (ct, Qnil); - SET_CASE_TABLE_CANON (ct, Qnil); - SET_CASE_TABLE_EQV (ct, Qnil); + if (init_tables) + { + SET_CASE_TABLE_DOWNCASE (ct, MAKE_TRT_TABLE ()); + SET_CASE_TABLE_UPCASE (ct, MAKE_TRT_TABLE ()); + SET_CASE_TABLE_CANON (ct, MAKE_TRT_TABLE ()); + SET_CASE_TABLE_EQV (ct, MAKE_TRT_TABLE ()); + } + else + { + SET_CASE_TABLE_DOWNCASE (ct, Qnil); + SET_CASE_TABLE_UPCASE (ct, Qnil); + SET_CASE_TABLE_CANON (ct, Qnil); + SET_CASE_TABLE_EQV (ct, Qnil); + } + return wrap_case_table (ct); +} - return wrap_case_table (ct); +DEFUN ("make-case-table", Fmake_case_table, 0, 0, 0, /* +Create a new, empty case table. +*/ + ()) +{ + return allocate_case_table (1); } DEFUN ("case-table-p", Fcase_table_p, 1, 1, 0, /* @@ -152,7 +187,7 @@ case_table_char (Lisp_Object ch, Lisp_Object table) { Lisp_Object ct_char; - ct_char = get_char_table (XCHAR (ch), XCHAR_TABLE (table)); + ct_char = get_char_table (XCHAR (ch), table); if (NILP (ct_char)) return ch; else @@ -162,7 +197,7 @@ DEFUN ("get-case-table", Fget_case_table, 3, 3, 0, /* Return CHAR-CASE version of CHARACTER in CASE-TABLE. -CHAR-CASE is either downcase or upcase. +CHAR-CASE is either `downcase' or `upcase'. */ (char_case, character, case_table)) { @@ -181,7 +216,7 @@ DEFUN ("put-case-table", Fput_case_table, 4, 4, 0, /* Set CHAR-CASE version of CHARACTER to be VALUE in CASE-TABLE. -CHAR-CASE is either downcase or upcase. +CHAR-CASE is either `downcase' or `upcase'. See also `put-case-table-pair'. */ (char_case, character, value, case_table)) @@ -192,25 +227,19 @@ if (EQ (char_case, Qdowncase)) { Fput_char_table (character, value, XCASE_TABLE_DOWNCASE (case_table)); - /* This one is not at all intuitive. */ + /* This one is not at all intuitive. See comment at top of file. */ Fput_char_table (character, value, XCASE_TABLE_UPCASE (case_table)); - Fput_char_table (character, value, XCASE_TABLE_CANON (case_table)); - Fput_char_table (value, value, XCASE_TABLE_CANON (case_table)); - Fput_char_table (value, character, XCASE_TABLE_EQV (case_table)); - Fput_char_table (character, value, XCASE_TABLE_EQV (case_table)); } else if (EQ (char_case, Qupcase)) { Fput_char_table (character, value, XCASE_TABLE_UPCASE (case_table)); - Fput_char_table (character, character, XCASE_TABLE_DOWNCASE (case_table)); - Fput_char_table (character, character, XCASE_TABLE_CANON (case_table)); - Fput_char_table (value, character, XCASE_TABLE_CANON (case_table)); - Fput_char_table (value, character, XCASE_TABLE_EQV (case_table)); - Fput_char_table (character, value, XCASE_TABLE_EQV (case_table)); + Fput_char_table (character, character, + XCASE_TABLE_DOWNCASE (case_table)); } else - invalid_constant ("Char case must be downcase or upcase", char_case); + invalid_constant ("CHAR-CASE must be downcase or upcase", char_case); + XCASE_TABLE (case_table)->dirty = 1; return Qnil; } @@ -229,10 +258,7 @@ Fput_char_table (uc, lc, XCASE_TABLE_DOWNCASE (case_table)); Fput_char_table (lc, uc, XCASE_TABLE_UPCASE (case_table)); - Fput_char_table (lc, lc, XCASE_TABLE_CANON (case_table)); - Fput_char_table (uc, lc, XCASE_TABLE_CANON (case_table)); - Fput_char_table (uc, lc, XCASE_TABLE_EQV (case_table)); - Fput_char_table (lc, uc, XCASE_TABLE_EQV (case_table)); + XCASE_TABLE (case_table)->dirty = 1; return Qnil; } @@ -244,7 +270,7 @@ Lisp_Object new_obj; CHECK_CASE_TABLE (case_table); - new_obj = allocate_case_table (); + new_obj = allocate_case_table (0); XSET_CASE_TABLE_DOWNCASE (new_obj, Fcopy_char_table (XCASE_TABLE_DOWNCASE (case_table))); XSET_CASE_TABLE_UPCASE @@ -256,6 +282,74 @@ return new_obj; } +static int +compute_canon_mapper (struct chartab_range *range, + Lisp_Object table, Lisp_Object val, void *arg) +{ + Lisp_Object casetab = VOID_TO_LISP (arg); + if (range->type == CHARTAB_RANGE_CHAR) + SET_TRT_TABLE_OF (XCASE_TABLE_CANON (casetab), range->ch, + TRT_TABLE_OF (XCASE_TABLE_DOWNCASE (casetab), + TRT_TABLE_OF (XCASE_TABLE_UPCASE (casetab), + XCHAR (val)))); + + return 0; +} + +static int +initialize_identity_mapper (struct chartab_range *range, + Lisp_Object table, Lisp_Object val, void *arg) +{ + Lisp_Object trt = VOID_TO_LISP (arg); + if (range->type == CHARTAB_RANGE_CHAR) + SET_TRT_TABLE_OF (trt, range->ch, range->ch); + + return 0; +} + +static int +compute_up_or_eqv_mapper (struct chartab_range *range, + Lisp_Object table, Lisp_Object val, void *arg) +{ + Lisp_Object inverse = VOID_TO_LISP (arg); + Emchar toch = XCHAR (val); + + if (range->type == CHARTAB_RANGE_CHAR && range->ch != toch) + { + Emchar c = TRT_TABLE_OF (inverse, toch); + SET_TRT_TABLE_OF (inverse, toch, range->ch); + SET_TRT_TABLE_OF (inverse, range->ch, c); + } + + return 0; +} + +/* Recomputing the canonical and equivalency tables from scratch is a + lengthy process, and doing them incrementally is extremely difficult or + perhaps impossible -- and certainly not worth it. To avoid lots of + excessive recomputation when lots of stuff is incrementally added, we + just store a dirty flag and then recompute when a value from the canon + or eqv tables is actually needed. */ + +void +recompute_case_table (Lisp_Object casetab) +{ + struct chartab_range range; + + range.type = CHARTAB_RANGE_ALL; + /* Turn off dirty flag first so we don't get infinite recursion when + retrieving the values below! */ + XCASE_TABLE (casetab)->dirty = 0; + map_char_table (XCASE_TABLE_DOWNCASE (casetab), &range, + compute_canon_mapper, LISP_TO_VOID (casetab)); + map_char_table (XCASE_TABLE_CANON (casetab), &range, + initialize_identity_mapper, + LISP_TO_VOID (XCASE_TABLE_EQV (casetab))); + map_char_table (XCASE_TABLE_CANON (casetab), &range, + compute_up_or_eqv_mapper, + LISP_TO_VOID (XCASE_TABLE_EQV (casetab))); +} + DEFUN ("current-case-table", Fcurrent_case_table, 0, 1, 0, /* Return the case table of BUFFER, which defaults to the current buffer. */ @@ -275,7 +369,86 @@ return Vstandard_case_table; } -static Lisp_Object set_case_table (Lisp_Object table, int standard); +static void +convert_old_style_syntax_string (Lisp_Object table, Lisp_Object string) +{ + Emchar i; + + for (i = 0; i < 256; i++) + SET_TRT_TABLE_OF (table, i, string_emchar (string, i)); +} + +static Lisp_Object +set_case_table (Lisp_Object table, int standard) +{ + /* This function can GC */ + struct buffer *buf = + standard ? XBUFFER (Vbuffer_defaults) : current_buffer; + + check_case_table (table); + + if (CASE_TABLEP (table)) + { + if (standard) + Vstandard_case_table = table; + + buf->case_table = table; + } + else + { + /* For backward compatibility. */ + Lisp_Object down, up, canon, eqv, tail = table; + Lisp_Object casetab = + standard ? Vstandard_case_table : buf->case_table; + struct chartab_range range; + + range.type = CHARTAB_RANGE_ALL; + + Freset_char_table (XCASE_TABLE_DOWNCASE (casetab)); + Freset_char_table (XCASE_TABLE_UPCASE (casetab)); + Freset_char_table (XCASE_TABLE_CANON (casetab)); + Freset_char_table (XCASE_TABLE_EQV (casetab)); + + down = XCAR (tail); tail = XCDR (tail); + up = XCAR (tail); tail = XCDR (tail); + canon = XCAR (tail); tail = XCDR (tail); + eqv = XCAR (tail); + + convert_old_style_syntax_string (XCASE_TABLE_DOWNCASE (casetab), down); + + if (NILP (up)) + { + map_char_table (XCASE_TABLE_DOWNCASE (casetab), &range, + initialize_identity_mapper, + LISP_TO_VOID (XCASE_TABLE_UPCASE (casetab))); + map_char_table (XCASE_TABLE_DOWNCASE (casetab), &range, + compute_up_or_eqv_mapper, + LISP_TO_VOID (XCASE_TABLE_UPCASE (casetab))); + } + else + convert_old_style_syntax_string (XCASE_TABLE_UPCASE (casetab), up); + + if (NILP (canon)) + map_char_table (XCASE_TABLE_DOWNCASE (casetab), &range, + compute_canon_mapper, LISP_TO_VOID (casetab)); + else + convert_old_style_syntax_string (XCASE_TABLE_CANON (casetab), canon); + + if (NILP (eqv)) + { + map_char_table (XCASE_TABLE_CANON (casetab), &range, + initialize_identity_mapper, + LISP_TO_VOID (XCASE_TABLE_EQV (casetab))); + map_char_table (XCASE_TABLE_CANON (casetab), &range, + compute_up_or_eqv_mapper, + LISP_TO_VOID (XCASE_TABLE_EQV (casetab))); + } + else + convert_old_style_syntax_string (XCASE_TABLE_CANON (casetab), eqv); + } + + return buf->case_table; +} DEFUN ("set-case-table", Fset_case_table, 1, 1, 0, /* Select CASE-TABLE as the new case table for the current buffer. @@ -313,131 +486,6 @@ return set_case_table (case_table, 1); } -static Lisp_Object -set_case_table (Lisp_Object table, int standard) -{ - /* This function can GC */ - struct buffer *buf = - standard ? XBUFFER(Vbuffer_defaults) : current_buffer; - - check_case_table (table); - - if (CASE_TABLEP (table)) - { - if (standard) - Vstandard_case_table = table; - - buf->case_table = table; - } - else - { - /* For backward compatibility. */ - Lisp_Object down, up, canon, eqv, tail = table; - Lisp_Object temp; - int i; - - down = XCAR (tail); tail = XCDR (tail); - up = XCAR (tail); tail = XCDR (tail); - canon = XCAR (tail); tail = XCDR (tail); - eqv = XCAR (tail); - - temp = down; - down = MAKE_TRT_TABLE (); - for (i = 0; i < 256; i++) - SET_TRT_TABLE_CHAR_1 (down, i, XSTRING_CHAR (temp, i)); - - if (NILP (up)) - { - up = MAKE_TRT_TABLE (); - compute_trt_inverse (down, up); - } - else - { - temp = up; - up = MAKE_TRT_TABLE (); - for (i = 0; i < 256; i++) - SET_TRT_TABLE_CHAR_1 (up, i, XSTRING_CHAR (temp, i)); - } - if (NILP (canon)) - { - canon = MAKE_TRT_TABLE (); - - /* Set up the CANON table; for each character, - this sequence of upcasing and downcasing ought to - get the "preferred" lowercase equivalent. */ - for (i = 0; i < 256; i++) - SET_TRT_TABLE_CHAR_1 (canon, i, - TRT_TABLE_CHAR_1 - (down, - TRT_TABLE_CHAR_1 - (up, - TRT_TABLE_CHAR_1 (down, i)))); - } - else - { - temp = canon; - canon = MAKE_TRT_TABLE (); - for (i = 0; i < 256; i++) - SET_TRT_TABLE_CHAR_1 (canon, i, XSTRING_CHAR (temp, i)); - } - - if (NILP (eqv)) - { - eqv = MAKE_TRT_TABLE (); - compute_trt_inverse (canon, eqv); - } - else - { - temp = eqv; - eqv = MAKE_TRT_TABLE (); - for (i = 0; i < 256; i++) - SET_TRT_TABLE_CHAR_1 (eqv, i, XSTRING_CHAR (temp, i)); - } - - if (standard) - { - XSET_CASE_TABLE_DOWNCASE (Vstandard_case_table, down); - XSET_CASE_TABLE_UPCASE (Vstandard_case_table, up); - XSET_CASE_TABLE_CANON (Vstandard_case_table, canon); - XSET_CASE_TABLE_EQV (Vstandard_case_table, eqv); - } - - buf->case_table = allocate_case_table (); - XSET_CASE_TABLE_DOWNCASE (buf->case_table, down); - XSET_CASE_TABLE_UPCASE (buf->case_table, up); - XSET_CASE_TABLE_CANON (buf->case_table, canon); - XSET_CASE_TABLE_EQV (buf->case_table, eqv); - } - - return buf->case_table; -} - -/* Given a translate table TRT, store the inverse mapping into INVERSE. - Since TRT is not one-to-one, INVERSE is not a simple mapping. - Instead, it divides the space of characters into equivalence classes. - All characters in a given class form one circular list, chained through - the elements of INVERSE. */ - -static void -compute_trt_inverse (Lisp_Object trt, Lisp_Object inverse) -{ - Charcount i = 0400; - Emchar c, q; - - while (--i) - SET_TRT_TABLE_CHAR_1 (inverse, i, (Emchar) i); - i = 0400; - while (--i) - { - if ((q = TRT_TABLE_CHAR_1 (trt, i)) != (Emchar) i) - { - c = TRT_TABLE_CHAR_1 (inverse, q); - SET_TRT_TABLE_CHAR_1 (inverse, q, (Emchar) i); - SET_TRT_TABLE_CHAR_1 (inverse, i, c); - } - } -} - void syms_of_casetab (void) @@ -448,6 +496,7 @@ DEFSYMBOL (Qdowncase); DEFSYMBOL (Qupcase); + DEFSUBR (Fmake_case_table); DEFSUBR (Fcase_table_p); DEFSUBR (Fget_case_table); DEFSUBR (Fput_case_table); @@ -463,34 +512,27 @@ complex_vars_of_casetab (void) { REGISTER Emchar i; - Lisp_Object tem; staticpro (&Vstandard_case_table); - Vstandard_case_table = allocate_case_table (); + Vstandard_case_table = allocate_case_table (1); - tem = MAKE_TRT_TABLE (); - XSET_CASE_TABLE_DOWNCASE (Vstandard_case_table, tem); - XSET_CASE_TABLE_CANON (Vstandard_case_table, tem); - - /* Under Mule, can't do set_string_char() until Vcharset_control_1 - and Vcharset_ascii are initialized. */ for (i = 0; i < 256; i++) { unsigned char lowered = tolower (i); - SET_TRT_TABLE_CHAR_1 (tem, i, lowered); + SET_TRT_TABLE_OF (XCASE_TABLE_DOWNCASE (Vstandard_case_table), i, + lowered); } - tem = MAKE_TRT_TABLE (); - XSET_CASE_TABLE_UPCASE (Vstandard_case_table, tem); - XSET_CASE_TABLE_EQV (Vstandard_case_table, tem); - for (i = 0; i < 256; i++) { unsigned char flipped = (isupper (i) ? tolower (i) : (islower (i) ? toupper (i) : i)); - SET_TRT_TABLE_CHAR_1 (tem, i, flipped); + SET_TRT_TABLE_OF (XCASE_TABLE_UPCASE (Vstandard_case_table), i, + flipped); } + + recompute_case_table (Vstandard_case_table); }
--- a/src/casetab.h Thu May 02 14:35:32 2002 +0000 +++ b/src/casetab.h Sun May 05 11:33:57 2002 +0000 @@ -1,5 +1,6 @@ /* XEmacs routines to deal with case tables. Copyright (C) 2000 Yoshiki Hayashi. + Copyright (C) 2002 Ben Wing. This file is part of XEmacs. XEmacs is free software; you can redistribute it and/or modify it @@ -29,6 +30,7 @@ Lisp_Object upcase_table; Lisp_Object case_canon_table; Lisp_Object case_eqv_table; + int dirty; }; typedef struct Lisp_Case_Table Lisp_Case_Table; @@ -39,14 +41,34 @@ #define CHECK_CASE_TABLE(x) CHECK_RECORD (x, case_table) #define CONCHECK_CASE_TABLE(x) CONCHECK_RECORD (x, case_table) +void recompute_case_table (Lisp_Object casetab); + +DECLARE_INLINE_HEADER ( +Lisp_Case_Table * +XCASE_TABLE_UPDATE (Lisp_Object table) +) +{ + Lisp_Case_Table *ct = XCASE_TABLE (table); + /* If the table is dirty (changes have been made without ancillary + structures updated), recompute first. */ + if (ct->dirty) + recompute_case_table (table); + return ct; +} + #define CASE_TABLE_DOWNCASE(ct) ((ct)->downcase_table) #define CASE_TABLE_UPCASE(ct) ((ct)->upcase_table) #define CASE_TABLE_CANON(ct) ((ct)->case_canon_table) #define CASE_TABLE_EQV(ct) ((ct)->case_eqv_table) #define XCASE_TABLE_DOWNCASE(ct) (XCASE_TABLE (ct)->downcase_table) #define XCASE_TABLE_UPCASE(ct) (XCASE_TABLE (ct)->upcase_table) -#define XCASE_TABLE_CANON(ct) (XCASE_TABLE (ct)->case_canon_table) -#define XCASE_TABLE_EQV(ct) (XCASE_TABLE (ct)->case_eqv_table) +/* Only do automatic updating for canon and eqv, which are the two that are + automatically computed and that are not up to date. These are not + normally used by the simple case routines. canon is used by + compare-buffer-substrings when case-insensitive and by the regex + routines, and eqv is used only by the Boyer-Moore search routines. */ +#define XCASE_TABLE_CANON(ct) (XCASE_TABLE_UPDATE (ct)->case_canon_table) +#define XCASE_TABLE_EQV(ct) (XCASE_TABLE_UPDATE (ct)->case_eqv_table) #define SET_CASE_TABLE_DOWNCASE(ct, p) ((ct)->downcase_table = p) #define SET_CASE_TABLE_UPCASE(ct, p) ((ct)->upcase_table = p)
--- a/src/charset.h Thu May 02 14:35:32 2002 +0000 +++ b/src/charset.h Sun May 05 11:33:57 2002 +0000 @@ -40,18 +40,20 @@ #define Vcharset_ascii Qnil -#define CHAR_CHARSET(ch) Vcharset_ascii -#define CHAR_LEADING_BYTE(ch) LEADING_BYTE_ASCII +#define emchar_charset(ch) Vcharset_ascii +#define emchar_leading_byte(ch) LEADING_BYTE_ASCII +#define emchar_len(ch) 1 +#define emchar_len_fmt(ch, fmt) 1 #define LEADING_BYTE_ASCII 0x80 #define NUM_LEADING_BYTES 1 #define MIN_LEADING_BYTE 0x80 #define CHARSETP(cs) 1 -#define CHARSET_BY_LEADING_BYTE(lb) Vcharset_ascii +#define charset_by_leading_byte(lb) Vcharset_ascii #define XCHARSET_LEADING_BYTE(cs) LEADING_BYTE_ASCII #define XCHARSET_GRAPHIC(cs) -1 #define XCHARSET_COLUMNS(cs) 1 #define XCHARSET_DIMENSION(cs) 1 -#define BREAKUP_CHAR(ch, charset, byte1, byte2) do { \ +#define BREAKUP_EMCHAR(ch, charset, byte1, byte2) do { \ (charset) = Vcharset_ascii; \ (byte1) = (ch); \ (byte2) = 0; \ @@ -151,13 +153,14 @@ /* Is this leading byte for a private charset? */ -#define LEADING_BYTE_PRIVATE_P(lb) ((lb) >= MIN_LEADING_BYTE_PRIVATE_1) +#define leading_byte_private_p(lb) ((lb) >= MIN_LEADING_BYTE_PRIVATE_1) /* Is this a prefix for a private leading byte? */ -INLINE_HEADER int LEADING_BYTE_PREFIX_P (Intbyte lb); -INLINE_HEADER int -LEADING_BYTE_PREFIX_P (Intbyte lb) +DECLARE_INLINE_HEADER ( +int +leading_byte_prefix_p (Intbyte lb) +) { return (lb == PRE_LEADING_BYTE_PRIVATE_1 || lb == PRE_LEADING_BYTE_PRIVATE_2); @@ -166,7 +169,7 @@ /* Given a private leading byte, return the leading byte prefix stored in a string. */ -#define PRIVATE_LEADING_BYTE_PREFIX(lb) \ +#define private_leading_byte_prefix(lb) \ ((unsigned int) (lb) < MIN_LEADING_BYTE_PRIVATE_2 ? \ PRE_LEADING_BYTE_PRIVATE_1 : \ PRE_LEADING_BYTE_PRIVATE_2) @@ -297,7 +300,7 @@ #define CHARSET_FROM_UNICODE_LEVELS(cs) ((cs)->from_unicode_levels) -#define CHARSET_PRIVATE_P(cs) LEADING_BYTE_PRIVATE_P (CHARSET_LEADING_BYTE (cs)) +#define CHARSET_PRIVATE_P(cs) leading_byte_private_p (CHARSET_LEADING_BYTE (cs)) #define XCHARSET_ID(cs) CHARSET_ID (XCHARSET (cs)) #define XCHARSET_NAME(cs) CHARSET_NAME (XCHARSET (cs)) @@ -336,9 +339,10 @@ Intbyte next_allocated_2_byte_leading_byte; }; -INLINE_HEADER Lisp_Object CHARSET_BY_LEADING_BYTE (int lb); -INLINE_HEADER Lisp_Object -CHARSET_BY_LEADING_BYTE (int lb) +DECLARE_INLINE_HEADER ( +Lisp_Object +charset_by_leading_byte (int lb) +) { extern struct charset_lookup *chlook; @@ -351,10 +355,10 @@ return chlook->charset_by_leading_byte[lb - MIN_LEADING_BYTE]; } -INLINE_HEADER Lisp_Object -CHARSET_BY_ATTRIBUTES (int type, int final, int dir); -INLINE_HEADER Lisp_Object -CHARSET_BY_ATTRIBUTES (int type, int final, int dir) +DECLARE_INLINE_HEADER ( +Lisp_Object +charset_by_attributes (int type, int final, int dir) +) { extern struct charset_lookup *chlook; @@ -372,15 +376,15 @@ /* The bit fields of character are divided into 3 parts: FIELD1(5bits):FIELD2(7bits):FIELD3(7bits) */ -#define CHAR_FIELD1_MASK (0x1F << 14) -#define CHAR_FIELD2_MASK (0x7F << 7) -#define CHAR_FIELD3_MASK 0x7F +#define EMCHAR_FIELD1_MASK (0x1F << 14) +#define EMCHAR_FIELD2_MASK (0x7F << 7) +#define EMCHAR_FIELD3_MASK 0x7F /* Macros to access each field of a character code of C. */ -#define CHAR_FIELD1(c) (((c) & CHAR_FIELD1_MASK) >> 14) -#define CHAR_FIELD2(c) (((c) & CHAR_FIELD2_MASK) >> 7) -#define CHAR_FIELD3(c) ((c) & CHAR_FIELD3_MASK) +#define emchar_field1(c) (((c) & EMCHAR_FIELD1_MASK) >> 14) +#define emchar_field2(c) (((c) & EMCHAR_FIELD2_MASK) >> 7) +#define emchar_field3(c) ((c) & EMCHAR_FIELD3_MASK) /* Field 1, if non-zero, usually holds a leading byte for a dimension-2 charset. Field 2, if non-zero, usually holds a leading @@ -396,32 +400,32 @@ /* Minimum and maximum allowed values for the fields. */ -#define MIN_CHAR_FIELD2_OFFICIAL \ +#define MIN_EMCHAR_FIELD2_OFFICIAL \ (MIN_LEADING_BYTE_OFFICIAL_1 - FIELD2_TO_OFFICIAL_LEADING_BYTE) -#define MAX_CHAR_FIELD2_OFFICIAL \ +#define MAX_EMCHAR_FIELD2_OFFICIAL \ (MAX_LEADING_BYTE_OFFICIAL_1 - FIELD2_TO_OFFICIAL_LEADING_BYTE) -#define MIN_CHAR_FIELD1_OFFICIAL \ +#define MIN_EMCHAR_FIELD1_OFFICIAL \ (MIN_LEADING_BYTE_OFFICIAL_2 - FIELD1_TO_OFFICIAL_LEADING_BYTE) -#define MAX_CHAR_FIELD1_OFFICIAL \ +#define MAX_EMCHAR_FIELD1_OFFICIAL \ (MAX_LEADING_BYTE_OFFICIAL_2 - FIELD1_TO_OFFICIAL_LEADING_BYTE) -#define MIN_CHAR_FIELD2_PRIVATE \ +#define MIN_EMCHAR_FIELD2_PRIVATE \ (MIN_LEADING_BYTE_PRIVATE_1 - FIELD2_TO_PRIVATE_LEADING_BYTE) -#define MAX_CHAR_FIELD2_PRIVATE \ +#define MAX_EMCHAR_FIELD2_PRIVATE \ (MAX_LEADING_BYTE_PRIVATE_1 - FIELD2_TO_PRIVATE_LEADING_BYTE) -#define MIN_CHAR_FIELD1_PRIVATE \ +#define MIN_EMCHAR_FIELD1_PRIVATE \ (MIN_LEADING_BYTE_PRIVATE_2 - FIELD1_TO_PRIVATE_LEADING_BYTE) -#define MAX_CHAR_FIELD1_PRIVATE \ +#define MAX_EMCHAR_FIELD1_PRIVATE \ (MAX_LEADING_BYTE_PRIVATE_2 - FIELD1_TO_PRIVATE_LEADING_BYTE) /* Minimum character code of each <type> character. */ -#define MIN_CHAR_OFFICIAL_TYPE9N (MIN_CHAR_FIELD2_OFFICIAL << 7) -#define MIN_CHAR_PRIVATE_TYPE9N (MIN_CHAR_FIELD2_PRIVATE << 7) -#define MIN_CHAR_OFFICIAL_TYPE9NX9N (MIN_CHAR_FIELD1_OFFICIAL << 14) -#define MIN_CHAR_PRIVATE_TYPE9NX9N (MIN_CHAR_FIELD1_PRIVATE << 14) +#define MIN_CHAR_OFFICIAL_TYPE9N (MIN_EMCHAR_FIELD2_OFFICIAL << 7) +#define MIN_CHAR_PRIVATE_TYPE9N (MIN_EMCHAR_FIELD2_PRIVATE << 7) +#define MIN_CHAR_OFFICIAL_TYPE9NX9N (MIN_EMCHAR_FIELD1_OFFICIAL << 14) +#define MIN_CHAR_PRIVATE_TYPE9NX9N (MIN_EMCHAR_FIELD1_PRIVATE << 14) #define MIN_CHAR_COMPOSITION (0x1F << 14) /* Leading byte of a character. @@ -431,20 +435,21 @@ FIELD2_TO_PRIVATE_LEADING_BYTE are the same. */ -INLINE_HEADER Intbyte CHAR_LEADING_BYTE (Emchar c); -INLINE_HEADER Intbyte -CHAR_LEADING_BYTE (Emchar c) +DECLARE_INLINE_HEADER ( +Intbyte +emchar_leading_byte (Emchar c) +) { - if (CHAR_ASCII_P (c)) + if (emchar_ascii_p (c)) return LEADING_BYTE_ASCII; else if (c < 0xA0) return LEADING_BYTE_CONTROL_1; else if (c < MIN_CHAR_OFFICIAL_TYPE9NX9N) - return CHAR_FIELD2 (c) + FIELD2_TO_OFFICIAL_LEADING_BYTE; + return emchar_field2 (c) + FIELD2_TO_OFFICIAL_LEADING_BYTE; else if (c < MIN_CHAR_PRIVATE_TYPE9NX9N) - return CHAR_FIELD1 (c) + FIELD1_TO_OFFICIAL_LEADING_BYTE; + return emchar_field1 (c) + FIELD1_TO_OFFICIAL_LEADING_BYTE; else if (c < MIN_CHAR_COMPOSITION) - return CHAR_FIELD1 (c) + FIELD1_TO_PRIVATE_LEADING_BYTE; + return emchar_field1 (c) + FIELD1_TO_PRIVATE_LEADING_BYTE; else { #ifdef ENABLE_COMPOSITE_CHARS @@ -456,7 +461,50 @@ } } -#define CHAR_CHARSET(c) CHARSET_BY_LEADING_BYTE (CHAR_LEADING_BYTE (c)) +DECLARE_INLINE_HEADER ( +Bytecount +emchar_len (Emchar c) +) +{ + if (emchar_ascii_p (c)) + return 1; + else if (c < MIN_CHAR_OFFICIAL_TYPE9NX9N) + return 2; + else if (c < MIN_CHAR_PRIVATE_TYPE9NX9N) + return 3; /* dimension-2 official or dimension-1 private */ + else if (c < MIN_CHAR_COMPOSITION) + return 4; + else + { +#ifdef ENABLE_COMPOSITE_CHARS +#error Not yet implemented +#else + abort(); + return 0; +#endif /* ENABLE_COMPOSITE_CHARS */ + } +} + +DECLARE_INLINE_HEADER ( +Bytecount +emchar_len_fmt (Emchar c, Internal_Format fmt) +) +{ + switch (fmt) + { + case FORMAT_DEFAULT: + return emchar_len (c); + case FORMAT_16_BIT_FIXED: + return 2; + case FORMAT_32_BIT_FIXED: + return 4; + default: + text_checking_assert (fmt == FORMAT_8_BIT_FIXED); + return 1; + } +} + +#define emchar_charset(c) charset_by_leading_byte (emchar_leading_byte (c)) /* Return a character whose charset is CHARSET and position-codes are C1 and C2. TYPE9N character ignores C2. (For typical charsets, i.e. not @@ -468,72 +516,63 @@ FIELD2_TO_PRIVATE_LEADING_BYTE are the same. */ -INLINE_HEADER Emchar MAKE_CHAR_1 (Lisp_Object charset, int c1, int c2); -INLINE_HEADER Emchar -MAKE_CHAR_1 (Lisp_Object charset, int c1, int c2) +DECLARE_INLINE_HEADER ( +Emchar +make_emchar (Lisp_Object charset, int c1, int c2) +) { + Emchar retval; if (EQ (charset, Vcharset_ascii)) - return c1; + retval = c1; else if (EQ (charset, Vcharset_control_1)) - return c1 | 0x80; + retval = c1 | 0x80; #ifdef ENABLE_COMPOSITE_CHARS else if (EQ (charset, Vcharset_composite)) - return (0x1F << 14) | ((c1) << 7) | (c2); + retval = (0x1F << 14) | ((c1) << 7) | (c2); #endif else if (XCHARSET_DIMENSION (charset) == 1) - return ((XCHARSET_LEADING_BYTE (charset) - - FIELD2_TO_OFFICIAL_LEADING_BYTE) << 7) | (c1); + retval = ((XCHARSET_LEADING_BYTE (charset) - + FIELD2_TO_OFFICIAL_LEADING_BYTE) << 7) | (c1); else if (!XCHARSET_PRIVATE_P (charset)) - return ((XCHARSET_LEADING_BYTE (charset) - - FIELD1_TO_OFFICIAL_LEADING_BYTE) << 14) | ((c1) << 7) | (c2); + retval = ((XCHARSET_LEADING_BYTE (charset) - + FIELD1_TO_OFFICIAL_LEADING_BYTE) << 14) | ((c1) << 7) | (c2); else - return ((XCHARSET_LEADING_BYTE (charset) - - FIELD1_TO_PRIVATE_LEADING_BYTE) << 14) | ((c1) << 7) | (c2); + retval = ((XCHARSET_LEADING_BYTE (charset) - + FIELD1_TO_PRIVATE_LEADING_BYTE) << 14) | ((c1) << 7) | (c2); + text_checking_assert (valid_emchar_p (retval)); + return retval; } -#ifdef ERROR_CHECK_TEXT -INLINE_HEADER Emchar MAKE_CHAR (Lisp_Object charset, int c1, int c2); -INLINE_HEADER Emchar -MAKE_CHAR (Lisp_Object charset, int c1, int c2) -{ - Emchar retval = MAKE_CHAR_1 (charset, c1, c2); - assert (valid_char_p (retval)); - return retval; -} -#else -#define MAKE_CHAR(charset, c1, c2) MAKE_CHAR_1 (charset, c1, c2) -#endif - -/* BREAKUP_CHAR_1_UNSAFE assumes that the charset has already been +/* BREAKUP_EMCHAR_1_UNSAFE assumes that the charset has already been calculated, and just computes c1 and c2. - BREAKUP_CHAR also computes and stores the charset. */ + BREAKUP_EMCHAR also computes and stores the charset. */ -#define BREAKUP_CHAR_1_UNSAFE(c, charset, c1, c2) \ +#define BREAKUP_EMCHAR_1_UNSAFE(c, charset, c1, c2) \ XCHARSET_DIMENSION (charset) == 1 \ - ? ((c1) = CHAR_FIELD3 (c), (c2) = 0) \ - : ((c1) = CHAR_FIELD2 (c), \ - (c2) = CHAR_FIELD3 (c)) + ? ((c1) = emchar_field3 (c), (c2) = 0) \ + : ((c1) = emchar_field2 (c), \ + (c2) = emchar_field3 (c)) -INLINE_HEADER void breakup_char_1 (Emchar c, Lisp_Object *charset, int *c1, - int *c2); -INLINE_HEADER void -breakup_char_1 (Emchar c, Lisp_Object *charset, int *c1, int *c2) +DECLARE_INLINE_HEADER ( +void +breakup_emchar_1 (Emchar c, Lisp_Object *charset, int *c1, int *c2) +) { - text_checking_assert (valid_char_p (c)); - *charset = CHAR_CHARSET (c); - BREAKUP_CHAR_1_UNSAFE (c, *charset, *c1, *c2); + text_checking_assert (valid_emchar_p (c)); + *charset = emchar_charset (c); + BREAKUP_EMCHAR_1_UNSAFE (c, *charset, *c1, *c2); } -/* BREAKUP_CHAR separates an Emchar into its components. The charset of +/* BREAKUP_EMCHAR separates an Emchar into its components. The charset of character C is set to CHARSET, and the position-codes of C are set to C1 and C2. C2 of TYPE9N character is 0. */ -#define BREAKUP_CHAR(c, charset, c1, c2) \ - breakup_char_1 (c, &(charset), &(c1), &(c2)) +#define BREAKUP_EMCHAR(c, charset, c1, c2) \ + breakup_emchar_1 (c, &(charset), &(c1), &(c2)) void get_charset_limits (Lisp_Object charset, int *low, int *high); -int char_to_unicode (Emchar chr); +int emchar_to_unicode (Emchar chr); #endif /* MULE */
--- a/src/chartab.c Thu May 02 14:35:32 2002 +0000 +++ b/src/chartab.c Sun May 05 11:33:57 2002 +0000 @@ -57,6 +57,10 @@ Lisp_Object Vword_combining_categories, Vword_separating_categories; #endif /* MULE */ +static int check_valid_char_table_value (Lisp_Object value, + enum char_table_type type, + Error_Behavior errb); + /* A char table maps from ranges of characters to values. @@ -126,7 +130,7 @@ { Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj); - return internal_array_hash (cte->level2, 96, depth); + return internal_array_hash (cte->level2, 96, depth + 1); } static const struct lrecord_description char_table_entry_description[] = { @@ -218,159 +222,122 @@ } static void -print_chartab_range (Emchar first, Emchar last, Lisp_Object val, - Lisp_Object printcharfun) +decode_char_table_range (Lisp_Object range, struct chartab_range *outrange) { - if (first != last) - write_fmt_string_lisp (printcharfun, " (%s %s)", 2, - make_char (first), make_char (last)); + if (EQ (range, Qt)) + outrange->type = CHARTAB_RANGE_ALL; + else if (CHAR_OR_CHAR_INTP (range)) + { + outrange->type = CHARTAB_RANGE_CHAR; + outrange->ch = XCHAR_OR_CHAR_INT (range); + } +#ifndef MULE else - write_fmt_string_lisp (printcharfun, " %s ", 1, make_char (first)); - print_internal (val, printcharfun, 1); + sferror ("Range must be t or a character", range); +#else /* MULE */ + else if (VECTORP (range)) + { + Lisp_Vector *vec = XVECTOR (range); + Lisp_Object *elts = vector_data (vec); + if (vector_length (vec) != 2) + sferror ("Length of charset row vector must be 2", + range); + outrange->type = CHARTAB_RANGE_ROW; + outrange->charset = Fget_charset (elts[0]); + CHECK_INT (elts[1]); + outrange->row = XINT (elts[1]); + switch (XCHARSET_TYPE (outrange->charset)) + { + case CHARSET_TYPE_94: + case CHARSET_TYPE_96: + sferror ("Charset in row vector must be multi-byte", + outrange->charset); + case CHARSET_TYPE_94X94: + check_int_range (outrange->row, 33, 126); + break; + case CHARSET_TYPE_96X96: + check_int_range (outrange->row, 32, 127); + break; + default: + abort (); + } + } + else + { + if (!CHARSETP (range) && !SYMBOLP (range)) + sferror + ("Char table range must be t, charset, char, or vector", range); + outrange->type = CHARTAB_RANGE_CHARSET; + outrange->charset = Fget_charset (range); + } +#endif /* MULE */ } -#ifdef MULE - -static void -print_chartab_charset_row (Lisp_Object charset, - int row, - Lisp_Char_Table_Entry *cte, - Lisp_Object printcharfun) +static Lisp_Object +encode_char_table_range (struct chartab_range *range) { - int i; - Lisp_Object cat = Qunbound; - int first = -1; - - for (i = 32; i < 128; i++) + switch (range->type) { - Lisp_Object pam = cte->level2[i - 32]; - - if (first == -1) - { - first = i; - cat = pam; - continue; - } + case CHARTAB_RANGE_ALL: + return Qt; + +#ifdef MULE + case CHARTAB_RANGE_CHARSET: + return XCHARSET_NAME (Fget_charset (range->charset)); - if (!EQ (cat, pam)) - { - if (row == -1) - print_chartab_range (MAKE_CHAR (charset, first, 0), - MAKE_CHAR (charset, i - 1, 0), - cat, printcharfun); - else - print_chartab_range (MAKE_CHAR (charset, row, first), - MAKE_CHAR (charset, row, i - 1), - cat, printcharfun); - first = -1; - i--; - } + case CHARTAB_RANGE_ROW: + return vector2 (XCHARSET_NAME (Fget_charset (range->charset)), + make_int (range->row)); +#endif + case CHARTAB_RANGE_CHAR: + return make_char (range->ch); + default: + abort (); } - - if (first != -1) - { - if (row == -1) - print_chartab_range (MAKE_CHAR (charset, first, 0), - MAKE_CHAR (charset, i - 1, 0), - cat, printcharfun); - else - print_chartab_range (MAKE_CHAR (charset, row, first), - MAKE_CHAR (charset, row, i - 1), - cat, printcharfun); - } + return Qnil; /* not reached */ } -static void -print_chartab_two_byte_charset (Lisp_Object charset, - Lisp_Char_Table_Entry *cte, - Lisp_Object printcharfun) +struct ptemap { - int i; - - for (i = 32; i < 128; i++) - { - Lisp_Object jen = cte->level2[i - 32]; + Lisp_Object printcharfun; + int first; +}; - if (!CHAR_TABLE_ENTRYP (jen)) - { - write_fmt_string_lisp (printcharfun, " [%s %d] %s", - 3, XCHARSET_NAME (charset), - make_int (i), jen); - } - else - print_chartab_charset_row (charset, i, XCHAR_TABLE_ENTRY (jen), - printcharfun); - } +static int +print_table_entry (struct chartab_range *range, Lisp_Object table, + Lisp_Object val, void *arg) +{ + struct ptemap *a = (struct ptemap *) arg; + struct gcpro gcpro1; + Lisp_Object lisprange; + if (!a->first) + write_c_string (a->printcharfun, " "); + a->first = 0; + lisprange = encode_char_table_range (range); + GCPRO1 (lisprange); + write_fmt_string_lisp (a->printcharfun, "%s %s", 2, lisprange, val); + UNGCPRO; + return 0; } -#endif /* MULE */ - static void print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { Lisp_Char_Table *ct = XCHAR_TABLE (obj); + struct chartab_range range; + struct ptemap arg; + + range.type = CHARTAB_RANGE_ALL; + arg.printcharfun = printcharfun; + arg.first = 1; write_fmt_string_lisp (printcharfun, "#s(char-table type %s data (", 1, char_table_type_to_symbol (ct->type)); - - /* Now write out the ASCII/Control-1 stuff. */ - { - int i; - int first = -1; - Lisp_Object val = Qunbound; - - for (i = 0; i < NUM_ASCII_CHARS; i++) - { - if (first == -1) - { - first = i; - val = ct->ascii[i]; - continue; - } - - if (!EQ (ct->ascii[i], val)) - { - print_chartab_range (first, i - 1, val, printcharfun); - first = -1; - i--; - } - } - - if (first != -1) - print_chartab_range (first, i - 1, val, printcharfun); - } + map_char_table (obj, &range, print_table_entry, &arg); + write_c_string (printcharfun, "))"); -#ifdef MULE - { - int i; - - for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES; - i++) - { - Lisp_Object ann = ct->level1[i - MIN_LEADING_BYTE]; - Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i); - - if (!CHARSETP (charset) || i == LEADING_BYTE_ASCII - || i == LEADING_BYTE_CONTROL_1) - continue; - if (!CHAR_TABLE_ENTRYP (ann)) - { - write_fmt_string_lisp (printcharfun, " %s %s", 2, - XCHARSET_NAME (charset), ann); - } - else - { - Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (ann); - if (XCHARSET_DIMENSION (charset) == 1) - print_chartab_charset_row (charset, -1, cte, printcharfun); - else - print_chartab_two_byte_charset (charset, cte, printcharfun); - } - } - } -#endif /* MULE */ - - write_c_string ("))", printcharfun); + /* #### need to print and read the default; but that will allow the + default to be modified, which we don't (yet) support -- but FSF does */ } static int @@ -393,7 +360,7 @@ return 0; #endif /* MULE */ - return 1; + return internal_equal (ct1->default_, ct2->default_, depth + 1); } static Hashcode @@ -401,12 +368,13 @@ { Lisp_Char_Table *ct = XCHAR_TABLE (obj); Hashcode hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS, - depth); + depth + 1); #ifdef MULE hashval = HASH2 (hashval, - internal_array_hash (ct->level1, NUM_LEADING_BYTES, depth)); + internal_array_hash (ct->level1, NUM_LEADING_BYTES, + depth + 1)); #endif /* MULE */ - return hashval; + return HASH2 (hashval, internal_hash (ct->default_, depth + 1)); } static const struct lrecord_description char_table_description[] = { @@ -474,6 +442,15 @@ } void +set_char_table_default (Lisp_Object table, Lisp_Object value) +{ + Lisp_Char_Table *ct = XCHAR_TABLE (table); + ct->default_ = value; + if (ct->type == CHAR_TABLE_TYPE_SYNTAX) + update_syntax_table (table); +} + +static void fill_char_table (Lisp_Char_Table *ct, Lisp_Object value) { int i; @@ -486,7 +463,7 @@ #endif /* MULE */ if (ct->type == CHAR_TABLE_TYPE_SYNTAX) - update_syntax_table (ct); + update_syntax_table (wrap_char_table (ct)); } DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /* @@ -495,6 +472,7 @@ (char_table)) { Lisp_Char_Table *ct; + Lisp_Object def; CHECK_CHAR_TABLE (char_table); ct = XCHAR_TABLE (char_table); @@ -502,24 +480,31 @@ switch (ct->type) { case CHAR_TABLE_TYPE_CHAR: - fill_char_table (ct, make_char (0)); + def = make_char (0); break; case CHAR_TABLE_TYPE_DISPLAY: case CHAR_TABLE_TYPE_GENERIC: #ifdef MULE case CHAR_TABLE_TYPE_CATEGORY: #endif /* MULE */ - fill_char_table (ct, Qnil); + def = Qnil; break; case CHAR_TABLE_TYPE_SYNTAX: - fill_char_table (ct, make_int (Sinherit)); + def = make_int (Sinherit); break; default: abort (); + def = Qnil; + break; } + /* Avoid doubly updating the syntax table by setting the default ourselves, + since set_char_table_default() also updates. */ + ct->default_ = def; + fill_char_table (ct, Qunbound); + return Qnil; } @@ -552,7 +537,7 @@ To create a char table, use `make-char-table'. To modify a char table, use `put-char-table' or `remove-char-table'. To retrieve the value for a particular character, use `get-char-table'. -See also `map-char-table', `clear-char-table', `copy-char-table', +See also `map-char-table', `reset-char-table', `copy-char-table', `char-table-p', `valid-char-table-type-p', `char-table-type-list', `valid-char-table-value-p', and `check-char-table-value'. @@ -590,9 +575,10 @@ ct->type = ty; if (ty == CHAR_TABLE_TYPE_SYNTAX) { + /* Qgeneric not Qsyntax because a syntax table has a mirror table + and we don't want infinite recursion */ ct->mirror_table = Fmake_char_table (Qgeneric); - fill_char_table (XCHAR_TABLE (ct->mirror_table), - make_int (Spunct)); + set_char_table_default (ct->mirror_table, make_int (Spunct)); } else ct->mirror_table = Qnil; @@ -700,70 +686,18 @@ return obj; } -static void -decode_char_table_range (Lisp_Object range, struct chartab_range *outrange) -{ - if (EQ (range, Qt)) - outrange->type = CHARTAB_RANGE_ALL; - else if (CHAR_OR_CHAR_INTP (range)) - { - outrange->type = CHARTAB_RANGE_CHAR; - outrange->ch = XCHAR_OR_CHAR_INT (range); - } -#ifndef MULE - else - sferror ("Range must be t or a character", range); -#else /* MULE */ - else if (VECTORP (range)) - { - Lisp_Vector *vec = XVECTOR (range); - Lisp_Object *elts = vector_data (vec); - if (vector_length (vec) != 2) - sferror ("Length of charset row vector must be 2", - range); - outrange->type = CHARTAB_RANGE_ROW; - outrange->charset = Fget_charset (elts[0]); - CHECK_INT (elts[1]); - outrange->row = XINT (elts[1]); - switch (XCHARSET_TYPE (outrange->charset)) - { - case CHARSET_TYPE_94: - case CHARSET_TYPE_96: - sferror ("Charset in row vector must be multi-byte", - outrange->charset); - case CHARSET_TYPE_94X94: - check_int_range (outrange->row, 33, 126); - break; - case CHARSET_TYPE_96X96: - check_int_range (outrange->row, 32, 127); - break; - default: - abort (); - } - } - else - { - if (!CHARSETP (range) && !SYMBOLP (range)) - sferror - ("Char table range must be t, charset, char, or vector", range); - outrange->type = CHARTAB_RANGE_CHARSET; - outrange->charset = Fget_charset (range); - } -#endif /* MULE */ -} - #ifdef MULE -/* called from CHAR_TABLE_VALUE(). */ +/* called from get_char_table(). */ Lisp_Object get_non_ascii_char_table_value (Lisp_Char_Table *ct, int leading_byte, - Emchar c) + Emchar c) { Lisp_Object val; - Lisp_Object charset = CHARSET_BY_LEADING_BYTE (leading_byte); + Lisp_Object charset = charset_by_leading_byte (leading_byte); int byte1, byte2; - BREAKUP_CHAR_1_UNSAFE (c, charset, byte1, byte2); + BREAKUP_EMCHAR_1_UNSAFE (c, charset, byte1, byte2); val = ct->level1[leading_byte - MIN_LEADING_BYTE]; if (CHAR_TABLE_ENTRYP (val)) { @@ -783,46 +717,31 @@ #endif /* MULE */ -Lisp_Object -get_char_table (Emchar ch, Lisp_Char_Table *ct) +DEFUN ("char-table-default", Fchar_table_default, 1, 1, 0, /* +Return the default value for CHAR-TABLE. When an entry for a character +does not exist, the default is returned. +*/ + (char_table)) { -#ifdef MULE - { - Lisp_Object charset; - int byte1, byte2; - Lisp_Object val; - - BREAKUP_CHAR (ch, charset, byte1, byte2); - - if (EQ (charset, Vcharset_ascii)) - val = ct->ascii[byte1]; - else if (EQ (charset, Vcharset_control_1)) - val = ct->ascii[byte1 + 128]; - else - { - int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE; - val = ct->level1[lb]; - if (CHAR_TABLE_ENTRYP (val)) - { - Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val); - val = cte->level2[byte1 - 32]; - if (CHAR_TABLE_ENTRYP (val)) - { - cte = XCHAR_TABLE_ENTRY (val); - assert (byte2 >= 32); - val = cte->level2[byte2 - 32]; - assert (!CHAR_TABLE_ENTRYP (val)); - } - } - } - - return val; - } -#else /* not MULE */ - return ct->ascii[(unsigned char)ch]; -#endif /* not MULE */ + CHECK_CHAR_TABLE (char_table); + return XCHAR_TABLE (char_table)->default_; } +DEFUN ("set-char-table-default", Fset_char_table_default, 2, 2, 0, /* +Set the default value for CHAR-TABLE to DEFAULT. +Currently, the default value for syntax tables cannot be changed. +(This policy might change in the future.) +*/ + (char_table, default_)) +{ + CHECK_CHAR_TABLE (char_table); + if (XCHAR_TABLE_TYPE (char_table) == CHAR_TABLE_TYPE_SYNTAX) + invalid_change ("Can't change default for syntax tables", char_table); + check_valid_char_table_value (default_, XCHAR_TABLE_TYPE (char_table), + ERROR_ME); + set_char_table_default (char_table, default_); + return Qnil; +} DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /* Find value for CHARACTER in CHAR-TABLE. @@ -832,7 +751,113 @@ CHECK_CHAR_TABLE (char_table); CHECK_CHAR_COERCE_INT (character); - return get_char_table (XCHAR (character), XCHAR_TABLE (char_table)); + return get_char_table (XCHAR (character), char_table); +} + +static int +copy_mapper (struct chartab_range *range, Lisp_Object table, + Lisp_Object val, void *arg) +{ + put_char_table (VOID_TO_LISP (arg), range, val); + return 0; +} + +void +copy_char_table_range (Lisp_Object from, Lisp_Object to, + struct chartab_range *range) +{ + map_char_table (from, range, copy_mapper, LISP_TO_VOID (to)); +} + +Lisp_Object +get_range_char_table (struct chartab_range *range, Lisp_Object table, + Lisp_Object multi) +{ + Lisp_Char_Table *ct = XCHAR_TABLE (table); + Lisp_Object retval = Qnil; + + switch (range->type) + { + case CHARTAB_RANGE_CHAR: + return get_char_table (range->ch, table); + + case CHARTAB_RANGE_ALL: + { + int i; + retval = ct->ascii[0]; + + for (i = 1; i < NUM_ASCII_CHARS; i++) + if (!EQ (retval, ct->ascii[i])) + return multi; + +#ifdef MULE + for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES; + i++) + { + if (!CHARSETP (charset_by_leading_byte (i)) + || i == LEADING_BYTE_ASCII + || i == LEADING_BYTE_CONTROL_1) + continue; + if (!EQ (retval, ct->level1[i - MIN_LEADING_BYTE])) + return multi; + } +#endif /* MULE */ + + break; + } + +#ifdef MULE + case CHARTAB_RANGE_CHARSET: + if (EQ (range->charset, Vcharset_ascii)) + { + int i; + retval = ct->ascii[0]; + + for (i = 1; i < 128; i++) + if (!EQ (retval, ct->ascii[i])) + return multi; + break; + } + + if (EQ (range->charset, Vcharset_control_1)) + { + int i; + retval = ct->ascii[128]; + + for (i = 129; i < 160; i++) + if (!EQ (retval, ct->ascii[i])) + return multi; + break; + } + + { + retval = ct->level1[XCHARSET_LEADING_BYTE (range->charset) - + MIN_LEADING_BYTE]; + if (CHAR_TABLE_ENTRYP (retval)) + return multi; + break; + } + + case CHARTAB_RANGE_ROW: + { + retval = ct->level1[XCHARSET_LEADING_BYTE (range->charset) - + MIN_LEADING_BYTE]; + if (!CHAR_TABLE_ENTRYP (retval)) + break; + retval = XCHAR_TABLE_ENTRY (retval)->level2[range->row - 32]; + if (CHAR_TABLE_ENTRYP (retval)) + return multi; + break; + } +#endif /* not MULE */ + + default: + abort (); + } + + if (UNBOUNDP (retval)) + return ct->default_; + return retval; } DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /* @@ -841,94 +866,16 @@ */ (range, char_table, multi)) { - Lisp_Char_Table *ct; struct chartab_range rainj; if (CHAR_OR_CHAR_INTP (range)) return Fget_char_table (range, char_table); CHECK_CHAR_TABLE (char_table); - ct = XCHAR_TABLE (char_table); decode_char_table_range (range, &rainj); - switch (rainj.type) - { - case CHARTAB_RANGE_ALL: - { - int i; - Lisp_Object first = ct->ascii[0]; - - for (i = 1; i < NUM_ASCII_CHARS; i++) - if (!EQ (first, ct->ascii[i])) - return multi; - -#ifdef MULE - for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES; - i++) - { - if (!CHARSETP (CHARSET_BY_LEADING_BYTE (i)) - || i == LEADING_BYTE_ASCII - || i == LEADING_BYTE_CONTROL_1) - continue; - if (!EQ (first, ct->level1[i - MIN_LEADING_BYTE])) - return multi; - } -#endif /* MULE */ - - return first; - } - -#ifdef MULE - case CHARTAB_RANGE_CHARSET: - if (EQ (rainj.charset, Vcharset_ascii)) - { - int i; - Lisp_Object first = ct->ascii[0]; - - for (i = 1; i < 128; i++) - if (!EQ (first, ct->ascii[i])) - return multi; - return first; - } - - if (EQ (rainj.charset, Vcharset_control_1)) - { - int i; - Lisp_Object first = ct->ascii[128]; - - for (i = 129; i < 160; i++) - if (!EQ (first, ct->ascii[i])) - return multi; - return first; - } - - { - Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) - - MIN_LEADING_BYTE]; - if (CHAR_TABLE_ENTRYP (val)) - return multi; - return val; - } - - case CHARTAB_RANGE_ROW: - { - Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) - - MIN_LEADING_BYTE]; - if (!CHAR_TABLE_ENTRYP (val)) - return val; - val = XCHAR_TABLE_ENTRY (val)->level2[rainj.row - 32]; - if (CHAR_TABLE_ENTRYP (val)) - return multi; - return val; - } -#endif /* not MULE */ - - default: - abort (); - } - - return Qnil; /* not (usually) reached */ + return get_range_char_table (&rainj, char_table, multi); } - + static int check_valid_char_table_value (Lisp_Object value, enum char_table_type type, Error_Behavior errb) @@ -1024,12 +971,14 @@ return Qnil; } -/* Assign VAL to all characters in RANGE in char table CT. */ +/* Assign VAL to all characters in RANGE in char table TABLE. */ void -put_char_table (Lisp_Char_Table *ct, struct chartab_range *range, +put_char_table (Lisp_Object table, struct chartab_range *range, Lisp_Object val) { + Lisp_Char_Table *ct = XCHAR_TABLE (table); + switch (range->type) { case CHARTAB_RANGE_ALL: @@ -1077,7 +1026,7 @@ Lisp_Object charset; int byte1, byte2; - BREAKUP_CHAR (range->ch, charset, byte1, byte2); + BREAKUP_EMCHAR (range->ch, charset, byte1, byte2); if (EQ (charset, Vcharset_ascii)) ct->ascii[byte1] = val; else if (EQ (charset, Vcharset_control_1)) @@ -1115,7 +1064,7 @@ } if (ct->type == CHAR_TABLE_TYPE_SYNTAX) - update_syntax_table (ct); + update_syntax_table (wrap_char_table (ct)); } DEFUN ("put-char-table", Fput_char_table, 3, 3, 0, /* @@ -1143,36 +1092,76 @@ check_valid_char_table_value (value, ct->type, ERROR_ME); decode_char_table_range (range, &rainj); value = canonicalize_char_table_value (value, ct->type); - put_char_table (ct, &rainj, value); + put_char_table (char_table, &rainj, value); + return Qnil; +} + +DEFUN ("remove-char-table", Fremove_char_table, 2, 2, 0, /* +Remove any value from chars in RANGE in CHAR-TABLE. + +RANGE specifies one or more characters to be affected and should be +one of the following: + +-- t (all characters are affected) +-- A charset (only allowed when Mule support is present) +-- A vector of two elements: a two-octet charset and a row number + (only allowed when Mule support is present) +-- A single character + +With the values removed, the default value will be returned. +*/ + (range, char_table)) +{ + struct chartab_range rainj; + + CHECK_CHAR_TABLE (char_table); + decode_char_table_range (range, &rainj); + put_char_table (char_table, &rainj, Qunbound); return Qnil; } /* Map FN over the ASCII chars in CT. */ static int +map_over_charset_ascii_1 (Lisp_Char_Table *ct, + int start, int stop, + int (*fn) (struct chartab_range *range, + Lisp_Object table, Lisp_Object val, + void *arg), + void *arg) +{ + struct chartab_range rainj; + int i, retval; + + rainj.type = CHARTAB_RANGE_CHAR; + + for (i = start, retval = 0; i <= stop && retval == 0; i++) + { + rainj.ch = (Emchar) i; + if (!UNBOUNDP (ct->ascii[i])) + retval = (fn) (&rainj, wrap_char_table (ct), ct->ascii[i], arg); + } + + return retval; +} + + +/* Map FN over the ASCII chars in CT. */ + +static int map_over_charset_ascii (Lisp_Char_Table *ct, int (*fn) (struct chartab_range *range, - Lisp_Object val, void *arg), + Lisp_Object table, Lisp_Object val, + void *arg), void *arg) { - struct chartab_range rainj; - int i, retval; - int start = 0; + return map_over_charset_ascii_1 (ct, 0, #ifdef MULE - int stop = 128; + 127, #else - int stop = 256; + 255, #endif - - rainj.type = CHARTAB_RANGE_CHAR; - - for (i = start, retval = 0; i < stop && retval == 0; i++) - { - rainj.ch = (Emchar) i; - retval = (fn) (&rainj, ct->ascii[i], arg); - } - - return retval; + fn, arg); } #ifdef MULE @@ -1182,23 +1171,11 @@ static int map_over_charset_control_1 (Lisp_Char_Table *ct, int (*fn) (struct chartab_range *range, - Lisp_Object val, void *arg), + Lisp_Object table, Lisp_Object val, + void *arg), void *arg) { - struct chartab_range rainj; - int i, retval; - int start = 128; - int stop = start + 32; - - rainj.type = CHARTAB_RANGE_CHAR; - - for (i = start, retval = 0; i < stop && retval == 0; i++) - { - rainj.ch = (Emchar) (i); - retval = (fn) (&rainj, ct->ascii[i], arg); - } - - return retval; + return map_over_charset_ascii_1 (ct, 128, 159, fn, arg); } /* Map FN over the row ROW of two-byte charset CHARSET. @@ -1206,39 +1183,45 @@ CTE specifies the char table entry for CHARSET. */ static int -map_over_charset_row (Lisp_Char_Table_Entry *cte, +map_over_charset_row (Lisp_Char_Table *ct, + Lisp_Char_Table_Entry *cte, Lisp_Object charset, int row, int (*fn) (struct chartab_range *range, - Lisp_Object val, void *arg), + Lisp_Object table, Lisp_Object val, + void *arg), void *arg) { Lisp_Object val = cte->level2[row - 32]; - if (!CHAR_TABLE_ENTRYP (val)) + if (UNBOUNDP (val)) + return 0; + else if (!CHAR_TABLE_ENTRYP (val)) { struct chartab_range rainj; - + rainj.type = CHARTAB_RANGE_ROW; rainj.charset = charset; rainj.row = row; - return (fn) (&rainj, val, arg); + return (fn) (&rainj, wrap_char_table (ct), val, arg); } else { struct chartab_range rainj; int i, retval; - int charset94_p = (XCHARSET_CHARS (charset) == 94); - int start = charset94_p ? 33 : 32; - int stop = charset94_p ? 127 : 128; + int start, stop; + + get_charset_limits (charset, &start, &stop); cte = XCHAR_TABLE_ENTRY (val); rainj.type = CHARTAB_RANGE_CHAR; - for (i = start, retval = 0; i < stop && retval == 0; i++) + for (i = start, retval = 0; i <= stop && retval == 0; i++) { - rainj.ch = MAKE_CHAR (charset, row, i); - retval = (fn) (&rainj, cte->level2[i - 32], arg); + rainj.ch = make_emchar (charset, row, i); + if (!UNBOUNDP (cte->level2[i - 32])) + retval = (fn) (&rainj, wrap_char_table (ct), cte->level2[i - 32], + arg); } return retval; } @@ -1248,48 +1231,51 @@ static int map_over_other_charset (Lisp_Char_Table *ct, int lb, int (*fn) (struct chartab_range *range, - Lisp_Object val, void *arg), + Lisp_Object table, Lisp_Object val, + void *arg), void *arg) { Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE]; - Lisp_Object charset = CHARSET_BY_LEADING_BYTE (lb); + Lisp_Object charset = charset_by_leading_byte (lb); if (!CHARSETP (charset) || lb == LEADING_BYTE_ASCII || lb == LEADING_BYTE_CONTROL_1) return 0; + if (UNBOUNDP (val)) + return 0; if (!CHAR_TABLE_ENTRYP (val)) { struct chartab_range rainj; rainj.type = CHARTAB_RANGE_CHARSET; rainj.charset = charset; - return (fn) (&rainj, val, arg); + return (fn) (&rainj, wrap_char_table (ct), val, arg); } - { Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val); - int charset94_p = (XCHARSET_CHARS (charset) == 94); - int start = charset94_p ? 33 : 32; - int stop = charset94_p ? 127 : 128; + int start, stop; int i, retval; + get_charset_limits (charset, &start, &stop); if (XCHARSET_DIMENSION (charset) == 1) { struct chartab_range rainj; rainj.type = CHARTAB_RANGE_CHAR; - for (i = start, retval = 0; i < stop && retval == 0; i++) + for (i = start, retval = 0; i <= stop && retval == 0; i++) { - rainj.ch = MAKE_CHAR (charset, i, 0); - retval = (fn) (&rainj, cte->level2[i - 32], arg); + rainj.ch = make_emchar (charset, i, 0); + if (!UNBOUNDP (cte->level2[i - 32])) + retval = (fn) (&rainj, wrap_char_table (ct), cte->level2[i - 32], + arg); } } else { - for (i = start, retval = 0; i < stop && retval == 0; i++) - retval = map_over_charset_row (cte, charset, i, fn, arg); + for (i = start, retval = 0; i <= stop && retval == 0; i++) + retval = map_over_charset_row (ct, cte, charset, i, fn, arg); } return retval; @@ -1300,15 +1286,20 @@ /* Map FN (with client data ARG) over range RANGE in char table CT. Mapping stops the first time FN returns non-zero, and that value - becomes the return value of map_char_table(). */ + becomes the return value of map_char_table(). + + #### This mapping code is way ugly. The FSF version, in contrast, + is short and sweet, and much more recursive. There should be some way + of cleaning this up. */ int -map_char_table (Lisp_Char_Table *ct, +map_char_table (Lisp_Object table, struct chartab_range *range, int (*fn) (struct chartab_range *range, - Lisp_Object val, void *arg), + Lisp_Object table, Lisp_Object val, void *arg), void *arg) { + Lisp_Char_Table *ct = XCHAR_TABLE (table); switch (range->type) { case CHARTAB_RANGE_ALL: @@ -1347,31 +1338,38 @@ { Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE]; - if (!CHAR_TABLE_ENTRYP (val)) + + if (CHAR_TABLE_ENTRYP (val)) + return map_over_charset_row (ct, XCHAR_TABLE_ENTRY (val), + range->charset, range->row, fn, arg); + else if (!UNBOUNDP (val)) { struct chartab_range rainj; rainj.type = CHARTAB_RANGE_ROW; rainj.charset = range->charset; rainj.row = range->row; - return (fn) (&rainj, val, arg); + return (fn) (&rainj, table, val, arg); } else - return map_over_charset_row (XCHAR_TABLE_ENTRY (val), - range->charset, range->row, - fn, arg); + return 0; } #endif /* MULE */ case CHARTAB_RANGE_CHAR: { Emchar ch = range->ch; - Lisp_Object val = CHAR_TABLE_VALUE_UNSAFE (ct, ch); + Lisp_Object val = get_char_table (ch, table); struct chartab_range rainj; - rainj.type = CHARTAB_RANGE_CHAR; - rainj.ch = ch; - return (fn) (&rainj, val, arg); + if (!UNBOUNDP (val)) + { + rainj.type = CHARTAB_RANGE_CHAR; + rainj.ch = ch; + return (fn) (&rainj, table, val, arg); + } + else + return 0; } default: @@ -1389,36 +1387,13 @@ static int slow_map_char_table_fun (struct chartab_range *range, - Lisp_Object val, void *arg) + Lisp_Object table, Lisp_Object val, void *arg) { - Lisp_Object ranjarg = Qnil; struct slow_map_char_table_arg *closure = (struct slow_map_char_table_arg *) arg; - switch (range->type) - { - case CHARTAB_RANGE_ALL: - ranjarg = Qt; - break; - -#ifdef MULE - case CHARTAB_RANGE_CHARSET: - ranjarg = XCHARSET_NAME (range->charset); - break; - - case CHARTAB_RANGE_ROW: - ranjarg = vector2 (XCHARSET_NAME (range->charset), - make_int (range->row)); - break; -#endif /* MULE */ - case CHARTAB_RANGE_CHAR: - ranjarg = make_char (range->ch); - break; - default: - abort (); - } - - closure->retval = call2 (closure->function, ranjarg, val); + closure->retval = call2 (closure->function, encode_char_table_range (range), + val); return !NILP (closure->retval); } @@ -1432,20 +1407,18 @@ */ (function, char_table, range)) { - Lisp_Char_Table *ct; struct slow_map_char_table_arg slarg; struct gcpro gcpro1, gcpro2; struct chartab_range rainj; CHECK_CHAR_TABLE (char_table); - ct = XCHAR_TABLE (char_table); if (NILP (range)) range = Qt; decode_char_table_range (range, &rainj); slarg.function = function; slarg.retval = Qnil; GCPRO2 (slarg.function, slarg.retval); - map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg); + map_char_table (char_table, &rainj, slow_map_char_table_fun, &slarg); UNGCPRO; return slarg.retval; @@ -1466,6 +1439,8 @@ return 1; } +/* #### Document the print/read format; esp. what's this cons element? */ + static int chartab_data_validate (Lisp_Object keyword, Lisp_Object value, Error_Behavior errb) @@ -1600,11 +1575,9 @@ int designator, int not_p) { REGISTER Lisp_Object temp; - Lisp_Char_Table *ctbl; if (NILP (Fcategory_table_p (table))) wtaerror ("Expected category table", table); - ctbl = XCHAR_TABLE (table); - temp = get_char_table (ch, ctbl); + temp = get_char_table (ch, table); if (NILP (temp)) return not_p; @@ -1720,8 +1693,7 @@ #define CATEGORYP(x) \ (CHARP (x) && XCHAR (x) >= 0x20 && XCHAR (x) <= 0x7E) -#define CATEGORY_SET(c) \ - (get_char_table(c, XCHAR_TABLE(current_buffer->category_table))) +#define CATEGORY_SET(c) get_char_table (c, current_buffer->category_table) /* Return 1 if CATEGORY_SET contains CATEGORY, else return 0. The faster version of `!NILP (Faref (category_set, category))'. */ @@ -1733,7 +1705,6 @@ Use the macro WORD_BOUNDARY_P instead of calling this function directly. */ -int word_boundary_p (Emchar c1, Emchar c2); int word_boundary_p (Emchar c1, Emchar c2) { @@ -1748,7 +1719,7 @@ c2 = cmpchar_component (c2, 0, 1); #endif - if (EQ (CHAR_CHARSET (c1), CHAR_CHARSET (c2))) + if (EQ (emchar_charset (c1), emchar_charset (c2))) { tail = Vword_separating_categories; default_result = 0; @@ -1802,6 +1773,8 @@ DEFSUBR (Fchar_table_type_list); DEFSUBR (Fvalid_char_table_type_p); DEFSUBR (Fchar_table_type); + DEFSUBR (Fchar_table_default); + DEFSUBR (Fset_char_table_default); DEFSUBR (Freset_char_table); DEFSUBR (Fmake_char_table); DEFSUBR (Fcopy_char_table); @@ -1810,6 +1783,7 @@ DEFSUBR (Fvalid_char_table_value_p); DEFSUBR (Fcheck_valid_char_table_value); DEFSUBR (Fput_char_table); + DEFSUBR (Fremove_char_table); DEFSUBR (Fmap_char_table); #ifdef MULE
--- a/src/chartab.h Thu May 02 14:35:32 2002 +0000 +++ b/src/chartab.h Sun May 05 11:33:57 2002 +0000 @@ -83,7 +83,7 @@ struct lcrecord_header header; Lisp_Object ascii[NUM_ASCII_CHARS]; - Lisp_Object default_; /* #### not yet implemented */ + Lisp_Object default_; Lisp_Object parent; /* #### not yet implemented */ #ifdef MULE @@ -134,38 +134,37 @@ #define CHAR_TABLE_TYPE(ct) ((ct)->type) #define XCHAR_TABLE_TYPE(ct) CHAR_TABLE_TYPE (XCHAR_TABLE (ct)) -#ifdef MULE - Lisp_Object get_non_ascii_char_table_value (Lisp_Char_Table *ct, int leading_byte, Emchar c); -INLINE_HEADER Lisp_Object -CHAR_TABLE_NON_ASCII_VALUE_UNSAFE (Lisp_Char_Table *ct, Emchar ch); -INLINE_HEADER Lisp_Object -CHAR_TABLE_NON_ASCII_VALUE_UNSAFE (Lisp_Char_Table *ct, Emchar ch) +DECLARE_INLINE_HEADER ( +Lisp_Object +get_char_table (Emchar ch, Lisp_Object table) +) { - unsigned char lb = CHAR_LEADING_BYTE (ch); - if (!CHAR_TABLE_ENTRYP ((ct)->level1[lb - MIN_LEADING_BYTE])) - return (ct)->level1[lb - MIN_LEADING_BYTE]; + Lisp_Object retval; + Lisp_Char_Table *ct = XCHAR_TABLE (table); +#ifdef MULE + if (ch < NUM_ASCII_CHARS) + retval = ct->ascii[ch]; else - return get_non_ascii_char_table_value (ct, lb, ch); + { + unsigned char lb = emchar_leading_byte (ch); + if (!CHAR_TABLE_ENTRYP (ct->level1[lb - MIN_LEADING_BYTE])) + retval = ct->level1[lb - MIN_LEADING_BYTE]; + else + retval = get_non_ascii_char_table_value (ct, lb, ch); + } +#else /* not MULE */ + retval = ct->ascii[(unsigned char) ch]; +#endif /* not MULE */ + if (!UNBOUNDP (retval)) + return retval; + else + return ct->default_; } -#define CHAR_TABLE_VALUE_UNSAFE(ct, ch) \ - ((ch) < NUM_ASCII_CHARS \ - ? (ct)->ascii[ch] \ - : CHAR_TABLE_NON_ASCII_VALUE_UNSAFE (ct, ch)) - -#else /* not MULE */ - -#define CHAR_TABLE_VALUE_UNSAFE(ct, ch) ((ct)->ascii[(unsigned char) (ch)]) - -#endif /* not MULE */ - -#define XCHAR_TABLE_VALUE_UNSAFE(ct, ch) \ - CHAR_TABLE_VALUE_UNSAFE (XCHAR_TABLE (ct), ch) - enum chartab_range_type { CHARTAB_RANGE_ALL, @@ -184,16 +183,21 @@ int row; }; -void fill_char_table (Lisp_Char_Table *ct, Lisp_Object value); -void put_char_table (Lisp_Char_Table *ct, struct chartab_range *range, +void set_char_table_default (Lisp_Object table, Lisp_Object value); +void put_char_table (Lisp_Object table, struct chartab_range *range, Lisp_Object val); -Lisp_Object get_char_table (Emchar, Lisp_Char_Table *); -int map_char_table (Lisp_Char_Table *ct, +int map_char_table (Lisp_Object table, struct chartab_range *range, int (*fn) (struct chartab_range *range, + Lisp_Object table, Lisp_Object val, void *arg), void *arg); void prune_syntax_tables (void); +Lisp_Object get_range_char_table (struct chartab_range *range, + Lisp_Object table, Lisp_Object multi); +void copy_char_table_range (Lisp_Object from, Lisp_Object to, + struct chartab_range *range); +int word_boundary_p (Emchar c1, Emchar c2); EXFUN (Fcopy_char_table, 1); EXFUN (Fmake_char_table, 1); @@ -205,8 +209,8 @@ #ifdef MULE -int check_category_char(Emchar ch, Lisp_Object ctbl, - int designator, int not_p); +int check_category_char (Emchar ch, Lisp_Object ctbl, int designator, + int not_p); extern Lisp_Object Vstandard_category_table;
--- a/src/cmds.c Thu May 02 14:35:32 2002 +0000 +++ b/src/cmds.c Sun May 05 11:33:57 2002 +0000 @@ -1,5 +1,6 @@ /* Simple built-in editing commands. Copyright (C) 1985, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. + Copyright (C) 2002 Ben Wing. This file is part of XEmacs. @@ -370,12 +371,12 @@ REGISTER enum syntaxcode synt; REGISTER Emchar c2; Lisp_Object overwrite; - Lisp_Char_Table *syntax_table; + Lisp_Object syntax_table; struct buffer *buf = current_buffer; int tab_width; overwrite = buf->overwrite_mode; - syntax_table = XCHAR_TABLE (buf->mirror_syntax_table); + syntax_table = buf->mirror_syntax_table; #if 0 /* No, this is very bad, it makes undo *always* undo a character at a time @@ -440,7 +441,7 @@ } } if ((CHAR_TABLEP (Vauto_fill_chars) - ? !NILP (XCHAR_TABLE_VALUE_UNSAFE (Vauto_fill_chars, c1)) + ? !NILP (get_char_table (c1, Vauto_fill_chars)) : (c1 == ' ' || c1 == '\n')) && !noautofill && !NILP (buf->auto_fill_function))
--- a/src/console-msw.h Thu May 02 14:35:32 2002 +0000 +++ b/src/console-msw.h Sun May 05 11:33:57 2002 +0000 @@ -1,7 +1,7 @@ /* Define mswindows-specific console, device, and frame object for XEmacs. Copyright (C) 1989, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. - Copyright (C) 2001 Ben Wing. + Copyright (C) 2001, 2002 Ben Wing. This file is part of XEmacs.
--- a/src/console-stream.c Thu May 02 14:35:32 2002 +0000 +++ b/src/console-stream.c Sun May 05 11:33:57 2002 +0000 @@ -217,9 +217,9 @@ static void stream_clear_region (Lisp_Object window, struct device* d, struct frame * f, - face_index findex, int x, int y, - int width, int height, Lisp_Object fcolor, Lisp_Object bcolor, - Lisp_Object background_pixmap) + face_index findex, int x, int y, + int width, int height, Lisp_Object fcolor, + Lisp_Object bcolor, Lisp_Object background_pixmap) { } @@ -233,8 +233,14 @@ stream_ring_bell (struct device *d, int volume, int pitch, int duration) { struct console *c = XCONSOLE (DEVICE_CONSOLE (d)); - fputc (07, CONSOLE_STREAM_DATA (c)->out); - fflush (CONSOLE_STREAM_DATA (c)->out); + /* Don't output ^G when not a TTY -- in particular, under MS Windows, ^G + is interpreted as bell by the console, but not when running under + VC++. Probably this would be the same under Unix. */ + if (isatty (fileno (CONSOLE_STREAM_DATA (c)->out))) + { + fputc (07, CONSOLE_STREAM_DATA (c)->out); + fflush (CONSOLE_STREAM_DATA (c)->out); + } }
--- a/src/console-x.c Thu May 02 14:35:32 2002 +0000 +++ b/src/console-x.c Sun May 05 11:33:57 2002 +0000 @@ -193,7 +193,7 @@ connection = x_device_to_console_connection (connection, errb); /* Check for a couple of standard special cases */ - if (XSTRING_CHAR (connection, 0) == ':') + if (string_emchar (connection, 0) == ':') connection = concat2 (build_string ("localhost"), connection); else {
--- a/src/console.c Thu May 02 14:35:32 2002 +0000 +++ b/src/console.c Sun May 05 11:33:57 2002 +0000 @@ -553,7 +553,7 @@ { Lisp_Object console; - VOID_TO_LISP (console, closure); + console = VOID_TO_LISP (closure); if (FRAME_MINIBUF_ONLY_P (XFRAME (frame))) return 0; if (EQ (console, FRAME_CONSOLE (XFRAME (frame))))
--- a/src/console.h Thu May 02 14:35:32 2002 +0000 +++ b/src/console.h Sun May 05 11:33:57 2002 +0000 @@ -487,10 +487,10 @@ #define CONSOLE_TYPE_P(con, type) EQ (CONSOLE_TYPE (con), Q##type) #ifdef ERROR_CHECK_TYPES -INLINE_HEADER struct console * -error_check_console_type (struct console *con, Lisp_Object sym); -INLINE_HEADER struct console * +DECLARE_INLINE_HEADER ( +struct console * error_check_console_type (struct console *con, Lisp_Object sym) +) { assert (EQ (CONSOLE_TYPE (con), sym)); return con;
--- a/src/data.c Thu May 02 14:35:32 2002 +0000 +++ b/src/data.c Sun May 05 11:33:57 2002 +0000 @@ -79,12 +79,13 @@ { /* #### It would be really nice if this were a proper warning instead of brain-dead print ro Qexternal_debugging_output. */ - write_c_string ("Comparison between integer and character is constant nil (", - Qexternal_debugging_output); + write_c_string + (Qexternal_debugging_output, + "Comparison between integer and character is constant nil ("); Fprinc (obj1, Qexternal_debugging_output); - write_c_string (" and ", Qexternal_debugging_output); + write_c_string (Qexternal_debugging_output, " and "); Fprinc (obj2, Qexternal_debugging_output); - write_c_string (")\n", Qexternal_debugging_output); + write_c_string (Qexternal_debugging_output, ")\n"); debug_short_backtrace (debug_ebola_backtrace_length); } return EQ (obj1, obj2); @@ -721,8 +722,8 @@ } else if (STRINGP (array)) { - if (idx >= XSTRING_CHAR_LENGTH (array)) goto range_error; - return make_char (XSTRING_CHAR (array, idx)); + if (idx >= string_char_length (array)) goto range_error; + return make_char (string_emchar (array, idx)); } #ifdef LOSING_BYTECODE else if (COMPILED_FUNCTIONP (array)) @@ -779,7 +780,7 @@ else if (STRINGP (array)) { CHECK_CHAR_COERCE_INT (newval); - if (idx >= XSTRING_CHAR_LENGTH (array)) goto range_error; + if (idx >= string_char_length (array)) goto range_error; set_string_char (array, idx, XCHAR (newval)); bump_string_modiff (array); }
--- a/src/device-msw.c Thu May 02 14:35:32 2002 +0000 +++ b/src/device-msw.c Sun May 05 11:33:57 2002 +0000 @@ -1075,7 +1075,7 @@ if (print_readably) printing_unreadable_object ("#<msprinter-settings 0x%x>", dm->header.uid); - write_c_string ("#<msprinter-settings", printcharfun); + write_c_string (printcharfun, "#<msprinter-settings"); if (!NILP (dm->printer_name)) write_fmt_string_lisp (printcharfun, " for %S", 1, dm->printer_name); if (!NILP (dm->device))
--- a/src/device.c Thu May 02 14:35:32 2002 +0000 +++ b/src/device.c Sun May 05 11:33:57 2002 +0000 @@ -643,7 +643,7 @@ { Lisp_Object device; - VOID_TO_LISP (device, closure); + device = VOID_TO_LISP (closure); if (FRAME_MINIBUF_ONLY_P (XFRAME (frame))) return 0; if (EQ (device, FRAME_DEVICE (XFRAME (frame))))
--- a/src/device.h Thu May 02 14:35:32 2002 +0000 +++ b/src/device.h Sun May 05 11:33:57 2002 +0000 @@ -39,7 +39,7 @@ int low_x_coord, high_x_coord, col, obj_x; int low_y_coord, high_y_coord, row, obj_y; struct window *w; - Charbpos charbpos; + Charbpos charpos; Charbpos closest; Charcount modeline_closest; Lisp_Object obj1, obj2; @@ -157,10 +157,10 @@ #define DEVICE_TYPE_P(d, type) EQ (DEVICE_TYPE (d), Q##type) #ifdef ERROR_CHECK_TYPES -INLINE_HEADER struct device * -error_check_device_type (struct device *d, Lisp_Object sym); -INLINE_HEADER struct device * +DECLARE_INLINE_HEADER ( +struct device * error_check_device_type (struct device *d, Lisp_Object sym) +) { assert (EQ (DEVICE_TYPE (d), sym)); return d;
--- a/src/dialog-msw.c Thu May 02 14:35:32 2002 +0000 +++ b/src/dialog-msw.c Sun May 05 11:33:57 2002 +0000 @@ -194,7 +194,7 @@ case WM_DESTROY: { Lisp_Object data; - VOID_TO_LISP (data, qxeGetWindowLong (hwnd, DWL_USER)); + data = VOID_TO_LISP ((void *) qxeGetWindowLong (hwnd, DWL_USER)); Vdialog_data_list = delq_no_quit (data, Vdialog_data_list); } break; @@ -204,7 +204,7 @@ Lisp_Object fn, arg, data; struct mswindows_dialog_id *did; - VOID_TO_LISP (data, qxeGetWindowLong (hwnd, DWL_USER)); + data = VOID_TO_LISP ((void *) qxeGetWindowLong (hwnd, DWL_USER)); did = XMSWINDOWS_DIALOG_ID (data); if (w_param != IDCANCEL) /* user pressed escape */ {
--- a/src/dialog-x.c Thu May 02 14:35:32 2002 +0000 +++ b/src/dialog-x.c Sun May 05 11:33:57 2002 +0000 @@ -52,7 +52,7 @@ { Lisp_Object text_field_callback; Extbyte *text_field_value = wv->value; - VOID_TO_LISP (text_field_callback, wv->call_data); + text_field_callback = VOID_TO_LISP (wv->call_data); text_field_callback = XCAR (XCDR (text_field_callback)); if (text_field_value) {
--- a/src/dired-msw.c Thu May 02 14:35:32 2002 +0000 +++ b/src/dired-msw.c Sun May 05 11:33:57 2002 +0000 @@ -76,6 +76,7 @@ #include "buffer.h" #include "regex.h" +#include "syntax.h" #include "sysdir.h" #include "sysfile.h" @@ -198,7 +199,7 @@ /* PATTERN might be a flawed regular expression. Rather than catching and signalling our own errors, we just call compile_pattern to do the work for us. */ - bufp = compile_pattern (pattern, 0, Qnil, 0, ERROR_ME); + bufp = compile_pattern (pattern, 0, Qnil, Qnil, 0, 0, ERROR_ME); } /* Now *bufp is the compiled form of PATTERN; don't call anything which might compile a new regexp until we're done with the loop! */ @@ -232,6 +233,8 @@ int result; WIN32_FIND_DATAW finddat; Win32_file file; + struct syntax_cache scache_struct; + struct syntax_cache *scache = &scache_struct; if (fh == INVALID_HANDLE_VALUE) { @@ -270,7 +273,7 @@ len = eilen (filename); result = (NILP (pattern) || (0 <= re_search (bufp, eidata (filename), - len, 0, len, 0))); + len, 0, len, 0, Qnil, 0, scache))); if (result) { if ( ! (eigetch_char (filename, 0) == '.' &&
--- a/src/dired.c Thu May 02 14:35:32 2002 +0000 +++ b/src/dired.c Sun May 05 11:33:57 2002 +0000 @@ -1,6 +1,6 @@ /* Lisp functions for making directory listings. Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 2001 Ben Wing. + Copyright (C) 2001, 2002 Ben Wing. This file is part of XEmacs. @@ -117,7 +117,7 @@ /* MATCH might be a flawed regular expression. Rather than catching and signalling our own errors, we just call compile_pattern to do the work for us. */ - bufp = compile_pattern (match, 0, Qnil, 0, ERROR_ME); + bufp = compile_pattern (match, 0, Qnil, Qnil, 0, 0, ERROR_ME); } /* Now *bufp is the compiled form of MATCH; don't call anything @@ -130,9 +130,6 @@ if (!d) report_file_error ("Opening directory", directory); - regex_match_object = Qt; - regex_emacs_buffer = current_buffer; - record_unwind_protect (close_directory_unwind, make_opaque_ptr ((void *)d)); /* Loop reading blocks */ @@ -140,13 +137,16 @@ { DIRENTRY *dp = qxe_readdir (d); int len; + struct syntax_cache scache_struct; + struct syntax_cache *scache = &scache_struct; if (!dp) break; len = NAMLEN (dp); if (DIRENTRY_NONEMPTY (dp) && (NILP (match) - || (0 <= re_search (bufp, dp->d_name, len, 0, len, 0)))) + || (0 <= re_search (bufp, dp->d_name, len, 0, len, 0, Qnil, 0, + scache)))) { if (!NILP (files_only)) { @@ -318,7 +318,7 @@ file = FILE_SYSTEM_CASE (file); #endif directory = Fexpand_file_name (directory, Qnil); - file_name_length = XSTRING_CHAR_LENGTH (file); + file_name_length = string_char_length (file); /* With passcount = 0, ignore files that end in an ignored extension. If nothing found then try again with passcount = 1, don't ignore them. @@ -399,12 +399,12 @@ CHECK_STRING (elt); - skip = cclen - XSTRING_CHAR_LENGTH (elt); + skip = cclen - string_char_length (elt); if (skip < 0) continue; if (0 > scmp (charptr_n_addr (d_name, skip), XSTRING_DATA (elt), - XSTRING_CHAR_LENGTH (elt))) + string_char_length (elt))) { ignored_extension_p = 1; break; @@ -440,7 +440,7 @@ else { bestmatch = name; - bestmatchsize = XSTRING_CHAR_LENGTH (name); + bestmatchsize = string_char_length (name); } NUNGCPRO; } @@ -461,7 +461,7 @@ of the actual match. */ if ((matchsize == cclen && matchsize + !!directoryp - < XSTRING_CHAR_LENGTH (bestmatch)) + < string_char_length (bestmatch)) || /* If there is no exact match ignoring case, prefer a match that does not change the case @@ -469,7 +469,7 @@ (((matchsize == cclen) == (matchsize + !!directoryp - == XSTRING_CHAR_LENGTH (bestmatch))) + == string_char_length (bestmatch))) /* If there is more than one exact match aside from case, and one of them is exact including case, prefer that one. */ @@ -616,7 +616,7 @@ CHECK_STRING (user); - user_name_length = XSTRING_CHAR_LENGTH (user); + user_name_length = string_char_length (user); /* Cache user name lookups because it tends to be quite slow. * Rebuild the cache occasionally to catch changes */ @@ -744,7 +744,7 @@ else { bestmatch = name; - bestmatchsize = XSTRING_CHAR_LENGTH (name); + bestmatchsize = string_char_length (name); } NUNGCPRO; }
--- a/src/doc.c Thu May 02 14:35:32 2002 +0000 +++ b/src/doc.c Sun May 05 11:33:57 2002 +0000 @@ -81,7 +81,7 @@ (i.e. files with non-ASCII/Latin-1 chars in them). Currently this is "solved" in bytecomp.el by never inserting lazy references in such files. */ - (XLSTREAM (fdstream), standard_doc_file ? Qundecided : Qbinary, + (XLSTREAM (fdstream), standard_doc_file ? Qescape_quoted : Qbinary, CODING_DECODE, 0); Lstream_set_buffering (XLSTREAM (instream), LSTREAM_UNBUFFERED, 0);
--- a/src/doprnt.c Thu May 02 14:35:32 2002 +0000 +++ b/src/doprnt.c Sun May 05 11:33:57 2002 +0000 @@ -597,7 +597,7 @@ a = (Emchar) arg.l; - if (!valid_char_p (a)) + if (!valid_emchar_p (a)) syntax_error ("invalid character value %d to %%c spec", make_char (a));
--- a/src/dumper.c Thu May 02 14:35:32 2002 +0000 +++ b/src/dumper.c Sun May 05 11:33:57 2002 +0000 @@ -1,7 +1,7 @@ /* Portable data dumper for XEmacs. Copyright (C) 1999-2000 Olivier Galibert Copyright (C) 2001 Martin Buchholz - Copyright (C) 2001 Ben Wing. + Copyright (C) 2001, 2002 Ben Wing. This file is part of XEmacs. @@ -152,7 +152,7 @@ (((type *) (ptr = (char*) (((type *) ptr) + 1)))[-1]) #define PDUMP_READ_ALIGNED(ptr, type) \ -((ptr = (char *) ALIGN_PTR (ptr, ALIGNOF (type))), PDUMP_READ (ptr, type)) +((ptr = (char *) ALIGN_PTR (ptr, type)), PDUMP_READ (ptr, type)) @@ -755,7 +755,7 @@ /* We have no way of knowing the required alignment for this structure, so just max it maximally aligned. */ - return ALIGN_SIZE (max_offset + size_at_max, ALIGNOF (max_align_t)); + return MAX_ALIGN_SIZE (max_offset + size_at_max); } /* Register the referenced objects in the array of COUNT objects of @@ -1355,11 +1355,11 @@ header.nb_root_struct_ptrs = Dynarr_length (pdump_root_struct_ptrs); header.nb_opaques = Dynarr_length (pdump_opaques); - cur_offset = ALIGN_SIZE (sizeof (header), ALIGNOF (max_align_t)); + cur_offset = MAX_ALIGN_SIZE (sizeof (header)); max_size = 0; pdump_scan_by_alignment (pdump_allocate_offset); - cur_offset = ALIGN_SIZE (cur_offset, ALIGNOF (max_align_t)); + cur_offset = MAX_ALIGN_SIZE (cur_offset); header.stab_offset = cur_offset; pdump_buf = xmalloc (max_size); @@ -1423,7 +1423,7 @@ p = pdump_start + header->stab_offset; /* Put back the pdump_root_struct_ptrs */ - p = (char *) ALIGN_PTR (p, ALIGNOF (pdump_static_pointer)); + p = (char *) ALIGN_PTR (p, pdump_static_pointer); for (i=0; i<header->nb_root_struct_ptrs; i++) { pdump_static_pointer ptr = PDUMP_READ (p, pdump_static_pointer); @@ -1444,7 +1444,7 @@ for (;;) { pdump_reloc_table rt = PDUMP_READ_ALIGNED (p, pdump_reloc_table); - p = (char *) ALIGN_PTR (p, ALIGNOF (char *)); + p = (char *) ALIGN_PTR (p, char *); if (rt.desc) { char **reloc = (char **)p; @@ -1461,7 +1461,7 @@ /* Put the pdump_root_objects variables in place */ i = PDUMP_READ_ALIGNED (p, Elemcount); - p = (char *) ALIGN_PTR (p, ALIGNOF (pdump_static_Lisp_Object)); + p = (char *) ALIGN_PTR (p, pdump_static_Lisp_Object); while (i--) { pdump_static_Lisp_Object obj = PDUMP_READ (p, pdump_static_Lisp_Object); @@ -1478,7 +1478,7 @@ for (;;) { pdump_reloc_table rt = PDUMP_READ_ALIGNED (p, pdump_reloc_table); - p = (char *) ALIGN_PTR (p, ALIGNOF (Lisp_Object)); + p = (char *) ALIGN_PTR (p, Lisp_Object); if (!rt.desc) break; if (rt.desc == hash_table_description)
--- a/src/editfns.c Thu May 02 14:35:32 2002 +0000 +++ b/src/editfns.c Sun May 05 11:33:57 2002 +0000 @@ -134,7 +134,7 @@ CHECK_STRING (string); if (XSTRING_LENGTH (string) != 0) - return make_char (XSTRING_CHAR (string, 0)); + return make_char (string_emchar (string, 0)); else /* This used to return Qzero. That is broken, broken, broken. */ /* It might be kinder to signal an error directly. -slb */ @@ -178,25 +178,6 @@ return b->point_marker; } -/* The following two functions end up being identical but it's - cleaner to declare them separately. */ - -Charbpos -charbpos_clip_to_bounds (Charbpos lower, Charbpos num, Charbpos upper) -{ - return (num < lower ? lower : - num > upper ? upper : - num); -} - -Bytebpos -bytebpos_clip_to_bounds (Bytebpos lower, Bytebpos num, Bytebpos upper) -{ - return (num < lower ? lower : - num > upper ? upper : - num); -} - /* * Chuck says: * There is no absolute way to determine if goto-char is the function @@ -1856,9 +1837,9 @@ mc_count = begin_multiple_change (buf, pos, stop); if (STRINGP (table)) { - Charcount size = XSTRING_CHAR_LENGTH (table); + Charcount size = string_char_length (table); #ifdef MULE - /* Under Mule, XSTRING_CHAR(n) is O(n), so for large tables or + /* Under Mule, string_emchar(n) is O(n), so for large tables or large regions it makes sense to create an array of Emchars. */ if (size * (stop - pos) > 65536) { @@ -1885,7 +1866,7 @@ { if (oc < size) { - Emchar nc = XSTRING_CHAR (table, oc); + Emchar nc = string_emchar (table, oc); if (nc != oc) { buffer_replace_char (buf, pos, nc, 0, 0); @@ -1917,7 +1898,7 @@ } else if (STRINGP (replacement)) { - Charcount incr = XSTRING_CHAR_LENGTH (replacement) - 1; + Charcount incr = string_char_length (replacement) - 1; buffer_delete_range (buf, pos, pos + 1, 0); buffer_insert_lisp_string_1 (buf, pos, replacement, 0); pos += incr, stop += incr; @@ -1935,11 +1916,10 @@ && (XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC || XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR)) { - Lisp_Char_Table *ctable = XCHAR_TABLE (table); for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++) { - Lisp_Object replacement = get_char_table (oc, ctable); + Lisp_Object replacement = get_char_table (oc, table); retry2: if (CHAR_OR_CHAR_INTP (replacement)) { @@ -1952,7 +1932,7 @@ } else if (STRINGP (replacement)) { - Charcount incr = XSTRING_CHAR_LENGTH (replacement) - 1; + Charcount incr = string_char_length (replacement) - 1; buffer_delete_range (buf, pos, pos + 1, 0); buffer_insert_lisp_string_1 (buf, pos, replacement, 0); pos += incr, stop += incr; @@ -1960,7 +1940,8 @@ } else if (!NILP (replacement)) { - replacement = wrong_type_argument (Qchar_or_string_p, replacement); + replacement = wrong_type_argument (Qchar_or_string_p, + replacement); goto retry2; } } @@ -1981,11 +1962,11 @@ (start, end, buffer)) { /* This function can GC */ - Charbpos bp_start, bp_end; + Charbpos char_start, char_end; struct buffer *buf = decode_buffer (buffer, 1); - get_buffer_range_char (buf, start, end, &bp_start, &bp_end, 0); - buffer_delete_range (buf, bp_start, bp_end, 0); + get_buffer_range_char (buf, start, end, &char_start, &char_end, 0); + buffer_delete_range (buf, char_start, char_end, 0); return Qnil; } @@ -1995,12 +1976,12 @@ if (BUF_BEGV (b) != BUF_BEG (b)) { clip_changed = 1; - SET_BOTH_BUF_BEGV (b, BUF_BEG (b), BI_BUF_BEG (b)); + SET_BOTH_BUF_BEGV (b, BUF_BEG (b), BYTE_BUF_BEG (b)); } if (BUF_ZV (b) != BUF_Z (b)) { clip_changed = 1; - SET_BOTH_BUF_ZV (b, BUF_Z (b), BI_BUF_Z (b)); + SET_BOTH_BUF_ZV (b, BUF_Z (b), BYTE_BUF_Z (b)); } if (clip_changed) { @@ -2038,21 +2019,21 @@ */ (start, end, buffer)) { - Charbpos bp_start, bp_end; + Charbpos char_start, char_end; struct buffer *buf = decode_buffer (buffer, 1); - Bytebpos bi_start, bi_end; + Bytebpos byte_start, byte_end; - get_buffer_range_char (buf, start, end, &bp_start, &bp_end, + get_buffer_range_char (buf, start, end, &char_start, &char_end, GB_ALLOW_PAST_ACCESSIBLE); - bi_start = charbpos_to_bytebpos (buf, bp_start); - bi_end = charbpos_to_bytebpos (buf, bp_end); + byte_start = charbpos_to_bytebpos (buf, char_start); + byte_end = charbpos_to_bytebpos (buf, char_end); - SET_BOTH_BUF_BEGV (buf, bp_start, bi_start); - SET_BOTH_BUF_ZV (buf, bp_end, bi_end); - if (BUF_PT (buf) < bp_start) - BUF_SET_PT (buf, bp_start); - if (BUF_PT (buf) > bp_end) - BUF_SET_PT (buf, bp_end); + SET_BOTH_BUF_BEGV (buf, char_start, byte_start); + SET_BOTH_BUF_ZV (buf, char_end, byte_end); + if (BUF_PT (buf) < char_start) + BUF_SET_PT (buf, char_start); + if (BUF_PT (buf) > char_end) + BUF_SET_PT (buf, char_end); MARK_CLIP_CHANGED; /* Changing the buffer bounds invalidates any recorded current column. */ invalidate_current_column (); @@ -2104,24 +2085,24 @@ { Charbpos start, end; - Bytebpos bi_start, bi_end; + Bytebpos byte_start, byte_end; start = BUF_BEG (buf) + newhead; end = BUF_Z (buf) - newtail; - bi_start = charbpos_to_bytebpos (buf, start); - bi_end = charbpos_to_bytebpos (buf, end); + byte_start = charbpos_to_bytebpos (buf, start); + byte_end = charbpos_to_bytebpos (buf, end); if (BUF_BEGV (buf) != start) { local_clip_changed = 1; - SET_BOTH_BUF_BEGV (buf, start, bi_start); + SET_BOTH_BUF_BEGV (buf, start, byte_start); narrow_line_number_cache (buf); } if (BUF_ZV (buf) != end) { local_clip_changed = 1; - SET_BOTH_BUF_ZV (buf, end, bi_end); + SET_BOTH_BUF_ZV (buf, end, byte_end); } } if (local_clip_changed)
--- a/src/elhash.c Thu May 02 14:35:32 2002 +0000 +++ b/src/elhash.c Sun May 05 11:33:57 2002 +0000 @@ -314,16 +314,16 @@ int count = 0; hentry *e, *sentinel; - write_c_string (" data (", printcharfun); + write_c_string (printcharfun, " data ("); for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) if (!HENTRY_CLEAR_P (e)) { if (count > 0) - write_c_string (" ", printcharfun); + write_c_string (printcharfun, " "); if (!print_readably && count > 3) { - write_c_string ("...", printcharfun); + write_c_string (printcharfun, "..."); break; } print_internal (e->key, printcharfun, 1); @@ -331,7 +331,7 @@ count++; } - write_c_string (")", printcharfun); + write_c_string (printcharfun, ")"); } static void @@ -339,16 +339,16 @@ { Lisp_Hash_Table *ht = XHASH_TABLE (obj); - write_c_string (print_readably ? "#s(hash-table" : "#<hash-table", - printcharfun); + write_c_string (printcharfun, + print_readably ? "#s(hash-table" : "#<hash-table"); /* These checks have a kludgy look to them, but they are safe. Due to nature of hashing, you cannot use arbitrary test functions anyway. */ if (!ht->test_function) - write_c_string (" test eq", printcharfun); + write_c_string (printcharfun, " test eq"); else if (ht->test_function == lisp_object_equal_equal) - write_c_string (" test equal", printcharfun); + write_c_string (printcharfun, " test equal"); else if (ht->test_function == lisp_object_eql_equal) DO_NOTHING; else @@ -378,7 +378,7 @@ print_hash_table_data (ht, printcharfun); if (print_readably) - write_c_string (")", printcharfun); + write_c_string (printcharfun, ")"); else { write_fmt_string (printcharfun, " 0x%x>", ht->header.uid); @@ -1611,7 +1611,7 @@ } #if 0 -xxDEFUN ("internal-hash-value", Finternal_hash_value, 1, 1, 0, /* +DEFUN ("internal-hash-value", Finternal_hash_value, 1, 1, 0, /* Hash value of OBJECT. For debugging. The value is returned as (HIGH . LOW). */
--- a/src/emacs.c Thu May 02 14:35:32 2002 +0000 +++ b/src/emacs.c Sun May 05 11:33:57 2002 +0000 @@ -130,7 +130,7 @@ version 21.5.3 "asparagus" released September 7, 2001. version 21.5.4 "bamboo" released January 8, 2002. version 21.5.5 "beets" released March 5, 2002. - +version 21.5.6 "bok choi" released April 5, 2002. -- A time line for GNU Emacs version 19 is @@ -280,7 +280,7 @@ /* For PATH_EXEC */ #include <paths.h> -#if defined (HEAP_IN_DATA) && !defined(PDUMP) +#if defined (HEAP_IN_DATA) && !defined (PDUMP) void report_sheap_usage (int die_if_pure_storage_exceeded); #endif @@ -495,6 +495,10 @@ static DWORD mswindows_handle_hardware_exceptions (DWORD code); #endif +#ifdef WIN32_NATIVE +static DWORD CALLBACK wait_for_termination_signal (LPVOID handle); +#endif + /************************************************************************/ /* Functions to handle arguments */ @@ -877,6 +881,30 @@ } #ifdef WIN32_NATIVE + { + /* Since we aren't a console application, we can't easily be terminated + using ^C. (We aren't a console application to avoid Windows from + automatically and unwantedly creating a console window for us. If + only the Windows designers had some sense in them and didn't create + this artificial console/non-console distinction!) Therefore, we set + up a communication path with i.exe so that when a ^C is sent to it + (using GenerateConsoleCtrlEvent), it in turn signals us to commit + suicide. (This is cleaner than using TerminateProcess()). This + makes (e.g.) the "Stop Build" command from VC++ correctly terminate + XEmacs. */ + + char *heventstr; + if (argmatch (argv, argc, "-mswindows-termination-handle", 0, 0, + &heventstr, &skip_args)) + { + HANDLE hevent = (HANDLE) atol (heventstr); + DWORD unused; + HANDLE h_thread = CreateThread (NULL, 0, wait_for_termination_signal, + (void *) hevent, 0, &unused); + CloseHandle (h_thread); + } + } + /* Handle the -nuni switch, which forces XEmacs to use the ANSI versions of Unicode-split API's even on Windows NT, which has full Unicode support. This helps flush out problems in the code @@ -1204,7 +1232,9 @@ #endif /* CLASH_DETECTION */ syms_of_floatfns (); syms_of_fns (); +#ifdef USE_C_FONT_LOCK syms_of_font_lock (); +#endif /* USE_C_FONT_LOCK */ syms_of_frame (); syms_of_general (); syms_of_glyphs (); @@ -1707,7 +1737,9 @@ #endif vars_of_floatfns (); vars_of_fns (); +#ifdef USE_C_FONT_LOCK vars_of_font_lock (); +#endif /* USE_C_FONT_LOCK */ vars_of_frame (); vars_of_glyphs (); vars_of_glyphs_eimage (); @@ -1979,7 +2011,7 @@ knows what. */ complex_vars_of_chartab (); - /* This calls set_string_char(), which (under Mule) depends on the + /* This calls Fput_char_table(), which (under Mule) depends on the charsets being initialized. */ complex_vars_of_casetab (); @@ -2094,7 +2126,9 @@ reinit_vars_of_extents (); reinit_vars_of_file_coding (); reinit_vars_of_fileio (); +#ifdef USE_C_FONT_LOCK reinit_vars_of_font_lock (); +#endif /* USE_C_FONT_LOCK */ reinit_vars_of_glyphs (); reinit_vars_of_glyphs_widget (); reinit_vars_of_insdel (); @@ -2341,8 +2375,9 @@ { "-t", "--terminal", 100, 1 }, { "-nd", "--no-dump-file", 95, 0 }, { "-nw", "--no-windows", 90, 0 }, - { "-batch", "--batch", 85, 0 }, + { "-batch", "--batch", 88, 0 }, #ifdef WIN32_NATIVE + { "-mswindows-termination-handle", 0, 84, 1 }, { "-nuni", "--no-unicode-lib-calls", 83, 0 }, #endif /* WIN32_NATIVE */ { "-debug-paths", "--debug-paths", 82, 0 }, @@ -3060,6 +3095,18 @@ } #endif +#ifdef WIN32_NATIVE + +static DWORD CALLBACK +wait_for_termination_signal (LPVOID handle) +{ + HANDLE hevent = (HANDLE) handle; + WaitForSingleObject (hevent, INFINITE); + ExitProcess (0); + return 0; /* not reached */ +} + +#endif /* -------------------------------- */ /* a (more-or-less) normal shutdown */ /* -------------------------------- */
--- a/src/eval.c Thu May 02 14:35:32 2002 +0000 +++ b/src/eval.c Sun May 05 11:33:57 2002 +0000 @@ -298,9 +298,9 @@ if (print_readably) printing_unreadable_object ("%s%s%s", header, name, trailer); - write_c_string (header, printcharfun); - write_c_string (name, printcharfun); - write_c_string (trailer, printcharfun); + write_c_string (printcharfun, header); + write_c_string (printcharfun, name); + write_c_string (printcharfun, trailer); } static const struct lrecord_description subr_description[] = { @@ -1176,7 +1176,7 @@ ((INTP (documentation) && XINT (documentation) < 0) || (STRINGP (documentation) && - (XSTRING_BYTE (documentation, 0) == '*')) || + (string_byte (documentation, 0) == '*')) || /* If (STRING . INTEGER), a negative integer means a user variable. */ (CONSP (documentation) @@ -5310,19 +5310,18 @@ || specpdl[speccount - 1].func == specbind_unwind_local || specpdl[speccount - 1].func == specbind_unwind_wasnt_local) { - write_c_string (((!printing_bindings) ? " # bind (" : " "), - stream); + write_c_string (stream, !printing_bindings ? " # bind (" : " "); Fprin1 (specpdl[speccount - 1].symbol, stream); printing_bindings = 1; } else { - if (printing_bindings) write_c_string (")\n", stream); - write_c_string (" # (unwind-protect ...)\n", stream); + if (printing_bindings) write_c_string (stream, ")\n"); + write_c_string (stream, " # (unwind-protect ...)\n"); printing_bindings = 0; } } - if (printing_bindings) write_c_string (")\n", stream); + if (printing_bindings) write_c_string (stream, ")\n"); } DEFUN ("backtrace", Fbacktrace, 0, 2, "", /* @@ -5380,15 +5379,15 @@ speccount = catches->pdlcount; if (catchpdl == speccount) { - write_c_string (" # (catch ", stream); + write_c_string (stream, " # (catch "); Fprin1 (catches->tag, stream); - write_c_string (" ...)\n", stream); + write_c_string (stream, " ...)\n"); } else { - write_c_string (" # (condition-case ... . ", stream); + write_c_string (stream, " # (condition-case ... . "); Fprin1 (Fcdr (Fcar (catches->tag)), stream); - write_c_string (")\n", stream); + write_c_string (stream, ")\n"); } catches = catches->next; } @@ -5401,18 +5400,17 @@ backtrace_specials (speccount, backlist->pdlcount, stream); speccount = backlist->pdlcount; } - write_c_string (((backlist->debug_on_exit) ? "* " : " "), - stream); + write_c_string (stream, backlist->debug_on_exit ? "* " : " "); if (backlist->nargs == UNEVALLED) { Fprin1 (Fcons (*backlist->function, *backlist->args), stream); - write_c_string ("\n", stream); /* from FSFmacs 19.30 */ + write_c_string (stream, "\n"); /* from FSFmacs 19.30 */ } else { Lisp_Object tem = *backlist->function; Fprin1 (tem, stream); /* This can QUIT */ - write_c_string ("(", stream); + write_c_string (stream, "("); if (backlist->nargs == MANY) { int i; @@ -5424,7 +5422,7 @@ !NILP (tail); tail = Fcdr (tail), i++) { - if (i != 0) write_c_string (" ", stream); + if (i != 0) write_c_string (stream, " "); Fprin1 (Fcar (tail), stream); } NUNGCPRO; @@ -5434,15 +5432,16 @@ int i; for (i = 0; i < backlist->nargs; i++) { - if (!i && EQ(tem, Qbyte_code)) { - write_c_string("\"...\"", stream); - continue; - } - if (i != 0) write_c_string (" ", stream); + if (!i && EQ (tem, Qbyte_code)) + { + write_c_string (stream, "\"...\""); + continue; + } + if (i != 0) write_c_string (stream, " "); Fprin1 (backlist->args[i], stream); } } - write_c_string (")\n", stream); + write_c_string (stream, ")\n"); } backlist = backlist->next; }
--- a/src/event-Xt.c Thu May 02 14:35:32 2002 +0000 +++ b/src/event-Xt.c Sun May 05 11:33:57 2002 +0000 @@ -181,7 +181,7 @@ #ifdef MULE Lisp_Object charset = Qzero; #define USE_CHARSET(var,cs) \ - ((var) = CHARSET_BY_LEADING_BYTE (LEADING_BYTE_##cs)) + ((var) = charset_by_leading_byte (LEADING_BYTE_##cs)) #else #define USE_CHARSET(var,lb) #endif /* MULE */ @@ -286,7 +286,7 @@ return Qnil; #ifdef MULE - return make_char (MAKE_CHAR (charset, code, 0)); + return make_char (make_emchar (charset, code, 0)); #else return make_char (code + 0x80); #endif @@ -1868,8 +1868,8 @@ { Lisp_Object console = CDFW_CONSOLE (EVENT_CHANNEL (event)); if (CONSOLE_X_P (XCONSOLE (console))) - write_c_string (x_event_name (event->event.magic.underlying_x_event.type), - pstream); + write_c_string + (pstream, x_event_name (event->event.magic.underlying_x_event.type)); } static int
--- a/src/event-gtk.c Thu May 02 14:35:32 2002 +0000 +++ b/src/event-gtk.c Sun May 05 11:33:57 2002 +0000 @@ -209,8 +209,9 @@ { Lisp_Object console = CDFW_CONSOLE (EVENT_CHANNEL (emacs_event)); if (CONSOLE_GTK_P (XCONSOLE (console))) - write_c_string (gtk_event_name (emacs_event->event.magic.underlying_gdk_event.type), - pstream); + write_c_string + (pstream, + gtk_event_name (emacs_event->event.magic.underlying_gdk_event.type)); } static int
--- a/src/event-msw.c Thu May 02 14:35:32 2002 +0000 +++ b/src/event-msw.c Sun May 05 11:33:57 2002 +0000 @@ -3251,7 +3251,7 @@ if (ii) { Lisp_Object image_instance; - VOID_TO_LISP (image_instance, ii); + image_instance = VOID_TO_LISP ((void *) ii); if (IMAGE_INSTANCEP (image_instance) && IMAGE_INSTANCE_TYPE_P (image_instance, IMAGE_WIDGET)) @@ -3910,7 +3910,7 @@ assert (!NILP (Vmswindows_frame_being_created)); return Vmswindows_frame_being_created; } - VOID_TO_LISP (f, l); + f = VOID_TO_LISP ((void *) l); return f; } @@ -3990,7 +3990,7 @@ emacs_mswindows_format_magic_event (Lisp_Event *emacs_event, Lisp_Object pstream) { -#define FROB(msg) case msg: write_c_string ("type=" #msg, pstream); break +#define FROB(msg) case msg: write_c_string (pstream, "type=" #msg); break switch (EVENT_MSWINDOWS_MAGIC_TYPE (emacs_event)) { @@ -4007,7 +4007,7 @@ if (!NILP (EVENT_CHANNEL (emacs_event))) { - write_c_string (" ", pstream); + write_c_string (pstream, " "); print_internal (EVENT_CHANNEL (emacs_event), pstream, 1); } }
--- a/src/event-stream.c Thu May 02 14:35:32 2002 +0000 +++ b/src/event-stream.c Sun May 05 11:33:57 2002 +0000 @@ -253,11 +253,11 @@ static void external_debugging_print_event (char *event_description, Lisp_Object event) { - write_c_string ("(", Qexternal_debugging_output); - write_c_string (event_description, Qexternal_debugging_output); - write_c_string (") ", Qexternal_debugging_output); + write_c_string (Qexternal_debugging_output, "("); + write_c_string (Qexternal_debugging_output, event_description); + write_c_string (Qexternal_debugging_output, ") "); print_internal (event, Qexternal_debugging_output, 1); - write_c_string ("\n", Qexternal_debugging_output); + write_c_string (Qexternal_debugging_output, "\n"); } #define DEBUG_PRINT_EMACS_EVENT(event_description, event) do { \ if (debug_emacs_events) \ @@ -3382,7 +3382,7 @@ { Lisp_Object keysym = XEVENT (builder->most_current_event)->event.key.keysym; - if (CHARP (keysym) && !CHAR_ASCII_P (XCHAR (keysym))) + if (CHARP (keysym) && !emchar_ascii_p (XCHAR (keysym))) return Vcomposed_character_default_binding; } #endif @@ -4542,7 +4542,7 @@ Bytecount len = set_charptr_emchar (str, ch); Lstream_write (XLSTREAM (Vdribble_file), str, len); } - else if (XSTRING_CHAR_LENGTH (XSYMBOL (keysym)->name) == 1) + else if (string_char_length (XSYMBOL (keysym)->name) == 1) /* one-char key events are printed with just the key name */ Fprinc (keysym, Vdribble_file); else if (EQ (keysym, Qreturn))
--- a/src/events.c Thu May 02 14:35:32 2002 +0000 +++ b/src/events.c Sun May 05 11:33:57 2002 +0000 @@ -138,9 +138,9 @@ print_event_1 (const char *str, Lisp_Object obj, Lisp_Object printcharfun) { DECLARE_EISTRING_MALLOC (ei); - write_c_string (str, printcharfun); + write_c_string (printcharfun, str); format_event_object (ei, XEVENT (obj), 0); - write_eistring (ei, printcharfun); + write_eistring (printcharfun, ei); eifree (ei); } @@ -183,7 +183,7 @@ write_fmt_string_lisp (printcharfun, "#<timeout-event %S", 1, XEVENT (obj)->event.timeout.object); break; case empty_event: - write_c_string ("#<empty-event", printcharfun); + write_c_string (printcharfun, "#<empty-event"); break; case misc_user_event: write_fmt_string_lisp (printcharfun, "#<misc-user-event (%S", 1, XEVENT (obj)->event.misc.function); @@ -194,13 +194,13 @@ write_fmt_string_lisp (printcharfun, " %S)", 1, XEVENT (obj)->event.eval.object); break; case dead_event: - write_c_string ("#<DEALLOCATED-EVENT", printcharfun); + write_c_string (printcharfun, "#<DEALLOCATED-EVENT"); break; default: - write_c_string ("#<UNKNOWN-EVENT-TYPE", printcharfun); + write_c_string (printcharfun, "#<UNKNOWN-EVENT-TYPE"); break; } - write_c_string (">", printcharfun); + write_c_string (printcharfun, ">"); } static int @@ -1187,7 +1187,7 @@ if (STRINGP (seq)) { - Emchar ch = XSTRING_CHAR (seq, n); + Emchar ch = string_emchar (seq, n); Fcharacter_to_event (make_char (ch), event, Qnil, Qnil); } else @@ -1344,7 +1344,7 @@ #if 0 /* debugging functions */ -xxDEFUN ("event-next", Fevent_next, 1, 1, 0, /* +DEFUN ("event-next", Fevent_next, 1, 1, 0, /* Return the event object's `next' event, or nil if it has none. The `next-event' field is changed by calling `set-next-event'. */ @@ -1356,7 +1356,7 @@ return XEVENT_NEXT (event); } -xxDEFUN ("set-event-next", Fset_event_next, 2, 2, 0, /* +DEFUN ("set-event-next", Fset_event_next, 2, 2, 0, /* Set the `next event' of EVENT to NEXT-EVENT. NEXT-EVENT must be an event object or nil. */
--- a/src/events.h Thu May 02 14:35:32 2002 +0000 +++ b/src/events.h Sun May 05 11:33:57 2002 +0000 @@ -585,7 +585,6 @@ then Alt generates XEMACS_MOD_META instead. */ -#ifdef emacs /* Maybe this should be trickier */ #define KEYSYM(x) (intern (x)) @@ -715,7 +714,6 @@ first console is tty, even if HAVE_X_WINDOWS is defined */ /* #define DEBUG_TTY_EVENT_STREAM */ -#endif /* emacs */ /* #### a hack, until accelerator shit is cleaned up */
--- a/src/extents.c Thu May 02 14:35:32 2002 +0000 +++ b/src/extents.c Sun May 05 11:33:57 2002 +0000 @@ -265,7 +265,7 @@ /* Convert a "memory position" (i.e. taking the gap into account) into the address of the element at (i.e. after) that position. "Memory - positions" are only used internally and are of type Membpos. + positions" are only used internally and are of type Memxpos. "Array positions" are used externally and are of type int. */ #define GAP_ARRAY_MEMEL_ADDR(ga, memel) ((ga)->array + (ga)->elsize*(memel)) @@ -358,7 +358,7 @@ typedef struct stack_of_extents { Extent_List *extents; - Membpos pos; /* Position of stack of extents. EXTENTS is the list of + Memxpos pos; /* Position of stack of extents. EXTENTS is the list of all extents that overlap this position. This position can be -1 if the stack of extents is invalid (this happens when a buffer is first created or a string's @@ -370,31 +370,27 @@ /* map-extents */ /* ------------------------------- */ +typedef int (*map_extents_fun) (EXTENT extent, void *arg); + typedef int Endpoint_Index; -#define membpos_to_startind(x, start_open) \ +#define memxpos_to_startind(x, start_open) \ ((Endpoint_Index) (((x) << 1) + !!(start_open))) -#define membpos_to_endind(x, end_open) \ +#define memxpos_to_endind(x, end_open) \ ((Endpoint_Index) (((x) << 1) - !!(end_open))) -/* Combination macros */ -#define bytebpos_to_startind(buf, x, start_open) \ - membpos_to_startind (bytebpos_to_membpos (buf, x), start_open) -#define bytebpos_to_endind(buf, x, end_open) \ - membpos_to_endind (bytebpos_to_membpos (buf, x), end_open) - /* ------------------------------- */ /* buffer-or-string primitives */ /* ------------------------------- */ -/* Similar for Bytebposs and start/end indices. */ - -#define buffer_or_string_bytebpos_to_startind(obj, ind, start_open) \ - membpos_to_startind (buffer_or_string_bytebpos_to_membpos (obj, ind), \ +/* Similar for Bytebpos's and start/end indices. */ + +#define buffer_or_string_bytexpos_to_startind(obj, ind, start_open) \ + memxpos_to_startind (buffer_or_string_bytexpos_to_memxpos (obj, ind), \ start_open) -#define buffer_or_string_bytebpos_to_endind(obj, ind, end_open) \ - membpos_to_endind (buffer_or_string_bytebpos_to_membpos (obj, ind), \ +#define buffer_or_string_bytexpos_to_endind(obj, ind, end_open) \ + memxpos_to_endind (buffer_or_string_bytexpos_to_memxpos (obj, ind), \ end_open) /* ------------------------------- */ @@ -448,23 +444,26 @@ Lisp_Object Qcopy_function; Lisp_Object Qpaste_function; -/* The idea here is that if we're given a list of faces, we - need to "memoize" this so that two lists of faces that are `equal' - turn into the same object. When `set-extent-face' is called, we - "memoize" into a list of actual faces; when `extent-face' is called, - we do a reverse lookup to get the list of symbols. */ - static Lisp_Object canonicalize_extent_property (Lisp_Object prop, Lisp_Object value); + +typedef struct +{ + Lisp_Object key, value; +} Lisp_Object_pair; +typedef struct +{ + Dynarr_declare (Lisp_Object_pair); +} Lisp_Object_pair_dynarr; + +static void extent_properties (EXTENT e, Lisp_Object_pair_dynarr *props); + Lisp_Object Vextent_face_memoize_hash_table; Lisp_Object Vextent_face_reverse_memoize_hash_table; Lisp_Object Vextent_face_reusable_list; /* FSFmacs bogosity */ Lisp_Object Vdefault_text_properties; -EXFUN (Fextent_properties, 1); -EXFUN (Fset_extent_property, 3); - /* if true, we don't want to set any redisplay flags on modeline extent changes */ int in_modeline_generation; @@ -487,8 +486,8 @@ adjust_markers() in insdel.c. */ static void -gap_array_adjust_markers (Gap_Array *ga, Membpos from, - Membpos to, int amount) +gap_array_adjust_markers (Gap_Array *ga, Memxpos from, + Memxpos to, int amount) { Gap_Array_Marker *m; @@ -511,7 +510,7 @@ memmove (GAP_ARRAY_MEMEL_ADDR (ga, pos + gapsize), GAP_ARRAY_MEMEL_ADDR (ga, pos), (gap - pos)*ga->elsize); - gap_array_adjust_markers (ga, (Membpos) pos, (Membpos) gap, + gap_array_adjust_markers (ga, (Memxpos) pos, (Memxpos) gap, gapsize); } else if (pos > gap) @@ -519,8 +518,8 @@ memmove (GAP_ARRAY_MEMEL_ADDR (ga, gap), GAP_ARRAY_MEMEL_ADDR (ga, gap + gapsize), (pos - gap)*ga->elsize); - gap_array_adjust_markers (ga, (Membpos) (gap + gapsize), - (Membpos) (pos + gapsize), - gapsize); + gap_array_adjust_markers (ga, (Memxpos) (gap + gapsize), + (Memxpos) (pos + gapsize), - gapsize); } ga->gap = pos; } @@ -775,7 +774,7 @@ position at the beginning or end of the extent list is returned. */ static int -extent_list_locate_from_pos (Extent_List *el, Membpos pos, int endp) +extent_list_locate_from_pos (Extent_List *el, Memxpos pos, int endp) { struct extent fake_extent; /* @@ -799,7 +798,7 @@ /* Return the extent at POS. */ static EXTENT -extent_list_at (Extent_List *el, Membpos pos, int endp) +extent_list_at (Extent_List *el, Memxpos pos, int endp) { Gap_Array *ga = endp ? el->end : el->start; @@ -1299,9 +1298,9 @@ return; } sel = soe->extents; - printf ("SOE pos is %d (membpos %d)\n", + printf ("SOE pos is %d (memxpos %d)\n", soe->pos < 0 ? soe->pos : - buffer_or_string_membpos_to_bytebpos (obj, soe->pos), + buffer_or_string_memxpos_to_bytexpos (obj, soe->pos), soe->pos); for (endp = 0; endp < 2; endp++) { @@ -1376,7 +1375,7 @@ /* Move OBJ's stack of extents to lie over the specified position. */ static void -soe_move (Lisp_Object obj, Membpos pos) +soe_move (Lisp_Object obj, Memxpos pos) { Stack_Of_Extents *soe = buffer_or_string_stack_of_extents_force (obj); Extent_List *sel = soe->extents; @@ -1390,10 +1389,10 @@ #endif #ifdef SOE_DEBUG - printf ("Moving SOE from %d (membpos %d) to %d (membpos %d)\n", + printf ("Moving SOE from %d (memxpos %d) to %d (memxpos %d)\n", soe->pos < 0 ? soe->pos : - buffer_or_string_membpos_to_bytebpos (obj, soe->pos), soe->pos, - buffer_or_string_membpos_to_bytebpos (obj, pos), pos); + buffer_or_string_memxpos_to_bytexpos (obj, soe->pos), soe->pos, + buffer_or_string_memxpos_to_bytexpos (obj, pos), pos); #endif if (soe->pos < pos) { @@ -1534,43 +1533,126 @@ /* Return the start (endp == 0) or end (endp == 1) of an extent as a byte index. If you want the value as a memory index, use extent_endpoint(). If you want the value as a buffer position, - use extent_endpoint_charbpos(). */ - -static Bytebpos -extent_endpoint_bytebpos (EXTENT extent, int endp) + use extent_endpoint_char(). */ + +Bytexpos +extent_endpoint_byte (EXTENT extent, int endp) +{ + assert (EXTENT_LIVE_P (extent)); + assert (!extent_detached_p (extent)); + { + Memxpos i = endp ? extent_end (extent) : extent_start (extent); + Lisp_Object obj = extent_object (extent); + return buffer_or_string_memxpos_to_bytexpos (obj, i); + } +} + +Charxpos +extent_endpoint_char (EXTENT extent, int endp) { assert (EXTENT_LIVE_P (extent)); assert (!extent_detached_p (extent)); { - Membpos i = endp ? extent_end (extent) : extent_start (extent); + Memxpos i = endp ? extent_end (extent) : extent_start (extent); Lisp_Object obj = extent_object (extent); - return buffer_or_string_membpos_to_bytebpos (obj, i); + return buffer_or_string_memxpos_to_charxpos (obj, i); } } -static Charbpos -extent_endpoint_charbpos (EXTENT extent, int endp) -{ - assert (EXTENT_LIVE_P (extent)); - assert (!extent_detached_p (extent)); - { - Membpos i = endp ? extent_end (extent) : extent_start (extent); - Lisp_Object obj = extent_object (extent); - return buffer_or_string_membpos_to_charbpos (obj, i); - } -} - -/* A change to an extent occurred that will change the display, so - notify redisplay. Maybe also recurse over all the extent's - descendants. */ - static void -extent_changed_for_redisplay (EXTENT extent, int descendants_too, - int invisibility_change) -{ - Lisp_Object object; - Lisp_Object rest; - +signal_single_extent_changed (EXTENT extent, Lisp_Object property, + Bytexpos old_start, Bytexpos old_end) +{ + EXTENT anc = extent_ancestor (extent); + /* Redisplay checks */ + if (NILP (property) ? + (!NILP (extent_face (anc)) || + !NILP (extent_begin_glyph (anc)) || + !NILP (extent_end_glyph (anc)) || + !NILP (extent_mouse_face (anc)) || + !NILP (extent_invisible (anc)) || + !NILP (extent_initial_redisplay_function (anc))) : + EQ (property, Qface) || + EQ (property, Qmouse_face) || + EQ (property, Qbegin_glyph) || + EQ (property, Qend_glyph) || + EQ (property, Qbegin_glyph_layout) || + EQ (property, Qend_glyph_layout) || + EQ (property, Qinvisible) || + EQ (property, Qinitial_redisplay_function) || + EQ (property, Qpriority)) + { + Lisp_Object object = extent_object (extent); + + if (extent_detached_p (extent)) + return; + + else if (STRINGP (object)) + { + /* #### Changes to string extents can affect redisplay if they are + in the modeline or in the gutters. + + If the extent is in some generated-modeline-string: when we + change an extent in generated-modeline-string, this changes its + parent, which is in `modeline-format', so we should force the + modeline to be updated. But how to determine whether a string + is a `generated-modeline-string'? Looping through all buffers + is not very efficient. Should we add all + `generated-modeline-string' strings to a hash table? Maybe + efficiency is not the greatest concern here and there's no big + loss in looping over the buffers. + + If the extent is in a gutter we mark the gutter as + changed. This means (a) we can update extents in the gutters + when we need it. (b) we don't have to update the gutters when + only extents attached to buffers have changed. */ + + if (!in_modeline_generation) + MARK_EXTENTS_CHANGED; + gutter_extent_signal_changed_region_maybe + (object, extent_endpoint_char (extent, 0), + extent_endpoint_char (extent, 1)); + } + else if (BUFFERP (object)) + { + struct buffer *b; + b = XBUFFER (object); + BUF_FACECHANGE (b)++; + MARK_EXTENTS_CHANGED; + if (NILP (property) ? !NILP (extent_invisible (anc)) : + EQ (property, Qinvisible)) + MARK_CLIP_CHANGED; + buffer_extent_signal_changed_region + (b, extent_endpoint_char (extent, 0), + extent_endpoint_char (extent, 1)); + } + } + + /* Check for syntax table property change */ + if (NILP (property) ? !NILP (Fextent_property (wrap_extent (extent), + Qsyntax_table, Qnil)) : + EQ (property, Qsyntax_table)) + signal_syntax_table_extent_changed (extent); +} + +/* Make note that a change has happened in EXTENT. The change was either + to a property or to the endpoints (but not both at once). If PROPERTY + is non-nil, the change happened to that property; otherwise, the change + happened to the endpoints, and the old ones are given. Currently, all + endpoints changes are in the form of two signals, a detach followed by + an attach, and when detaching, we are signalled before the extent is + detached. (You can distinguish a detach from an attach because the + latter has old_start == -1 and old_end == -1.) (#### We don't currently + give the old property. If someone needs that, this will have to + change.) KLUDGE: If PROPERTY is Qt, all properties may have changed + because the parent was changed. #### We need to handle this properly, by + mapping over properties. */ + +static void +signal_extent_changed (EXTENT extent, Lisp_Object property, + Bytexpos old_start, Bytexpos old_end, + int descendants_too) +{ /* we could easily encounter a detached extent while traversing the children, but we should never be able to encounter a dead extent. */ assert (EXTENT_LIVE_P (extent)); @@ -1581,82 +1663,24 @@ if (!NILP (children)) { - /* first mark all of the extent's children. We will lose big-time - if there are any circularities here, so we sure as hell better - ensure that there aren't. */ - LIST_LOOP (rest, XWEAK_LIST_LIST (children)) - extent_changed_for_redisplay (XEXTENT (XCAR (rest)), 1, - invisibility_change); + /* first process all of the extent's children. We will lose + big-time if there are any circularities here, so we sure as + hell better ensure that there aren't. */ + LIST_LOOP_2 (rest, XWEAK_LIST_LIST (children)) + signal_extent_changed (extent, property, old_start, old_end, + descendants_too); } } - /* now mark the extent itself. */ - - object = extent_object (extent); - - if (extent_detached_p (extent)) - return; - - else if (STRINGP (object)) - { - /* #### Changes to string extents can affect redisplay if they are - in the modeline or in the gutters. - - If the extent is in some generated-modeline-string: when we - change an extent in generated-modeline-string, this changes its - parent, which is in `modeline-format', so we should force the - modeline to be updated. But how to determine whether a string - is a `generated-modeline-string'? Looping through all buffers - is not very efficient. Should we add all - `generated-modeline-string' strings to a hash table? Maybe - efficiency is not the greatest concern here and there's no big - loss in looping over the buffers. - - If the extent is in a gutter we mark the gutter as - changed. This means (a) we can update extents in the gutters - when we need it. (b) we don't have to update the gutters when - only extents attached to buffers have changed. */ - - if (!in_modeline_generation) - MARK_EXTENTS_CHANGED; - gutter_extent_signal_changed_region_maybe (object, - extent_endpoint_charbpos (extent, 0), - extent_endpoint_charbpos (extent, 1)); - } - else if (BUFFERP (object)) - { - struct buffer *b; - b = XBUFFER (object); - BUF_FACECHANGE (b)++; - MARK_EXTENTS_CHANGED; - if (invisibility_change) - MARK_CLIP_CHANGED; - buffer_extent_signal_changed_region (b, - extent_endpoint_charbpos (extent, 0), - extent_endpoint_charbpos (extent, 1)); - } -} - -/* A change to an extent occurred that might affect redisplay. - This is called when properties such as the endpoints, the layout, - or the priority changes. Redisplay will be affected only if - the extent has any displayable attributes. */ + /* now process the extent itself. */ + signal_single_extent_changed (extent, property, old_start, old_end); +} static void -extent_maybe_changed_for_redisplay (EXTENT extent, int descendants_too, - int invisibility_change) -{ - /* Retrieve the ancestor for efficiency */ - EXTENT anc = extent_ancestor (extent); - if (!NILP (extent_face (anc)) || - !NILP (extent_begin_glyph (anc)) || - !NILP (extent_end_glyph (anc)) || - !NILP (extent_mouse_face (anc)) || - !NILP (extent_invisible (anc)) || - !NILP (extent_initial_redisplay_function (anc)) || - invisibility_change) - extent_changed_for_redisplay (extent, descendants_too, - invisibility_change); +signal_extent_property_changed (EXTENT extent, Lisp_Object property, + int descendants_too) +{ + signal_extent_changed (extent, property, 0, 0, descendants_too); } static EXTENT @@ -1796,8 +1820,7 @@ extent_list_insert (el, extent); soe_insert (extent_object (extent), extent); /* only this extent changed */ - extent_maybe_changed_for_redisplay (extent, 0, - !NILP (extent_invisible (extent))); + signal_extent_changed (extent, Qnil, -1, -1, 0); } static void @@ -1810,8 +1833,10 @@ el = extent_extent_list (extent); /* call this before messing with the extent. */ - extent_maybe_changed_for_redisplay (extent, 0, - !NILP (extent_invisible (extent))); + signal_extent_changed (extent, Qnil, + extent_endpoint_byte (extent, 0), + extent_endpoint_char (extent, 0), + 0); extent_list_delete (el, extent); soe_delete (extent_object (extent), extent); set_extent_start (extent, -1); @@ -1828,7 +1853,7 @@ already been performed (see Fextent_in_region_p ()). */ static int -extent_in_region_p (EXTENT extent, Bytebpos from, Bytebpos to, +extent_in_region_p (EXTENT extent, Bytexpos from, Bytexpos to, unsigned int flags) { Lisp_Object obj = extent_object (extent); @@ -1864,11 +1889,12 @@ default: abort(); return 0; } - start = buffer_or_string_bytebpos_to_startind (obj, from, + start = buffer_or_string_bytexpos_to_startind (obj, from, flags & ME_START_OPEN); - end = buffer_or_string_bytebpos_to_endind (obj, to, ! (flags & ME_END_CLOSED)); - exs = membpos_to_startind (extent_start (extent), start_open); - exe = membpos_to_endind (extent_end (extent), end_open); + end = buffer_or_string_bytexpos_to_endind (obj, to, + ! (flags & ME_END_CLOSED)); + exs = memxpos_to_startind (extent_start (extent), start_open); + exe = memxpos_to_endind (extent_end (extent), end_open); /* It's easy to determine whether an extent lies *outside* the region -- just determine whether it's completely before @@ -1948,10 +1974,11 @@ static void -map_extents_bytebpos (Bytebpos from, Bytebpos to, map_extents_fun fn, void *arg, - Lisp_Object obj, EXTENT after, unsigned int flags) -{ - Membpos st, en; /* range we're mapping over */ +map_extents (Bytexpos from, Bytexpos to, map_extents_fun fn, + void *arg, Lisp_Object obj, EXTENT after, + unsigned int flags) +{ + Memxpos st, en; /* range we're mapping over */ EXTENT range = 0; /* extent for this, if ME_MIGHT_MODIFY_TEXT */ Extent_List *el = 0; /* extent list we're iterating over */ Extent_List_Marker *posm = 0; /* marker for extent list, @@ -1979,8 +2006,8 @@ return; el = 0; - st = buffer_or_string_bytebpos_to_membpos (obj, from); - en = buffer_or_string_bytebpos_to_membpos (obj, to); + st = buffer_or_string_bytexpos_to_memxpos (obj, from); + en = buffer_or_string_bytexpos_to_memxpos (obj, to); if (flags & ME_MIGHT_MODIFY_TEXT) { @@ -2249,10 +2276,10 @@ obj2 = extent_object (e); if (extent_in_region_p (e, - buffer_or_string_membpos_to_bytebpos (obj2, - st), - buffer_or_string_membpos_to_bytebpos (obj2, - en), + buffer_or_string_memxpos_to_bytexpos (obj2, + st), + buffer_or_string_memxpos_to_bytexpos (obj2, + en), flags)) { if ((*fn)(e, arg)) @@ -2280,15 +2307,6 @@ } } -void -map_extents (Charbpos from, Charbpos to, map_extents_fun fn, - void *arg, Lisp_Object obj, EXTENT after, unsigned int flags) -{ - map_extents_bytebpos (buffer_or_string_charbpos_to_bytebpos (obj, from), - buffer_or_string_charbpos_to_bytebpos (obj, to), fn, arg, - obj, after, flags); -} - /* ------------------------------- */ /* adjust_extents() */ /* ------------------------------- */ @@ -2310,7 +2328,7 @@ so for safety we make it just look at the extent lists directly. */ void -adjust_extents (Lisp_Object obj, Membpos from, Membpos to, int amount) +adjust_extents (Lisp_Object obj, Memxpos from, Memxpos to, int amount) { int endp; int pos; @@ -2386,15 +2404,15 @@ */ void -adjust_extents_for_deletion (Lisp_Object object, Bytebpos from, - Bytebpos to, int gapsize, int numdel, +adjust_extents_for_deletion (Lisp_Object object, Bytexpos from, + Bytexpos to, int gapsize, int numdel, int movegapsize) { struct adjust_extents_for_deletion_arg closure; int i; - Membpos adjust_to = (Membpos) (to + gapsize); + Memxpos adjust_to = (Memxpos) (to + gapsize); Bytecount amount = - numdel - movegapsize; - Membpos oldsoe = 0, newsoe = 0; + Memxpos oldsoe = 0, newsoe = 0; Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (object); #ifdef ERROR_CHECK_EXTENTS @@ -2407,12 +2425,12 @@ to muck with. If we do the mapping and adjusting together, things can get all screwed up. */ - map_extents_bytebpos (from, to, adjust_extents_for_deletion_mapper, - (void *) &closure, object, 0, - /* extent endpoints move like markers regardless - of their open/closeness. */ - ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED | - ME_START_OR_END_IN_REGION | ME_INCLUDE_INTERNAL); + map_extents (from, to, adjust_extents_for_deletion_mapper, + (void *) &closure, object, 0, + /* extent endpoints move like markers regardless + of their open/closeness. */ + ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED | + ME_START_OR_END_IN_REGION | ME_INCLUDE_INTERNAL); /* Old and new values for the SOE's position. (It gets adjusted @@ -2433,8 +2451,8 @@ for (i = 0; i < Dynarr_length (closure.list); i++) { EXTENT extent = Dynarr_at (closure.list, i); - Membpos new_start = extent_start (extent); - Membpos new_end = extent_end (extent); + Memxpos new_start = extent_start (extent); + Memxpos new_end = extent_end (extent); /* do_marker_adjustment() will not adjust values that should not be adjusted. We're passing the same funky arguments to @@ -2514,19 +2532,19 @@ the first run that begins after POS, or returns POS if there are no such runs. */ -static Bytebpos -extent_find_end_of_run (Lisp_Object obj, Bytebpos pos, int outside_accessible) +static Bytexpos +extent_find_end_of_run (Lisp_Object obj, Bytexpos pos, int outside_accessible) { Extent_List *sel; Extent_List *bel = buffer_or_string_extent_list (obj); - Bytebpos pos1, pos2; + Bytexpos pos1, pos2; int elind1, elind2; - Membpos mempos = buffer_or_string_bytebpos_to_membpos (obj, pos); - Bytebpos limit = outside_accessible ? + Memxpos mempos = buffer_or_string_bytexpos_to_memxpos (obj, pos); + Bytexpos limit = outside_accessible ? buffer_or_string_absolute_end_byte (obj) : - buffer_or_string_accessible_end_byte (obj); - - if (!bel || !extent_list_num_els(bel)) + buffer_or_string_accessible_end_byte (obj); + + if (!bel || !extent_list_num_els (bel)) return limit; sel = buffer_or_string_stack_of_extents_force (obj)->extents; @@ -2535,7 +2553,7 @@ /* Find the first start position after POS. */ elind1 = extent_list_locate_from_pos (bel, mempos+1, 0); if (elind1 < extent_list_num_els (bel)) - pos1 = buffer_or_string_membpos_to_bytebpos + pos1 = buffer_or_string_memxpos_to_bytexpos (obj, extent_start (extent_list_at (bel, elind1, 0))); else pos1 = limit; @@ -2545,7 +2563,7 @@ equal to POS1, so we just have to look in the SOE. */ elind2 = extent_list_locate_from_pos (sel, mempos+1, 1); if (elind2 < extent_list_num_els (sel)) - pos2 = buffer_or_string_membpos_to_bytebpos + pos2 = buffer_or_string_memxpos_to_bytexpos (obj, extent_end (extent_list_at (sel, elind2, 1))); else pos2 = limit; @@ -2553,18 +2571,18 @@ return min (min (pos1, pos2), limit); } -static Bytebpos -extent_find_beginning_of_run (Lisp_Object obj, Bytebpos pos, +static Bytexpos +extent_find_beginning_of_run (Lisp_Object obj, Bytexpos pos, int outside_accessible) { Extent_List *sel; Extent_List *bel = buffer_or_string_extent_list (obj); - Bytebpos pos1, pos2; + Bytexpos pos1, pos2; int elind1, elind2; - Membpos mempos = buffer_or_string_bytebpos_to_membpos (obj, pos); - Bytebpos limit = outside_accessible ? + Memxpos mempos = buffer_or_string_bytexpos_to_memxpos (obj, pos); + Bytexpos limit = outside_accessible ? buffer_or_string_absolute_begin_byte (obj) : - buffer_or_string_accessible_begin_byte (obj); + buffer_or_string_accessible_begin_byte (obj); if (!bel || !extent_list_num_els(bel)) return limit; @@ -2575,7 +2593,7 @@ /* Find the first end position before POS. */ elind1 = extent_list_locate_from_pos (bel, mempos, 1); if (elind1 > 0) - pos1 = buffer_or_string_membpos_to_bytebpos + pos1 = buffer_or_string_memxpos_to_bytexpos (obj, extent_end (extent_list_at (bel, elind1 - 1, 1))); else pos1 = limit; @@ -2585,7 +2603,7 @@ equal to POS1, so we just have to look in the SOE. */ elind2 = extent_list_locate_from_pos (sel, mempos, 0); if (elind2 > 0) - pos2 = buffer_or_string_membpos_to_bytebpos + pos2 = buffer_or_string_memxpos_to_bytexpos (obj, extent_start (extent_list_at (sel, elind2 - 1, 0))); else pos2 = limit; @@ -2754,7 +2772,7 @@ face_index extent_fragment_update (struct window *w, struct extent_fragment *ef, - Bytebpos pos, Lisp_Object last_glyph) + Bytexpos pos, Lisp_Object last_glyph) { int i; int seen_glyph = NILP (last_glyph) ? 1 : 0; @@ -2762,7 +2780,7 @@ buffer_or_string_stack_of_extents_force (ef->object)->extents; EXTENT lhe = 0; struct extent dummy_lhe_extent; - Membpos mempos = buffer_or_string_bytebpos_to_membpos (ef->object, pos); + Memxpos mempos = buffer_or_string_bytexpos_to_memxpos (ef->object, pos); #ifdef ERROR_CHECK_EXTENTS assert (pos >= buffer_or_string_accessible_begin_byte (ef->object) @@ -2960,7 +2978,7 @@ if (extent_detached_p (ext)) strcpy (bp, "detached"); else - sprintf (bp, "%d, %d", + sprintf (bp, "%ld, %ld", XINT (Fextent_start_position (obj)), XINT (Fextent_end_position (obj))); bp += strlen (bp); @@ -2979,7 +2997,7 @@ extent_duplicable_p (anc) || !NILP (extent_invisible (anc))) *bp++ = ' '; *bp = '\0'; - write_c_string (buf, printcharfun); + write_c_string (printcharfun, buf); tail = extent_plist_slot (anc); @@ -3041,13 +3059,13 @@ } if (!EXTENT_LIVE_P (XEXTENT (obj))) - write_c_string ("#<destroyed extent", printcharfun); + write_c_string (printcharfun, "#<destroyed extent"); else { - write_c_string ("#<extent ", printcharfun); + write_c_string (printcharfun, "#<extent "); print_extent_1 (obj, printcharfun, escapeflag); - write_c_string (extent_detached_p (XEXTENT (obj)) - ? " from " : " in ", printcharfun); + write_c_string (printcharfun, extent_detached_p (XEXTENT (obj)) + ? " from " : " in "); write_fmt_string (printcharfun, "%s%s%s", title, name, posttitle); } } @@ -3055,9 +3073,9 @@ { if (print_readably) printing_unreadable_object ("#<extent>"); - write_c_string ("#<extent", printcharfun); + write_c_string (printcharfun, "#<extent"); } - write_c_string (">", printcharfun); + write_c_string (printcharfun, ">"); } static int @@ -3142,40 +3160,13 @@ static int extent_remprop (Lisp_Object obj, Lisp_Object prop) { - EXTENT ext = XEXTENT (obj); - - /* This list is taken from Fset_extent_property, and should be kept - in synch. */ - if (EQ (prop, Qread_only) - || EQ (prop, Qunique) - || EQ (prop, Qduplicable) - || EQ (prop, Qinvisible) - || EQ (prop, Qdetachable) - || EQ (prop, Qdetached) - || EQ (prop, Qdestroyed) - || EQ (prop, Qpriority) - || EQ (prop, Qface) - || EQ (prop, Qinitial_redisplay_function) - || EQ (prop, Qafter_change_functions) - || EQ (prop, Qbefore_change_functions) - || EQ (prop, Qmouse_face) - || EQ (prop, Qhighlight) - || EQ (prop, Qbegin_glyph_layout) - || EQ (prop, Qend_glyph_layout) - || EQ (prop, Qglyph_layout) - || EQ (prop, Qbegin_glyph) - || EQ (prop, Qend_glyph) - || EQ (prop, Qstart_open) - || EQ (prop, Qend_open) - || EQ (prop, Qstart_closed) - || EQ (prop, Qend_closed) - || EQ (prop, Qkeymap)) - { - /* #### Is this correct, anyway? */ - return -1; - } - - return external_remprop (extent_plist_addr (ext), prop, 0, ERROR_ME); + Lisp_Object retval = Fset_extent_property (obj, prop, Qunbound); + if (UNBOUNDP (retval)) + return -1; + else if (!NILP (retval)) + return 1; + else + return 0; } static Lisp_Object @@ -3257,7 +3248,7 @@ return extent; } -/* Note that the returned value is a buffer position, not a byte index. */ +/* Note that the returned value is a char position, not a byte position. */ static Lisp_Object extent_endpoint_external (Lisp_Object extent_obj, int endp) @@ -3267,7 +3258,7 @@ if (extent_detached_p (extent)) return Qnil; else - return make_int (extent_endpoint_charbpos (extent, endp)); + return make_int (extent_endpoint_char (extent, endp)); } DEFUN ("extentp", Fextentp, 1, 1, 0, /* @@ -3324,8 +3315,8 @@ (extent)) { EXTENT e = decode_extent (extent, DE_MUST_BE_ATTACHED); - return make_int (extent_endpoint_charbpos (e, 1) - - extent_endpoint_charbpos (e, 0)); + return make_int (extent_endpoint_char (e, 1) + - extent_endpoint_char (e, 0)); } DEFUN ("next-extent", Fnext_extent, 1, 1, 0, /* @@ -3428,11 +3419,11 @@ (pos, object)) { Lisp_Object obj = decode_buffer_or_string (object); - Bytebpos bpos; - - bpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE); - bpos = extent_find_end_of_run (obj, bpos, 1); - return make_int (buffer_or_string_bytebpos_to_charbpos (obj, bpos)); + Bytexpos xpos; + + xpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE); + xpos = extent_find_end_of_run (obj, xpos, 1); + return make_int (buffer_or_string_bytexpos_to_charxpos (obj, xpos)); } DEFUN ("previous-extent-change", Fprevious_extent_change, 1, 2, 0, /* @@ -3444,11 +3435,11 @@ (pos, object)) { Lisp_Object obj = decode_buffer_or_string (object); - Bytebpos bpos; - - bpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE); - bpos = extent_find_beginning_of_run (obj, bpos, 1); - return make_int (buffer_or_string_bytebpos_to_charbpos (obj, bpos)); + Bytexpos xpos; + + xpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE); + xpos = extent_find_beginning_of_run (obj, xpos, 1); + return make_int (buffer_or_string_bytexpos_to_charxpos (obj, xpos)); } @@ -3516,6 +3507,17 @@ XWEAK_LIST_LIST (children) = Fcons (child, XWEAK_LIST_LIST (children)); } + +static int +compare_key_value_pairs (const void *humpty, const void *dumpty) +{ + Lisp_Object_pair *foo = (Lisp_Object_pair *) humpty; + Lisp_Object_pair *bar = (Lisp_Object_pair *) dumpty; + if (EQ (foo->key, bar->key)) + return 0; + return !NILP (Fstring_lessp (foo->key, bar->key)) ? -1 : 1; +} + DEFUN ("set-extent-parent", Fset_extent_parent, 2, 2, 0, /* Set the parent of EXTENT to PARENT (may be nil). See `extent-parent'. @@ -3550,6 +3552,78 @@ } /* changing the parent also changes the properties of all children. */ { + Lisp_Object_pair_dynarr *oldprops, *newprops; + int i, orignewlength; + + /* perhaps there's a smarter way, but the following will work, + and it's O(N*log N): + + (1) get the old props. + (2) get the new props. + (3) sort both. + (4) loop through old props; if key not in new, add it, with value + Qunbound. + (5) vice-versa for new props. + (6) sort both again. + (7) now we have identical lists of keys; we run through and compare + the values. + + Of course in reality the number of properties will be low, so + an N^2 algorithm wouldn't be a problem, but the stuff below is just + as easy to write given the existence of qsort and bsearch. + */ + + oldprops = Dynarr_new (Lisp_Object_pair); + newprops = Dynarr_new (Lisp_Object_pair); + if (!NILP (cur_parent)) + extent_properties (XEXTENT (cur_parent), oldprops); + if (!NILP (parent)) + extent_properties (XEXTENT (parent), newprops); + + qsort (Dynarr_atp (oldprops, 0), Dynarr_length (oldprops), + sizeof (Lisp_Object_pair), compare_key_value_pairs); + qsort (Dynarr_atp (newprops, 0), Dynarr_length (newprops), + sizeof (Lisp_Object_pair), compare_key_value_pairs); + orignewlength = Dynarr_length (newprops); + for (i = 0; i < Dynarr_length (oldprops); i++) + { + if (!bsearch (Dynarr_atp (oldprops, i), Dynarr_atp (newprops, 0), + Dynarr_length (newprops), sizeof (Lisp_Object_pair), + compare_key_value_pairs)) + { + Lisp_Object_pair new; + new.key = Dynarr_at (oldprops, i).key; + new.value = Qunbound; + Dynarr_add (newprops, new); + } + } + for (i = 0; i < orignewlength; i++) + { + if (!bsearch (Dynarr_atp (newprops, i), Dynarr_atp (oldprops, 0), + Dynarr_length (oldprops), sizeof (Lisp_Object_pair), + compare_key_value_pairs)) + { + Lisp_Object_pair new; + new.key = Dynarr_at (newprops, i).key; + new.value = Qunbound; + Dynarr_add (oldprops, new); + } + } + qsort (Dynarr_atp (oldprops, 0), Dynarr_length (oldprops), + sizeof (Lisp_Object_pair), compare_key_value_pairs); + qsort (Dynarr_atp (newprops, 0), Dynarr_length (newprops), + sizeof (Lisp_Object_pair), compare_key_value_pairs); + for (i = 0; i < Dynarr_length (oldprops); i++) + { + assert (EQ (Dynarr_at (oldprops, i).key, Dynarr_at (newprops, i).key)); + if (!EQ (Dynarr_at (oldprops, i).value, Dynarr_at (newprops, i).value)) + signal_extent_property_changed (e, Dynarr_at (oldprops, i).key, 1); + } + + Dynarr_free (oldprops); + Dynarr_free (newprops); +#if 0 + { int old_invis = (!NILP (cur_parent) && !NILP (extent_invisible (XEXTENT (cur_parent)))); int new_invis = (!NILP (parent) && @@ -3557,7 +3631,8 @@ extent_maybe_changed_for_redisplay (e, 1, new_invis != old_invis); } - +#endif /* 0 */ + } return Qnil; } @@ -3572,7 +3647,7 @@ */ static void -set_extent_endpoints_1 (EXTENT extent, Membpos start, Membpos end) +set_extent_endpoints_1 (EXTENT extent, Memxpos start, Memxpos end) { #ifdef ERROR_CHECK_EXTENTS Lisp_Object obj = extent_object (extent); @@ -3612,9 +3687,10 @@ OBJECT. (If OBJECT is nil, do not change the extent's object.) */ void -set_extent_endpoints (EXTENT extent, Bytebpos s, Bytebpos e, Lisp_Object object) -{ - Membpos start, end; +set_extent_endpoints (EXTENT extent, Bytexpos s, Bytexpos e, + Lisp_Object object) +{ + Memxpos start, end; if (NILP (object)) { @@ -3628,9 +3704,9 @@ } start = s < 0 ? extent_start (extent) : - buffer_or_string_bytebpos_to_membpos (object, s); + buffer_or_string_bytexpos_to_memxpos (object, s); end = e < 0 ? extent_end (extent) : - buffer_or_string_bytebpos_to_membpos (object, e); + buffer_or_string_bytexpos_to_memxpos (object, e); set_extent_endpoints_1 (extent, start, end); } @@ -3638,15 +3714,19 @@ set_extent_openness (EXTENT extent, int start_open, int end_open) { if (start_open != -1) - extent_start_open_p (extent) = start_open; + { + extent_start_open_p (extent) = start_open; + signal_extent_property_changed (extent, Qstart_open, 1); + } if (end_open != -1) - extent_end_open_p (extent) = end_open; - /* changing the open/closedness of an extent does not affect - redisplay. */ + { + extent_end_open_p (extent) = end_open; + signal_extent_property_changed (extent, Qend_open, 1); + } } static EXTENT -make_extent_internal (Lisp_Object object, Bytebpos from, Bytebpos to) +make_extent (Lisp_Object object, Bytexpos from, Bytexpos to) { EXTENT extent; @@ -3655,8 +3735,10 @@ return extent; } +/* Copy ORIGINAL, changing it to span FROM,TO in OBJECT. */ + static EXTENT -copy_extent (EXTENT original, Bytebpos from, Bytebpos to, Lisp_Object object) +copy_extent (EXTENT original, Bytexpos from, Bytexpos to, Lisp_Object object) { EXTENT e; @@ -3738,11 +3820,11 @@ } else { - Bytebpos start, end; + Bytexpos start, end; get_buffer_or_string_range_byte (obj, from, to, &start, &end, GB_ALLOW_PAST_ACCESSIBLE); - extent_obj = wrap_extent (make_extent_internal (obj, start, end)); + extent_obj = wrap_extent (make_extent (obj, start, end)); } return extent_obj; } @@ -3820,7 +3902,7 @@ (extent, start, end, buffer_or_string)) { EXTENT ext; - Bytebpos s, e; + Bytexpos s, e; ext = decode_extent (extent, 0); @@ -3912,7 +3994,7 @@ */ (extent, from, to, flags)) { - Bytebpos start, end; + Bytexpos start, end; EXTENT ext = decode_extent (extent, DE_MUST_BE_ATTACHED); Lisp_Object obj = extent_object (ext); @@ -4035,7 +4117,7 @@ /* This function can GC */ struct slow_map_extents_arg closure; unsigned int me_flags; - Bytebpos start, end; + Bytexpos start, end; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; EXTENT after = 0; @@ -4070,10 +4152,10 @@ closure.property = property; closure.value = value; - map_extents_bytebpos (start, end, slow_map_extents_function, - (void *) &closure, object, after, - /* You never know what the user might do ... */ - me_flags | ME_MIGHT_CALL_ELISP); + map_extents (start, end, slow_map_extents_function, + (void *) &closure, object, after, + /* You never know what the user might do ... */ + me_flags | ME_MIGHT_CALL_ELISP); UNGCPRO; return closure.result; @@ -4095,9 +4177,9 @@ Lisp_Object result; Lisp_Object property; Lisp_Object value; - Bytebpos start_min; - Bytebpos prev_start; - Bytebpos prev_end; + Bytexpos start_min; + Bytexpos prev_start; + Bytexpos prev_end; }; static int @@ -4107,8 +4189,8 @@ struct slow_map_extent_children_arg *closure = (struct slow_map_extent_children_arg *) arg; Lisp_Object extent_obj; - Bytebpos start = extent_endpoint_bytebpos (extent, 0); - Bytebpos end = extent_endpoint_bytebpos (extent, 1); + Bytexpos start = extent_endpoint_byte (extent, 0); + Bytexpos end = extent_endpoint_byte (extent, 1); /* Make sure the extent starts inside the region of interest, rather than just overlaps it. */ @@ -4151,8 +4233,8 @@ buffer positions here. */ closure->start_min = -1; /* no need for this any more */ - closure->prev_start = extent_endpoint_bytebpos (extent, 0); - closure->prev_end = extent_endpoint_bytebpos (extent, 1); + closure->prev_start = extent_endpoint_byte (extent, 0); + closure->prev_end = extent_endpoint_byte (extent, 1); return !NILP (closure->result); } @@ -4176,7 +4258,7 @@ /* This function can GC */ struct slow_map_extent_children_arg closure; unsigned int me_flags; - Bytebpos start, end; + Bytexpos start, end; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; EXTENT after = 0; @@ -4213,10 +4295,10 @@ closure.start_min = start; closure.prev_start = -1; closure.prev_end = -1; - map_extents_bytebpos (start, end, slow_map_extent_children_function, - (void *) &closure, object, after, - /* You never know what the user might do ... */ - me_flags | ME_MIGHT_CALL_ELISP); + map_extents (start, end, slow_map_extent_children_function, + (void *) &closure, object, after, + /* You never know what the user might do ... */ + me_flags | ME_MIGHT_CALL_ELISP); UNGCPRO; return closure.result; @@ -4236,20 +4318,13 @@ struct extent_at_arg { Lisp_Object best_match; /* or list of extents */ - Membpos best_start; - Membpos best_end; + Memxpos best_start; + Memxpos best_end; Lisp_Object prop; EXTENT before; int all_extents; }; -enum extent_at_flag -{ - EXTENT_AT_AFTER, - EXTENT_AT_BEFORE, - EXTENT_AT_AT -}; - static enum extent_at_flag decode_extent_at_flag (Lisp_Object at_flag) { @@ -4318,9 +4393,10 @@ return 0; } -static Lisp_Object -extent_at_bytebpos (Bytebpos position, Lisp_Object object, Lisp_Object property, - EXTENT before, enum extent_at_flag at_flag, int all_extents) +Lisp_Object +extent_at (Bytexpos position, Lisp_Object object, + Lisp_Object property, EXTENT before, + enum extent_at_flag at_flag, int all_extents) { struct extent_at_arg closure; struct gcpro gcpro1; @@ -4347,10 +4423,12 @@ closure.all_extents = all_extents; GCPRO1 (closure.best_match); - map_extents_bytebpos (at_flag == EXTENT_AT_BEFORE ? position - 1 : position, - at_flag == EXTENT_AT_AFTER ? position + 1 : position, - extent_at_mapper, (void *) &closure, object, 0, - ME_START_OPEN | ME_ALL_EXTENTS_CLOSED); + map_extents (at_flag == EXTENT_AT_BEFORE ? prev_bytexpos (object, position) : + position, + at_flag == EXTENT_AT_AFTER ? next_bytexpos (object, position) : + position, + extent_at_mapper, (void *) &closure, object, 0, + ME_START_OPEN | ME_ALL_EXTENTS_CLOSED); if (all_extents) closure.best_match = Fnreverse (closure.best_match); UNGCPRO; @@ -4388,7 +4466,7 @@ */ (pos, object, property, before, at_flag)) { - Bytebpos position; + Bytexpos position; EXTENT before_extent; enum extent_at_flag fl; @@ -4402,7 +4480,7 @@ invalid_argument ("extent not in specified buffer or string", object); fl = decode_extent_at_flag (at_flag); - return extent_at_bytebpos (position, object, property, before_extent, fl, 0); + return extent_at (position, object, property, before_extent, fl, 0); } DEFUN ("extents-at", Fextents_at, 1, 5, 0, /* @@ -4438,7 +4516,7 @@ */ (pos, object, property, before, at_flag)) { - Bytebpos position; + Bytexpos position; EXTENT before_extent; enum extent_at_flag fl; @@ -4452,7 +4530,7 @@ invalid_argument ("extent not in specified buffer or string", object); fl = decode_extent_at_flag (at_flag); - return extent_at_bytebpos (position, object, property, before_extent, fl, 1); + return extent_at (position, object, property, before_extent, fl, 1); } /* ------------------------------- */ @@ -4467,8 +4545,8 @@ struct verify_extents_arg { Lisp_Object object; - Membpos start; - Membpos end; + Memxpos start; + Memxpos end; Lisp_Object iro; /* value of inhibit-read-only */ }; @@ -4508,7 +4586,7 @@ efficiency */ void -verify_extent_modification (Lisp_Object object, Bytebpos from, Bytebpos to, +verify_extent_modification (Lisp_Object object, Bytexpos from, Bytexpos to, Lisp_Object inhibit_read_only_value) { int closed; @@ -4523,12 +4601,12 @@ As far as I know, this doesn't currently occur in XEmacs. --ben */ closed = (from==to); closure.object = object; - closure.start = buffer_or_string_bytebpos_to_membpos (object, from); - closure.end = buffer_or_string_bytebpos_to_membpos (object, to); + closure.start = buffer_or_string_bytexpos_to_memxpos (object, from); + closure.end = buffer_or_string_bytexpos_to_memxpos (object, to); closure.iro = inhibit_read_only_value; - map_extents_bytebpos (from, to, verify_extent_mapper, (void *) &closure, - object, 0, closed ? ME_END_CLOSED : ME_START_OPEN); + map_extents (from, to, verify_extent_mapper, (void *) &closure, + object, 0, closed ? ME_END_CLOSED : ME_START_OPEN); } /* ------------------------------------ */ @@ -4537,7 +4615,7 @@ struct process_extents_for_insertion_arg { - Bytebpos opoint; + Bytexpos opoint; int length; Lisp_Object object; }; @@ -4552,8 +4630,8 @@ { struct process_extents_for_insertion_arg *closure = (struct process_extents_for_insertion_arg *) arg; - Membpos indice = buffer_or_string_bytebpos_to_membpos (closure->object, - closure->opoint); + Memxpos indice = buffer_or_string_bytexpos_to_memxpos (closure->object, + closure->opoint); /* When this function is called, one end of the newly-inserted text should be adjacent to some endpoint of the extent, or disjoint from it. If @@ -4588,8 +4666,8 @@ it. */ { - Membpos new_start = extent_start (extent); - Membpos new_end = extent_end (extent); + Memxpos new_start = extent_start (extent); + Memxpos new_end = extent_end (extent); if (indice == extent_start (extent) && extent_start_open_p (extent) /* zero-length () extents are exempt; see comment above. */ @@ -4606,7 +4684,7 @@ } void -process_extents_for_insertion (Lisp_Object object, Bytebpos opoint, +process_extents_for_insertion (Lisp_Object object, Bytexpos opoint, Bytecount length) { struct process_extents_for_insertion_arg closure; @@ -4615,11 +4693,11 @@ closure.length = length; closure.object = object; - map_extents_bytebpos (opoint, opoint + length, - process_extents_for_insertion_mapper, - (void *) &closure, object, 0, - ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS | - ME_INCLUDE_INTERNAL); + map_extents (opoint, opoint + length, + process_extents_for_insertion_mapper, + (void *) &closure, object, 0, + ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS | + ME_INCLUDE_INTERNAL); } /* ------------------------------------ */ @@ -4628,7 +4706,7 @@ struct process_extents_for_deletion_arg { - Membpos start, end; + Memxpos start, end; int destroy_included_extents; }; @@ -4666,26 +4744,28 @@ be a function process_extents_for_destruction(), #if 0'd out, that did the equivalent). */ void -process_extents_for_deletion (Lisp_Object object, Bytebpos from, - Bytebpos to, int destroy_them) +process_extents_for_deletion (Lisp_Object object, Bytexpos from, + Bytexpos to, int destroy_them) { struct process_extents_for_deletion_arg closure; - closure.start = buffer_or_string_bytebpos_to_membpos (object, from); - closure.end = buffer_or_string_bytebpos_to_membpos (object, to); + closure.start = buffer_or_string_bytexpos_to_memxpos (object, from); + closure.end = buffer_or_string_bytexpos_to_memxpos (object, to); closure.destroy_included_extents = destroy_them; - map_extents_bytebpos (from, to, process_extents_for_deletion_mapper, - (void *) &closure, object, 0, - ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS); + map_extents (from, to, process_extents_for_deletion_mapper, + (void *) &closure, object, 0, + ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS); } /* ------------------------------- */ /* report_extent_modification() */ /* ------------------------------- */ -struct report_extent_modification_closure { + +struct report_extent_modification_closure +{ Lisp_Object buffer; - Charbpos start, end; + Charxpos start, end; int afterp; int speccount; }; @@ -4721,7 +4801,7 @@ One confusing thing here is that our caller never actually calls unbind_to (closure.speccount). This is because - map_extents_bytebpos() unbinds before, and with a smaller + map_extents() unbinds before, and with a smaller speccount. The additional unbind_to_1() in report_extent_modification() would cause XEmacs to abort. */ if (closure->speccount == -1) @@ -4769,7 +4849,9 @@ closure.afterp = afterp; closure.speccount = -1; - map_extents (start, end, report_extent_modification_mapper, (void *)&closure, + map_extents (charbpos_to_bytebpos (XBUFFER (buffer), start), + charbpos_to_bytebpos (XBUFFER (buffer), end), + report_extent_modification_mapper, (void *)&closure, buffer, NULL, ME_MIGHT_CALL_ELISP); } @@ -4784,7 +4866,7 @@ if (!EQ (extent_invisible (extent), value)) { set_extent_invisible_1 (extent, value); - extent_changed_for_redisplay (extent, 1, 1); + signal_extent_property_changed (extent, Qinvisible, 1); } } @@ -4909,6 +4991,12 @@ } } +/* The idea here is that if we're given a list of faces, we + need to "memoize" this so that two lists of faces that are `equal' + turn into the same object. When `set-extent-face' is called, we + "memoize" into a list of actual faces; when `extent-face' is called, + we do a reverse lookup to get the list of symbols. */ + static Lisp_Object canonicalize_extent_property (Lisp_Object prop, Lisp_Object value) { @@ -4919,7 +5007,8 @@ } /* Do we need a lisp-level function ? */ -DEFUN ("set-extent-initial-redisplay-function", Fset_extent_initial_redisplay_function, +DEFUN ("set-extent-initial-redisplay-function", + Fset_extent_initial_redisplay_function, 2,2,0, /* Note: This feature is experimental! @@ -4931,14 +5020,14 @@ */ (extent, function)) { - EXTENT e = decode_extent(extent, DE_MUST_BE_ATTACHED); + /* #### This is totally broken. */ + EXTENT e = decode_extent (extent, DE_MUST_BE_ATTACHED); e = extent_ancestor (e); /* Is this needed? Macro also does chasing!*/ - set_extent_initial_redisplay_function(e,function); - extent_in_red_event_p(e) = 0; /* If the function changed we can spawn + set_extent_initial_redisplay_function (e, function); + extent_in_red_event_p (e) = 0; /* If the function changed we can spawn new events */ - extent_changed_for_redisplay(e,1,0); /* Do we need to mark children too ?*/ - + signal_extent_property_changed (e, Qinitial_redisplay_function, 1); return function; } @@ -4974,7 +5063,7 @@ face = memoize_extent_face_internal (face); extent_face (e) = face; - extent_changed_for_redisplay (e, 1, 0); + signal_extent_property_changed (e, Qface, 1); return orig_face; } @@ -5014,7 +5103,7 @@ face = memoize_extent_face_internal (face); set_extent_mouse_face (e, face); - extent_changed_for_redisplay (e, 1, 0); + signal_extent_property_changed (e, Qmouse_face, 1); return orig_face; } @@ -5029,14 +5118,16 @@ { set_extent_begin_glyph (extent, glyph); set_extent_begin_glyph_layout (extent, layout); + signal_extent_property_changed (extent, Qbegin_glyph, 1); + signal_extent_property_changed (extent, Qbegin_glyph_layout, 1); } else { set_extent_end_glyph (extent, glyph); set_extent_end_glyph_layout (extent, layout); + signal_extent_property_changed (extent, Qend_glyph, 1); + signal_extent_property_changed (extent, Qend_glyph_layout, 1); } - - extent_changed_for_redisplay (extent, 1, 0); } static Lisp_Object @@ -5131,7 +5222,7 @@ EXTENT e = decode_extent (extent, 0); e = extent_ancestor (e); set_extent_begin_glyph_layout (e, symbol_to_glyph_layout (layout)); - extent_maybe_changed_for_redisplay (e, 1, 0); + signal_extent_property_changed (e, Qbegin_glyph_layout, 1); return layout; } @@ -5144,7 +5235,7 @@ EXTENT e = decode_extent (extent, 0); e = extent_ancestor (e); set_extent_end_glyph_layout (e, symbol_to_glyph_layout (layout)); - extent_maybe_changed_for_redisplay (e, 1, 0); + signal_extent_property_changed (e, Qend_glyph_layout, 1); return layout; } @@ -5183,7 +5274,7 @@ CHECK_INT (priority); e = extent_ancestor (e); set_extent_priority (e, XINT (priority)); - extent_maybe_changed_for_redisplay (e, 1, 0); + signal_extent_property_changed (e, Qpriority, 1); return priority; } @@ -5342,28 +5433,82 @@ { /* This function can GC if property is `keymap' */ EXTENT e = decode_extent (extent, 0); + int signal_change = 0; + + /* If VALUE is unbound, the property is being removed through `remprop'. + Return Qunbound if removal disallowed, Qt if anything removed, + Qnil otherwise. */ + + /* Keep in synch with stuff below. */ + if (UNBOUNDP (value)) + { + int retval; + + if (EQ (property, Qread_only) + || EQ (property, Qunique) + || EQ (property, Qduplicable) + || EQ (property, Qinvisible) + || EQ (property, Qdetachable) + || EQ (property, Qdetached) + || EQ (property, Qdestroyed) + || EQ (property, Qpriority) + || EQ (property, Qface) + || EQ (property, Qinitial_redisplay_function) + || EQ (property, Qafter_change_functions) + || EQ (property, Qbefore_change_functions) + || EQ (property, Qmouse_face) + || EQ (property, Qhighlight) + || EQ (property, Qbegin_glyph_layout) + || EQ (property, Qend_glyph_layout) + || EQ (property, Qglyph_layout) + || EQ (property, Qbegin_glyph) + || EQ (property, Qend_glyph) + || EQ (property, Qstart_open) + || EQ (property, Qend_open) + || EQ (property, Qstart_closed) + || EQ (property, Qend_closed) + || EQ (property, Qkeymap)) + return Qunbound; + + retval = external_remprop (extent_plist_addr (e), property, 0, + ERROR_ME); + if (retval) + signal_extent_property_changed (e, property, 1); + return retval ? Qt : Qnil; + } if (EQ (property, Qread_only)) - set_extent_read_only (e, value); + { + set_extent_read_only (e, value); + signal_change = 1; + } else if (EQ (property, Qunique)) - extent_unique_p (e) = !NILP (value); + { + extent_unique_p (e) = !NILP (value); + signal_change = 1; + } else if (EQ (property, Qduplicable)) - extent_duplicable_p (e) = !NILP (value); + { + extent_duplicable_p (e) = !NILP (value); + signal_change = 1; + } else if (EQ (property, Qinvisible)) set_extent_invisible (e, value); else if (EQ (property, Qdetachable)) - extent_detachable_p (e) = !NILP (value); - + { + extent_detachable_p (e) = !NILP (value); + signal_change = 1; + } else if (EQ (property, Qdetached)) { if (NILP (value)) - invalid_operation ("can only set `detached' to t", Qunbound); + invalid_operation ("can only set `detached' to t", Qunbound); Fdetach_extent (extent); } else if (EQ (property, Qdestroyed)) { if (NILP (value)) - invalid_operation ("can only set `destroyed' to t", Qunbound); + invalid_operation ("can only set `destroyed' to t", Qunbound); Fdelete_extent (extent); } else if (EQ (property, Qpriority)) @@ -5373,9 +5518,15 @@ else if (EQ (property, Qinitial_redisplay_function)) Fset_extent_initial_redisplay_function (extent, value); else if (EQ (property, Qbefore_change_functions)) - set_extent_before_change_functions (e, value); + { + set_extent_before_change_functions (e, value); + signal_change = 1; + } else if (EQ (property, Qafter_change_functions)) - set_extent_after_change_functions (e, value); + { + set_extent_after_change_functions (e, value); + signal_change = 1; + } else if (EQ (property, Qmouse_face)) Fset_extent_mouse_face (extent, value); /* Obsolete: */ @@ -5409,8 +5560,11 @@ value = wrong_type_argument (Qkeymapp, value); external_plist_put (extent_plist_addr (e), property, value, 0, ERROR_ME); + signal_change = 1; } + if (signal_change) + signal_extent_property_changed (e, property, 1); return value; } @@ -5506,90 +5660,120 @@ } } -DEFUN ("extent-properties", Fextent_properties, 1, 1, 0, /* -Return a property list of the attributes of EXTENT. -Do not modify this list; use `set-extent-property' instead. -*/ - (extent)) -{ - EXTENT e, anc; - Lisp_Object result, face, anc_obj; +static void +extent_properties (EXTENT e, Lisp_Object_pair_dynarr *props) +{ + Lisp_Object face, anc_obj; glyph_layout layout; - - CHECK_EXTENT (extent); - e = XEXTENT (extent); + EXTENT anc; + +#define ADD_PROP(miftaaH, maal) \ +do { \ + Lisp_Object_pair p; \ + p.key = miftaaH; \ + p.value = maal; \ + Dynarr_add (props, p); \ +} while (0) + if (!EXTENT_LIVE_P (e)) - return cons3 (Qdestroyed, Qt, Qnil); + { + ADD_PROP (Qdestroyed, Qt); + return; + } anc = extent_ancestor (e); anc_obj = wrap_extent (anc); /* For efficiency, use the ancestor for all properties except detached */ - - result = extent_plist_slot (anc); + { + EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, extent_plist_slot (anc)) + ADD_PROP (key, value); + } if (!NILP (face = Fextent_face (anc_obj))) - result = cons3 (Qface, face, result); + ADD_PROP (Qface, face); if (!NILP (face = Fextent_mouse_face (anc_obj))) - result = cons3 (Qmouse_face, face, result); + ADD_PROP (Qmouse_face, face); if ((layout = (glyph_layout) extent_begin_glyph_layout (anc)) != GL_TEXT) { Lisp_Object sym = glyph_layout_to_symbol (layout); - result = cons3 (Qglyph_layout, sym, result); /* compatibility */ - result = cons3 (Qbegin_glyph_layout, sym, result); + ADD_PROP (Qglyph_layout, sym); /* compatibility */ + ADD_PROP (Qbegin_glyph_layout, sym); } if ((layout = (glyph_layout) extent_end_glyph_layout (anc)) != GL_TEXT) - result = cons3 (Qend_glyph_layout, glyph_layout_to_symbol (layout), result); + ADD_PROP (Qend_glyph_layout, glyph_layout_to_symbol (layout)); if (!NILP (extent_end_glyph (anc))) - result = cons3 (Qend_glyph, extent_end_glyph (anc), result); + ADD_PROP (Qend_glyph, extent_end_glyph (anc)); if (!NILP (extent_begin_glyph (anc))) - result = cons3 (Qbegin_glyph, extent_begin_glyph (anc), result); + ADD_PROP (Qbegin_glyph, extent_begin_glyph (anc)); if (extent_priority (anc) != 0) - result = cons3 (Qpriority, make_int (extent_priority (anc)), result); + ADD_PROP (Qpriority, make_int (extent_priority (anc))); if (!NILP (extent_initial_redisplay_function (anc))) - result = cons3 (Qinitial_redisplay_function, - extent_initial_redisplay_function (anc), result); + ADD_PROP (Qinitial_redisplay_function, + extent_initial_redisplay_function (anc)); if (!NILP (extent_before_change_functions (anc))) - result = cons3 (Qbefore_change_functions, - extent_before_change_functions (anc), result); + ADD_PROP (Qbefore_change_functions, extent_before_change_functions (anc)); if (!NILP (extent_after_change_functions (anc))) - result = cons3 (Qafter_change_functions, - extent_after_change_functions (anc), result); + ADD_PROP (Qafter_change_functions, extent_after_change_functions (anc)); if (!NILP (extent_invisible (anc))) - result = cons3 (Qinvisible, extent_invisible (anc), result); + ADD_PROP (Qinvisible, extent_invisible (anc)); if (!NILP (extent_read_only (anc))) - result = cons3 (Qread_only, extent_read_only (anc), result); + ADD_PROP (Qread_only, extent_read_only (anc)); if (extent_normal_field (anc, end_open)) - result = cons3 (Qend_open, Qt, result); + ADD_PROP (Qend_open, Qt); if (extent_normal_field (anc, start_open)) - result = cons3 (Qstart_open, Qt, result); + ADD_PROP (Qstart_open, Qt); if (extent_normal_field (anc, detachable)) - result = cons3 (Qdetachable, Qt, result); + ADD_PROP (Qdetachable, Qt); if (extent_normal_field (anc, duplicable)) - result = cons3 (Qduplicable, Qt, result); + ADD_PROP (Qduplicable, Qt); if (extent_normal_field (anc, unique)) - result = cons3 (Qunique, Qt, result); + ADD_PROP (Qunique, Qt); /* detached is not an inherited property */ if (extent_detached_p (e)) - result = cons3 (Qdetached, Qt, result); - + ADD_PROP (Qdetached, Qt); + +#undef ADD_PROP +} + +DEFUN ("extent-properties", Fextent_properties, 1, 1, 0, /* +Return a property list of the attributes of EXTENT. +Do not modify this list; use `set-extent-property' instead. +*/ + (extent)) +{ + EXTENT e; + Lisp_Object result = Qnil; + Lisp_Object_pair_dynarr *props; + int i; + + CHECK_EXTENT (extent); + e = XEXTENT (extent); + props = Dynarr_new (Lisp_Object_pair); + extent_properties (e, props); + + for (i = 0; i < Dynarr_length (props); i++) + result = cons3 (Dynarr_at (props, i).key, Dynarr_at (props, i).value, + result); + + Dynarr_free (props); return result; } @@ -5613,14 +5797,16 @@ { /* do not recurse on descendants. Only one extent is highlighted at a time. */ - extent_changed_for_redisplay (XEXTENT (Vlast_highlighted_extent), 0, 0); + /* A bit of a lie. */ + signal_extent_property_changed (XEXTENT (Vlast_highlighted_extent), + Qface, 0); } Vlast_highlighted_extent = Qnil; if (!NILP (extent_obj) && BUFFERP (extent_object (XEXTENT (extent_obj))) && highlight_p) { - extent_changed_for_redisplay (XEXTENT (extent_obj), 0, 0); + signal_extent_property_changed (XEXTENT (extent_obj), Qface, 0); Vlast_highlighted_extent = extent_obj; } } @@ -5664,7 +5850,7 @@ /* copy/paste hooks */ static int -run_extent_copy_paste_internal (EXTENT e, Charbpos from, Charbpos to, +run_extent_copy_paste_internal (EXTENT e, Charxpos from, Charxpos to, Lisp_Object object, Lisp_Object prop) { @@ -5691,39 +5877,37 @@ } static int -run_extent_copy_function (EXTENT e, Bytebpos from, Bytebpos to) +run_extent_copy_function (EXTENT e, Bytexpos from, Bytexpos to) { Lisp_Object object = extent_object (e); /* This function can GC */ return run_extent_copy_paste_internal - (e, buffer_or_string_bytebpos_to_charbpos (object, from), - buffer_or_string_bytebpos_to_charbpos (object, to), object, + (e, buffer_or_string_bytexpos_to_charxpos (object, from), + buffer_or_string_bytexpos_to_charxpos (object, to), object, Qcopy_function); } static int -run_extent_paste_function (EXTENT e, Bytebpos from, Bytebpos to, +run_extent_paste_function (EXTENT e, Bytexpos from, Bytexpos to, Lisp_Object object) { /* This function can GC */ return run_extent_copy_paste_internal - (e, buffer_or_string_bytebpos_to_charbpos (object, from), - buffer_or_string_bytebpos_to_charbpos (object, to), object, + (e, buffer_or_string_bytexpos_to_charxpos (object, from), + buffer_or_string_bytexpos_to_charxpos (object, to), object, Qpaste_function); } -static void -update_extent (EXTENT extent, Bytebpos from, Bytebpos to) -{ - set_extent_endpoints (extent, from, to, Qnil); -} - -/* Insert an extent, usually from the dup_list of a string which - has just been inserted. - This code does not handle the case of undo. - */ +static int +run_extent_paste_function_char (EXTENT e, Charxpos from, Charxpos to, + Lisp_Object object) +{ + /* This function can GC */ + return run_extent_copy_paste_internal (e, from, to, object, Qpaste_function); +} + static Lisp_Object -insert_extent (EXTENT extent, Bytebpos new_start, Bytebpos new_end, +insert_extent (EXTENT extent, Bytexpos new_start, Bytexpos new_end, Lisp_Object object, int run_hooks) { /* This function can GC */ @@ -5737,12 +5921,12 @@ /* The paste-function said don't re-attach this extent here. */ return Qnil; else - update_extent (extent, new_start, new_end); + set_extent_endpoints (extent, new_start, new_end, Qnil); } else { - Bytebpos exstart = extent_endpoint_bytebpos (extent, 0); - Bytebpos exend = extent_endpoint_bytebpos (extent, 1); + Bytexpos exstart = extent_endpoint_byte (extent, 0); + Bytexpos exend = extent_endpoint_byte (extent, 1); if (exend < new_start || exstart > new_end) goto copy_it; @@ -5751,7 +5935,7 @@ new_start = min (exstart, new_start); new_end = max (exend, new_end); if (exstart != new_start || exend != new_end) - update_extent (extent, new_start, new_end); + set_extent_endpoints (extent, new_start, new_end, Qnil); } } @@ -5769,19 +5953,26 @@ DEFUN ("insert-extent", Finsert_extent, 1, 5, 0, /* Insert EXTENT from START to END in BUFFER-OR-STRING. BUFFER-OR-STRING defaults to the current buffer if omitted. -This operation does not insert any characters, -but otherwise acts as if there were a replicating extent whose -parent is EXTENT in some string that was just inserted. -Returns the newly-inserted extent. +If EXTENT is already on the same object, and overlaps or is adjacent to +the given range, its range is merely extended to include the new range. +Otherwise, a copy is made of the extent at the new position and object. +When a copy is made, the new extent is returned, copy/paste hooks are run, +and the change is noted for undo recording. When no copy is made, nil is +returned. See documentation on `detach-extent' for a discussion of undo +recording. + The fourth arg, NO-HOOKS, can be used to inhibit the running of the - extent's `paste-function' property if it has one. -See documentation on `detach-extent' for a discussion of undo recording. +extent's `paste-function' property if it has one. + +It's not really clear why this function exists any more. It was a holdover +from a much older implementation of extents, before extents could really +exist on strings. */ (extent, start, end, no_hooks, buffer_or_string)) { EXTENT ext = decode_extent (extent, 0); Lisp_Object copy; - Bytebpos s, e; + Bytexpos s, e; buffer_or_string = decode_buffer_or_string (buffer_or_string); get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e, @@ -5801,7 +5992,7 @@ struct add_string_extents_arg { - Bytebpos from; + Bytexpos from; Bytecount length; Lisp_Object string; }; @@ -5812,8 +6003,8 @@ /* This function can GC */ struct add_string_extents_arg *closure = (struct add_string_extents_arg *) arg; - Bytecount start = extent_endpoint_bytebpos (extent, 0) - closure->from; - Bytecount end = extent_endpoint_bytebpos (extent, 1) - closure->from; + Bytecount start = extent_endpoint_byte (extent, 0) - closure->from; + Bytecount end = extent_endpoint_byte (extent, 1) - closure->from; if (extent_duplicable_p (extent)) { @@ -5833,29 +6024,94 @@ return 0; } +struct add_string_extents_the_hard_way_arg +{ + Charxpos from; + Charcount length; + Lisp_Object string; +}; + +static int +add_string_extents_the_hard_way_mapper (EXTENT extent, void *arg) +{ + /* This function can GC */ + struct add_string_extents_arg *closure = + (struct add_string_extents_arg *) arg; + Charcount start = extent_endpoint_char (extent, 0) - closure->from; + Charcount end = extent_endpoint_char (extent, 1) - closure->from; + + if (extent_duplicable_p (extent)) + { + start = max (start, 0); + end = min (end, closure->length); + + /* Run the copy-function to give an extent the option of + not being copied into the string (or kill ring). + */ + if (extent_duplicable_p (extent) && + !run_extent_copy_function (extent, start + closure->from, + end + closure->from)) + return 0; + copy_extent (extent, + string_index_char_to_byte (closure->string, start), + string_index_char_to_byte (closure->string, end), + closure->string); + } + + return 0; +} + /* Add the extents in buffer BUF from OPOINT to OPOINT+LENGTH to the string STRING. */ void -add_string_extents (Lisp_Object string, struct buffer *buf, Bytebpos opoint, +add_string_extents (Lisp_Object string, struct buffer *buf, Bytexpos opoint, Bytecount length) { /* This function can GC */ - struct add_string_extents_arg closure; struct gcpro gcpro1, gcpro2; Lisp_Object buffer; - closure.from = opoint; - closure.length = length; - closure.string = string; buffer = wrap_buffer (buf); GCPRO2 (buffer, string); - map_extents_bytebpos (opoint, opoint + length, add_string_extents_mapper, - (void *) &closure, buffer, 0, - /* ignore extents that just abut the region */ - ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | - /* we are calling E-Lisp (the extent's copy function) - so anything might happen */ - ME_MIGHT_CALL_ELISP); + + if (XSTRING_FORMAT (string) == BUF_FORMAT (buf)) + { + struct add_string_extents_arg closure; + closure.from = opoint; + closure.length = length; + closure.string = string; + map_extents (opoint, opoint + length, add_string_extents_mapper, + (void *) &closure, buffer, 0, + /* ignore extents that just abut the region */ + ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | + /* we are calling E-Lisp (the extent's copy function) + so anything might happen */ + ME_MIGHT_CALL_ELISP); + } + else + { + struct add_string_extents_the_hard_way_arg closure; + closure.from = bytebpos_to_charbpos (buf, opoint); + closure.length = (bytebpos_to_charbpos (buf, opoint + length) - + closure.from); + closure.string = string; + + /* If the string and buffer are in different formats, things get + tricky; the only reasonable way to do the operation is entirely in + char offsets, which are invariant to format changes. In practice, + this won't be time-consuming because the byte/char conversions are + mostly in the buffer, which will be in a fixed-width format. */ + map_extents (opoint, opoint + length, + add_string_extents_the_hard_way_mapper, + (void *) &closure, buffer, 0, + /* ignore extents that just abut the region */ + ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | + /* we are calling E-Lisp (the extent's copy function) + so anything might happen */ + ME_MIGHT_CALL_ELISP); + + } + UNGCPRO; } @@ -5863,7 +6119,7 @@ { Bytecount pos; Bytecount length; - Bytebpos opoint; + Bytexpos opoint; Lisp_Object buffer; }; @@ -5875,15 +6131,15 @@ (struct splice_in_string_extents_arg *) arg; /* BASE_START and BASE_END are the limits in the buffer of the string that was just inserted. - + NEW_START and NEW_END are the prospective buffer positions of the extent that is going into the buffer. */ - Bytebpos base_start = closure->opoint; - Bytebpos base_end = base_start + closure->length; - Bytebpos new_start = (base_start + extent_endpoint_bytebpos (extent, 0) - + Bytexpos base_start = closure->opoint; + Bytexpos base_end = base_start + closure->length; + Bytexpos new_start = (base_start + extent_endpoint_byte (extent, 0) - + closure->pos); + Bytexpos new_end = (base_start + extent_endpoint_byte (extent, 1) - closure->pos); - Bytebpos new_end = (base_start + extent_endpoint_bytebpos (extent, 1) - - closure->pos); if (new_start < base_start) new_start = base_start; @@ -5904,31 +6160,105 @@ return 0; } +struct splice_in_string_extents_the_hard_way_arg +{ + Charcount pos; + Charcount length; + Charxpos opoint; + Lisp_Object buffer; +}; + +static int +splice_in_string_extents_the_hard_way_mapper (EXTENT extent, void *arg) +{ + /* This function can GC */ + struct splice_in_string_extents_arg *closure = + (struct splice_in_string_extents_arg *) arg; + /* BASE_START and BASE_END are the limits in the buffer of the string + that was just inserted. + + NEW_START and NEW_END are the prospective buffer positions of the + extent that is going into the buffer. */ + Charxpos base_start = closure->opoint; + Charxpos base_end = base_start + closure->length; + Charxpos new_start = (base_start + extent_endpoint_char (extent, 0) - + closure->pos); + Charxpos new_end = (base_start + extent_endpoint_char (extent, 1) - + closure->pos); + + if (new_start < base_start) + new_start = base_start; + if (new_end > base_end) + new_end = base_end; + if (new_end <= new_start) + return 0; + + if (!extent_duplicable_p (extent)) + return 0; + + if (!inside_undo && + !run_extent_paste_function_char (extent, new_start, new_end, + closure->buffer)) + return 0; + copy_extent (extent, + charbpos_to_bytebpos (XBUFFER (closure->buffer), new_start), + charbpos_to_bytebpos (XBUFFER (closure->buffer), new_end), + closure->buffer); + + return 0; +} + /* We have just inserted a section of STRING (starting at POS, of length LENGTH) into buffer BUF at OPOINT. Do whatever is necessary to get the string's extents into the buffer. */ void splice_in_string_extents (Lisp_Object string, struct buffer *buf, - Bytebpos opoint, Bytecount length, Bytecount pos) -{ - struct splice_in_string_extents_arg closure; + Bytexpos opoint, Bytecount length, Bytecount pos) +{ struct gcpro gcpro1, gcpro2; Lisp_Object buffer = wrap_buffer (buf); - closure.opoint = opoint; - closure.pos = pos; - closure.length = length; - closure.buffer = buffer; GCPRO2 (buffer, string); - map_extents_bytebpos (pos, pos + length, - splice_in_string_extents_mapper, - (void *) &closure, string, 0, - /* ignore extents that just abut the region */ - ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | - /* we are calling E-Lisp (the extent's copy function) - so anything might happen */ - ME_MIGHT_CALL_ELISP); + if (XSTRING_FORMAT (string) == BUF_FORMAT (buf)) + { + struct splice_in_string_extents_arg closure; + closure.opoint = opoint; + closure.pos = pos; + closure.length = length; + closure.buffer = buffer; + map_extents (pos, pos + length, + splice_in_string_extents_mapper, + (void *) &closure, string, 0, + /* ignore extents that just abut the region */ + ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | + /* we are calling E-Lisp (the extent's copy function) + so anything might happen */ + ME_MIGHT_CALL_ELISP); + } + else + { + struct splice_in_string_extents_the_hard_way_arg closure; + closure.opoint = bytebpos_to_charbpos (buf, opoint); + closure.pos = string_index_byte_to_char (string, pos); + closure.length = string_offset_byte_to_char_len (string, pos, length); + closure.buffer = buffer; + + /* If the string and buffer are in different formats, things get + tricky; the only reasonable way to do the operation is entirely in + char offsets, which are invariant to format changes. In practice, + this won't be time-consuming because the byte/char conversions are + mostly in the buffer, which will be in a fixed-width format. */ + map_extents (pos, pos + length, + splice_in_string_extents_the_hard_way_mapper, + (void *) &closure, string, 0, + /* ignore extents that just abut the region */ + ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | + /* we are calling E-Lisp (the extent's copy function) + so anything might happen */ + ME_MIGHT_CALL_ELISP); + + } UNGCPRO; } @@ -5953,8 +6283,8 @@ (struct copy_string_extents_arg *) arg; Bytecount old_start, old_end, new_start, new_end; - old_start = extent_endpoint_bytebpos (extent, 0); - old_end = extent_endpoint_bytebpos (extent, 1); + old_start = extent_endpoint_byte (extent, 0); + old_end = extent_endpoint_byte (extent, 1); old_start = max (closure->old_pos, old_start); old_end = min (closure->old_pos + closure->length, old_end); @@ -5987,14 +6317,14 @@ closure.new_string = new_string; closure.length = length; GCPRO2 (new_string, old_string); - map_extents_bytebpos (old_pos, old_pos + length, - copy_string_extents_mapper, - (void *) &closure, old_string, 0, - /* ignore extents that just abut the region */ - ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | - /* we are calling E-Lisp (the extent's copy function) - so anything might happen */ - ME_MIGHT_CALL_ELISP); + map_extents (old_pos, old_pos + length, + copy_string_extents_mapper, + (void *) &closure, old_string, 0, + /* ignore extents that just abut the region */ + ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | + /* we are calling E-Lisp (the extent's copy function) + so anything might happen */ + ME_MIGHT_CALL_ELISP); UNGCPRO; } @@ -6016,24 +6346,29 @@ Lisp_Object Qtext_prop; Lisp_Object Qtext_prop_extent_paste_function; -static Lisp_Object -get_text_property_bytebpos (Bytebpos position, Lisp_Object prop, - Lisp_Object object, enum extent_at_flag fl, - int text_props_only) +/* Retrieve the value of the property PROP of the text at position POSITION + in OBJECT. TEXT-PROPS-ONLY means only look at extents with the + `text-prop' property, i.e. extents created by the text property + routines. Otherwise, all extents are examined. &&#### finish Note that + the default extent_at_flag is EXTENT_AT_DEFAULT (same as + EXTENT_AT_AFTER). */ +Lisp_Object +get_char_property (Bytexpos position, Lisp_Object prop, + Lisp_Object object, enum extent_at_flag fl, + int text_props_only) { Lisp_Object extent; /* text_props_only specifies whether we only consider text-property extents (those with the 'text-prop property set) or all extents. */ if (!text_props_only) - extent = extent_at_bytebpos (position, object, prop, 0, fl, 0); + extent = extent_at (position, object, prop, 0, fl, 0); else { EXTENT prior = 0; while (1) { - extent = extent_at_bytebpos (position, object, Qtext_prop, prior, - fl, 0); + extent = extent_at (position, object, Qtext_prop, prior, fl, 0); if (NILP (extent)) return Qnil; if (EQ (prop, Fextent_property (extent, Qtext_prop, Qnil))) @@ -6050,10 +6385,10 @@ } static Lisp_Object -get_text_property_1 (Lisp_Object pos, Lisp_Object prop, Lisp_Object object, - Lisp_Object at_flag, int text_props_only) -{ - Bytebpos position; +get_char_property_char (Lisp_Object pos, Lisp_Object prop, Lisp_Object object, + Lisp_Object at_flag, int text_props_only) +{ + Bytexpos position; int invert = 0; object = decode_buffer_or_string (object); @@ -6077,9 +6412,9 @@ { Lisp_Object val = - get_text_property_bytebpos (position, prop, object, - decode_extent_at_flag (at_flag), - text_props_only); + get_char_property (position, prop, object, + decode_extent_at_flag (at_flag), + text_props_only); if (invert) val = NILP (val) ? Qt : Qnil; return val; @@ -6097,7 +6432,7 @@ */ (pos, prop, object, at_flag)) { - return get_text_property_1 (pos, prop, object, at_flag, 1); + return get_char_property_char (pos, prop, object, at_flag, 1); } DEFUN ("get-char-property", Fget_char_property, 2, 4, 0, /* @@ -6111,7 +6446,7 @@ */ (pos, prop, object, at_flag)) { - return get_text_property_1 (pos, prop, object, at_flag, 0); + return get_char_property_char (pos, prop, object, at_flag, 0); } /* About start/end-open/closed: @@ -6143,7 +6478,7 @@ struct put_text_prop_arg { Lisp_Object prop, value; /* The property and value we are storing */ - Bytebpos start, end; /* The region into which we are storing it */ + Bytexpos start, end; /* The region into which we are storing it */ Lisp_Object object; Lisp_Object the_extent; /* Our chosen extent; this is used for communication between subsequent passes. */ @@ -6157,9 +6492,9 @@ Lisp_Object object = closure->object; Lisp_Object value = closure->value; - Bytebpos e_start, e_end; - Bytebpos start = closure->start; - Bytebpos end = closure->end; + Bytexpos e_start, e_end; + Bytexpos start = closure->start; + Bytexpos end = closure->end; Lisp_Object extent, e_val; int is_eq; @@ -6173,8 +6508,8 @@ /* It's not for this property; do nothing. */ return 0; - e_start = extent_endpoint_bytebpos (e, 0); - e_end = extent_endpoint_bytebpos (e, 1); + e_start = extent_endpoint_byte (e, 0); + e_end = extent_endpoint_byte (e, 1); e_val = Fextent_property (extent, closure->prop, Qnil); is_eq = EQ (value, e_val); @@ -6188,18 +6523,19 @@ */ if (e_start != start || e_end != end) { - Bytebpos new_start = min (e_start, start); - Bytebpos new_end = max (e_end, end); + Bytexpos new_start = min (e_start, start); + Bytexpos new_end = max (e_end, end); set_extent_endpoints (e, new_start, new_end, Qnil); /* If we changed the endpoint, then we need to set its openness. */ set_extent_openness (e, new_start != e_start - ? !NILP (get_text_property_bytebpos + ? !NILP (get_char_property (start, Qstart_open, object, EXTENT_AT_AFTER, 1)) : -1, new_end != e_end - ? NILP (get_text_property_bytebpos - (end - 1, Qend_closed, object, + ? NILP (get_char_property + (prev_bytexpos (object, end), + Qend_closed, object, EXTENT_AT_AFTER, 1)) : -1); closure->changed_p = 1; @@ -6240,8 +6576,8 @@ the-extent to cover it, resulting in the minimum number of extents in the buffer. */ - Bytebpos the_start = extent_endpoint_bytebpos (te, 0); - Bytebpos the_end = extent_endpoint_bytebpos (te, 1); + Bytexpos the_start = extent_endpoint_byte (te, 0); + Bytexpos the_end = extent_endpoint_byte (te, 1); if (e_start != the_start && /* note AND not OR -- hmm, why is this the case? I think it's because the assumption that the text-property @@ -6251,8 +6587,8 @@ falsely marked. Is this bad? */ e_end != the_end) { - Bytebpos new_start = min (e_start, the_start); - Bytebpos new_end = max (e_end, the_end); + Bytexpos new_start = min (e_start, the_start); + Bytexpos new_end = max (e_end, the_end); set_extent_endpoints (te, new_start, new_end, Qnil); /* If we changed the endpoint, then we need to set its openness. We are setting the endpoint to be the same as @@ -6275,9 +6611,11 @@ if (e_end != start) { set_extent_endpoints (e, e_start, start, Qnil); - set_extent_openness (e, -1, NILP (get_text_property_bytebpos - (start - 1, Qend_closed, object, - EXTENT_AT_AFTER, 1))); + set_extent_openness (e, -1, + NILP (get_char_property + (prev_bytexpos (object, start), + Qend_closed, object, + EXTENT_AT_AFTER, 1))); closure->changed_p = 1; } } @@ -6289,7 +6627,7 @@ if (e_start != end) { set_extent_endpoints (e, end, e_end, Qnil); - set_extent_openness (e, !NILP (get_text_property_bytebpos + set_extent_openness (e, !NILP (get_char_property (end, Qstart_open, object, EXTENT_AT_AFTER, 1)), -1); closure->changed_p = 1; @@ -6300,11 +6638,12 @@ /* Otherwise, `extent' straddles the region. We need to split it. */ set_extent_endpoints (e, e_start, start, Qnil); - set_extent_openness (e, -1, NILP (get_text_property_bytebpos - (start - 1, Qend_closed, object, + set_extent_openness (e, -1, NILP (get_char_property + (prev_bytexpos (object, start), + Qend_closed, object, EXTENT_AT_AFTER, 1))); set_extent_openness (copy_extent (e, end, e_end, extent_object (e)), - !NILP (get_text_property_bytebpos + !NILP (get_char_property (end, Qstart_open, object, EXTENT_AT_AFTER, 1)), -1); closure->changed_p = 1; @@ -6317,13 +6656,13 @@ put_text_prop_openness_mapper (EXTENT e, void *arg) { struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg; - Bytebpos e_start, e_end; - Bytebpos start = closure->start; - Bytebpos end = closure->end; + Bytexpos e_start, e_end; + Bytexpos start = closure->start; + Bytexpos end = closure->end; Lisp_Object extent = wrap_extent (e); - e_start = extent_endpoint_bytebpos (e, 0); - e_end = extent_endpoint_bytebpos (e, 1); + e_start = extent_endpoint_byte (e, 0); + e_end = extent_endpoint_byte (e, 1); if (NILP (Fextent_property (extent, Qtext_prop, Qnil))) { @@ -6342,7 +6681,7 @@ } static int -put_text_prop (Bytebpos start, Bytebpos end, Lisp_Object object, +put_text_prop (Bytexpos start, Bytexpos end, Lisp_Object object, Lisp_Object prop, Lisp_Object value, int duplicable_p) { @@ -6375,25 +6714,36 @@ closure.changed_p = 0; closure.the_extent = Qnil; - map_extents_bytebpos (start, end, - put_text_prop_mapper, - (void *) &closure, object, 0, - /* get all extents that abut the region */ - ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED | - /* it might QUIT or error if the user has - fucked with the extent plist. */ - /* #### dmoore - I think this should include - ME_MIGHT_MOVE_SOE, since the callback function - might recurse back into map_extents_bytebpos. */ - ME_MIGHT_THROW | - ME_MIGHT_MODIFY_EXTENTS); + map_extents (start, end, + put_text_prop_mapper, + (void *) &closure, object, 0, + /* get all extents that abut the region */ + ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED | +#if 0 + /* it might move the SOE because the callback function calls + get_char_property(), which calls extent_at(), which calls + map_extents() + + #### this was comment out before, and nothing seemed broken; + #### but when I added the above comment and uncommented it, + #### text property operations (e.g. font-lock) suddenly + #### became *WAY* slow, and dominated font-lock, when a + #### single extent spanning the entire buffer + #### existed. --ben */ + ME_MIGHT_MOVE_SOE | +#endif + /* it might QUIT or error if the user has + fucked with the extent plist. */ + ME_MIGHT_THROW | + ME_MIGHT_MODIFY_EXTENTS); /* If we made it through the loop without reusing an extent (and we want there to be one) make it now. */ if (!NILP (value) && NILP (closure.the_extent)) { - Lisp_Object extent = wrap_extent (make_extent_internal (object, start, end)); + Lisp_Object extent = + wrap_extent (make_extent (object, start, end)); closure.changed_p = 1; Fset_extent_property (extent, Qtext_prop, prop); @@ -6405,22 +6755,22 @@ Qtext_prop_extent_paste_function); } set_extent_openness (XEXTENT (extent), - !NILP (get_text_property_bytebpos + !NILP (get_char_property (start, Qstart_open, object, EXTENT_AT_AFTER, 1)), - NILP (get_text_property_bytebpos - (end - 1, Qend_closed, object, + NILP (get_char_property + (prev_bytexpos (object, end), + Qend_closed, object, EXTENT_AT_AFTER, 1))); } if (EQ (prop, Qstart_open) || EQ (prop, Qend_closed)) { - map_extents_bytebpos (start, end, - put_text_prop_openness_mapper, - (void *) &closure, object, 0, - /* get all extents that abut the region */ - ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED | - ME_MIGHT_MODIFY_EXTENTS); + map_extents (start, end, put_text_prop_openness_mapper, + (void *) &closure, object, 0, + /* get all extents that abut the region */ + ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED | + ME_MIGHT_MODIFY_EXTENTS); } return closure.changed_p; @@ -6436,7 +6786,7 @@ (start, end, prop, value, object)) { /* This function can GC */ - Bytebpos s, e; + Bytexpos s, e; object = decode_buffer_or_string (object); get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); @@ -6456,7 +6806,7 @@ (start, end, prop, value, object)) { /* This function can GC */ - Bytebpos s, e; + Bytexpos s, e; object = decode_buffer_or_string (object); get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); @@ -6475,7 +6825,7 @@ { /* This function can GC */ int changed = 0; - Bytebpos s, e; + Bytexpos s, e; object = decode_buffer_or_string (object); get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); @@ -6503,7 +6853,7 @@ { /* This function can GC */ int changed = 0; - Bytebpos s, e; + Bytexpos s, e; object = decode_buffer_or_string (object); get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); @@ -6528,7 +6878,7 @@ { /* This function can GC */ int changed = 0; - Bytebpos s, e; + Bytexpos s, e; object = decode_buffer_or_string (object); get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); @@ -6581,9 +6931,83 @@ return Qnil; /* important! */ } -/* This function could easily be written in Lisp but the C code wants - to use it in connection with invisible extents (at least currently). - If this changes, consider moving this back into Lisp. */ +Bytexpos +next_single_property_change (Bytexpos pos, Lisp_Object prop, + Lisp_Object object, Bytexpos limit) +{ + Lisp_Object extent, value; + int limit_was_nil; + + if (limit < 0) + { + limit = buffer_or_string_accessible_end_byte (object); + limit_was_nil = 1; + } + else + limit_was_nil = 0; + + extent = extent_at (pos, object, prop, 0, EXTENT_AT_AFTER, 0); + if (!NILP (extent)) + value = Fextent_property (extent, prop, Qnil); + else + value = Qnil; + + while (1) + { + pos = extent_find_end_of_run (object, pos, 1); + if (pos >= limit) + break; /* property is the same all the way to the end */ + extent = extent_at (pos, object, prop, 0, EXTENT_AT_AFTER, 0); + if ((NILP (extent) && !NILP (value)) || + (!NILP (extent) && !EQ (value, + Fextent_property (extent, prop, Qnil)))) + return pos; + } + + if (limit_was_nil) + return -1; + else + return limit; +} + +Bytexpos +previous_single_property_change (Bytexpos pos, Lisp_Object prop, + Lisp_Object object, Bytexpos limit) +{ + Lisp_Object extent, value; + int limit_was_nil; + + if (limit < 0) + { + limit = buffer_or_string_accessible_begin_byte (object); + limit_was_nil = 1; + } + else + limit_was_nil = 0; + + extent = extent_at (pos, object, prop, 0, EXTENT_AT_BEFORE, 0); + if (!NILP (extent)) + value = Fextent_property (extent, prop, Qnil); + else + value = Qnil; + + while (1) + { + pos = extent_find_beginning_of_run (object, pos, 1); + if (pos <= limit) + break; /* property is the same all the way to the end */ + extent = extent_at (pos, object, prop, 0, EXTENT_AT_BEFORE, 0); + if ((NILP (extent) && !NILP (value)) || + (!NILP (extent) && !EQ (value, + Fextent_property (extent, prop, Qnil)))) + return pos; + } + + if (limit_was_nil) + return -1; + else + return limit; +} DEFUN ("next-single-property-change", Fnext_single_property_change, 2, 4, 0, /* @@ -6605,52 +7029,20 @@ */ (pos, prop, object, limit)) { - Charbpos bpos; - Charbpos blim; - Lisp_Object extent, value; - int limit_was_nil; + Bytexpos xpos; + Bytexpos blim; object = decode_buffer_or_string (object); - bpos = get_buffer_or_string_pos_char (object, pos, 0); - if (NILP (limit)) - { - blim = buffer_or_string_accessible_end_char (object); - limit_was_nil = 1; - } - else - { - blim = get_buffer_or_string_pos_char (object, limit, 0); - limit_was_nil = 0; - } - - extent = Fextent_at (make_int (bpos), object, prop, Qnil, Qnil); - if (!NILP (extent)) - value = Fextent_property (extent, prop, Qnil); - else - value = Qnil; - - while (1) - { - bpos = XINT (Fnext_extent_change (make_int (bpos), object)); - if (bpos >= blim) - break; /* property is the same all the way to the end */ - extent = Fextent_at (make_int (bpos), object, prop, Qnil, Qnil); - if ((NILP (extent) && !NILP (value)) || - (!NILP (extent) && !EQ (value, - Fextent_property (extent, prop, Qnil)))) - return make_int (bpos); - } - - /* I think it's more sensible for this function to return nil always - in this situation and it used to do it this way, but it's been changed - for FSF compatibility. */ - if (limit_was_nil) + xpos = get_buffer_or_string_pos_byte (object, pos, 0); + blim = !NILP (limit) ? get_buffer_or_string_pos_byte (object, limit, 0) : -1; + + blim = next_single_property_change (xpos, prop, object, blim); + + if (blim < 0) return Qnil; else - return make_int (blim); -} - -/* See comment on previous function about why this is written in C. */ + return make_int (buffer_or_string_bytexpos_to_charxpos (object, blim)); +} DEFUN ("previous-single-property-change", Fprevious_single_property_change, 2, 4, 0, /* @@ -6672,52 +7064,19 @@ */ (pos, prop, object, limit)) { - Charbpos bpos; - Charbpos blim; - Lisp_Object extent, value; - int limit_was_nil; + Bytexpos xpos; + Bytexpos blim; object = decode_buffer_or_string (object); - bpos = get_buffer_or_string_pos_char (object, pos, 0); - if (NILP (limit)) - { - blim = buffer_or_string_accessible_begin_char (object); - limit_was_nil = 1; - } - else - { - blim = get_buffer_or_string_pos_char (object, limit, 0); - limit_was_nil = 0; - } - - /* extent-at refers to the character AFTER bpos, but we want the - character before bpos. Thus the - 1. extent-at simply - returns nil on bogus positions, so not to worry. */ - extent = Fextent_at (make_int (bpos - 1), object, prop, Qnil, Qnil); - if (!NILP (extent)) - value = Fextent_property (extent, prop, Qnil); - else - value = Qnil; - - while (1) - { - bpos = XINT (Fprevious_extent_change (make_int (bpos), object)); - if (bpos <= blim) - break; /* property is the same all the way to the beginning */ - extent = Fextent_at (make_int (bpos - 1), object, prop, Qnil, Qnil); - if ((NILP (extent) && !NILP (value)) || - (!NILP (extent) && !EQ (value, - Fextent_property (extent, prop, Qnil)))) - return make_int (bpos); - } - - /* I think it's more sensible for this function to return nil always - in this situation and it used to do it this way, but it's been changed - for FSF compatibility. */ - if (limit_was_nil) + xpos = get_buffer_or_string_pos_byte (object, pos, 0); + blim = !NILP (limit) ? get_buffer_or_string_pos_byte (object, limit, 0) : -1; + + blim = previous_single_property_change (xpos, prop, object, blim); + + if (blim < 0) return Qnil; else - return make_int (blim); + return make_int (buffer_or_string_bytexpos_to_charxpos (object, blim)); } #ifdef MEMORY_USAGE_STATS
--- a/src/extents.h Thu May 02 14:35:32 2002 +0000 +++ b/src/extents.h Sun May 05 11:33:57 2002 +0000 @@ -1,5 +1,5 @@ /* Copyright (c) 1994, 1995 Free Software Foundation. - Copyright (c) 1995 Ben Wing. + Copyright (c) 1995, 1996 Ben Wing. This file is part of XEmacs. @@ -43,8 +43,8 @@ { struct lrecord_header lheader; - Membpos start; - Membpos end; + Memxpos start; + Memxpos end; Lisp_Object object; /* A buffer, string, Qnil (extent detached from no buffer), Qt (destroyed extent) */ @@ -109,6 +109,9 @@ ((endp) ? set_extent_end (e, val) : set_extent_start (e, val)) #define extent_detached_p(e) (extent_start (e) < 0) +void set_extent_endpoints (EXTENT extent, Bytexpos s, Bytexpos e, + Lisp_Object object); + /* Additional information that may be present in an extent. The idea is that fast access is provided to this information, but since (hopefully) most extents won't have this set on them, we usually don't need to @@ -177,9 +180,10 @@ #define extent_no_chase_normal_field(e, field) ((e)->flags.field) -INLINE_HEADER struct extent_auxiliary *extent_aux_or_default (EXTENT e); -INLINE_HEADER struct extent_auxiliary * +DECLARE_INLINE_HEADER ( +struct extent_auxiliary * extent_aux_or_default (EXTENT e) +) { return e->flags.has_aux ? XEXTENT_AUXILIARY (XCAR (e->plist)) : @@ -218,6 +222,19 @@ #define extent_parent(e) extent_no_chase_aux_field (e, parent) #define extent_children(e) extent_no_chase_aux_field (e, children) +EXTENT extent_ancestor_1 (EXTENT e); + +/* extent_ancestor() chases all the parent links until there aren't any + more. extent_ancestor_1() does the same thing but it a function; + the following optimizes the most common case. */ +DECLARE_INLINE_HEADER ( +EXTENT +extent_ancestor (EXTENT e) +) +{ + return e->flags.has_parent ? extent_ancestor_1 (e) : e; +} + #define extent_begin_glyph(e) extent_aux_field (e, begin_glyph) #define extent_end_glyph(e) extent_aux_field (e, end_glyph) #define extent_priority(e) extent_aux_field (e, priority) @@ -280,9 +297,13 @@ #define set_extent_in_red_event_p(e, val) \ set_extent_normal_field (e, in_red_event, val) -INLINE_HEADER Lisp_Object * extent_no_chase_plist_addr (EXTENT e); -INLINE_HEADER Lisp_Object * +void set_extent_glyph (EXTENT extent, Lisp_Object glyph, int endp, + glyph_layout layout); + +DECLARE_INLINE_HEADER ( +Lisp_Object * extent_no_chase_plist_addr (EXTENT e) +) { return e->flags.has_aux ? &XCDR (e->plist) : &e->plist; } @@ -329,17 +350,6 @@ x = wrong_type_argument (Qextent_live_p, (x)); \ } while (0) -EXFUN (Fdetach_extent, 1); -EXFUN (Fextent_end_position, 1); -EXFUN (Fextent_object, 1); -EXFUN (Fextent_start_position, 1); -EXFUN (Fmake_extent, 3); -EXFUN (Fprevious_single_property_change, 4); -EXFUN (Fset_extent_endpoints, 4); -EXFUN (Fnext_extent_change, 2); -EXFUN (Fprevious_extent_change, 2); -EXFUN (Fset_extent_parent, 2); -EXFUN (Fget_char_property, 4); extern int inside_undo; extern int in_modeline_generation; @@ -348,68 +358,15 @@ struct frame *frm); face_index extent_fragment_update (struct window *w, struct extent_fragment *ef, - /* Note this is in Bytebpos' */ - Bytebpos pos, Lisp_Object last_glyph); + Bytexpos pos, Lisp_Object last_glyph); void extent_fragment_delete (struct extent_fragment *ef); - -#ifdef emacs /* things other than emacs want the structs */ - /* from alloc.c */ struct extent *allocate_extent (void); -/* from extents.c */ -EXTENT extent_ancestor_1 (EXTENT e); - -/* extent_ancestor() chases all the parent links until there aren't any - more. extent_ancestor_1() does the same thing but it a function; - the following optimizes the most common case. */ -INLINE_HEADER EXTENT extent_ancestor (EXTENT e); -INLINE_HEADER EXTENT -extent_ancestor (EXTENT e) -{ - return e->flags.has_parent ? extent_ancestor_1 (e) : e; -} - void allocate_extent_auxiliary (EXTENT ext); void init_buffer_extents (struct buffer *b); void uninit_buffer_extents (struct buffer *b); -typedef int (*map_extents_fun) (EXTENT extent, void *arg); -void map_extents (Charbpos from, Charbpos to, map_extents_fun fn, - void *arg, Lisp_Object obj, EXTENT after, - unsigned int flags); - -/* Note the following five functions are NOT in Charbpos's */ -void adjust_extents (Lisp_Object object, Membpos from, - Membpos to, int amount); -void adjust_extents_for_deletion (Lisp_Object object, Bytebpos from, - Bytebpos to, int gapsize, - int numdel, int movegapsize); -void verify_extent_modification (Lisp_Object object, Bytebpos from, - Bytebpos to, - Lisp_Object inhibit_read_only_value); -void process_extents_for_insertion (Lisp_Object object, - Bytebpos opoint, Bytecount length); -void process_extents_for_deletion (Lisp_Object object, Bytebpos from, - Bytebpos to, int destroy_them); -void report_extent_modification (Lisp_Object, Charbpos, Charbpos, int); - -void set_extent_glyph (EXTENT extent, Lisp_Object glyph, int endp, - glyph_layout layout); - -void add_string_extents (Lisp_Object string, struct buffer *buf, - Bytebpos opoint, Bytecount length); -void splice_in_string_extents (Lisp_Object string, struct buffer *buf, - Bytebpos opoint, Bytecount length, - Bytecount pos); -void copy_string_extents (Lisp_Object new_string, - Lisp_Object old_string, - Bytecount new_pos, Bytecount old_pos, - Bytecount length); - -void detach_all_extents (Lisp_Object object); -void set_extent_endpoints (EXTENT extent, Bytebpos s, Bytebpos e, - Lisp_Object object); #ifdef ERROR_CHECK_EXTENTS void sledgehammer_extent_check (Lisp_Object obj); @@ -420,6 +377,4 @@ struct overhead_stats *ovstats); #endif -#endif /* emacs */ - #endif /* INCLUDED_extents_h_ */
--- a/src/faces.c Thu May 02 14:35:32 2002 +0000 +++ b/src/faces.c Sun May 05 11:33:57 2002 +0000 @@ -110,7 +110,7 @@ write_fmt_string_lisp (printcharfun, "#<face %S", 1, face->name); if (!NILP (face->doc_string)) write_fmt_string_lisp (printcharfun, " %S", 1, face->doc_string); - write_c_string (">", printcharfun); + write_c_string (printcharfun, ">"); } } @@ -497,8 +497,8 @@ struct face_inheritance_closure *fcl = (struct face_inheritance_closure *) face_inheritance_closure; - CVOID_TO_LISP (key, hash_key); - VOID_TO_LISP (contents, hash_contents); + key = VOID_TO_LISP (hash_key); + contents = VOID_TO_LISP (hash_contents); if (EQ (fcl->property, Qfont)) { @@ -1110,7 +1110,7 @@ for (i = 0; i < NUM_LEADING_BYTES; i++) if (charsets[i]) { - Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i + MIN_LEADING_BYTE); + Lisp_Object charset = charset_by_leading_byte (i + MIN_LEADING_BYTE); assert (CHARSETP (charset)); ensure_face_cachel_contains_charset (cachel, domain, charset); } @@ -1132,7 +1132,7 @@ { if (charsets[i]) { - Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i + MIN_LEADING_BYTE); + Lisp_Object charset = charset_by_leading_byte (i + MIN_LEADING_BYTE); Lisp_Object font_instance = FACE_CACHEL_FONT (cachel, charset); Lisp_Font_Instance *fi = XFONT_INSTANCE (font_instance);
--- a/src/file-coding.c Thu May 02 14:35:32 2002 +0000 +++ b/src/file-coding.c Sun May 05 11:33:57 2002 +0000 @@ -550,7 +550,7 @@ write_fmt_string_lisp (printcharfun, "#<coding-system %s ", 1, c->name); print_coding_system_properties (obj, printcharfun); - write_c_string (">", printcharfun); + write_c_string (printcharfun, ">"); } /* Print an abbreviated version of a coding system (but still containing @@ -562,7 +562,7 @@ { write_fmt_string_lisp (printcharfun, "%s[", 1, XCODING_SYSTEM_NAME (cs)); print_coding_system_properties (cs, printcharfun); - write_c_string ("]", printcharfun); + write_c_string (printcharfun, "]"); } static void @@ -2684,10 +2684,10 @@ { int i; - write_c_string ("(", printcharfun); + write_c_string (printcharfun, "("); for (i = 0; i < XCODING_SYSTEM_CHAIN_COUNT (cs); i++) { - write_c_string (i == 0 ? "" : "->", printcharfun); + write_c_string (printcharfun, i == 0 ? "" : "->"); print_coding_system_in_print_method (XCODING_SYSTEM_CHAIN_CHAIN (cs)[i], printcharfun, escapeflag); } @@ -2696,13 +2696,13 @@ if (!NILP (cac)) { if (i > 0) - write_c_string (" ", printcharfun); - write_c_string ("canonicalize-after-coding=", printcharfun); + write_c_string (printcharfun, " "); + write_c_string (printcharfun, "canonicalize-after-coding="); print_coding_system_in_print_method (cac, printcharfun, escapeflag); } } - write_c_string (")", printcharfun); + write_c_string (printcharfun, ")"); } static void @@ -2944,13 +2944,13 @@ while (n--) { c = *src++; - if (BYTE_ASCII_P (c)) + if (byte_ascii_p (c)) { assert (ch == 0); Dynarr_add (dst, c); } #ifdef MULE - else if (INTBYTE_LEADING_BYTE_P (c)) + else if (intbyte_leading_byte_p (c)) { assert (ch == 0); if (c == LEADING_BYTE_LATIN_ISO8859_1 || @@ -3322,27 +3322,27 @@ XCODING_SYSTEM_TYPE_DATA (cs, undecided); int need_space = 0; - write_c_string ("(", printcharfun); + write_c_string (printcharfun, "("); if (data->do_eol) { - write_c_string ("do-eol", printcharfun); + write_c_string (printcharfun, "do-eol"); need_space = 1; } if (data->do_coding) { if (need_space) - write_c_string (" ", printcharfun); - write_c_string ("do-coding", printcharfun); + write_c_string (printcharfun, " "); + write_c_string (printcharfun, "do-coding"); need_space = 1; } if (!NILP (data->cs)) { if (need_space) - write_c_string (" ", printcharfun); - write_c_string ("coding-system=", printcharfun); + write_c_string (printcharfun, " "); + write_c_string (printcharfun, "coding-system="); print_coding_system_in_print_method (data->cs, printcharfun, escapeflag); } - write_c_string (")", printcharfun); + write_c_string (printcharfun, ")"); } static void @@ -4303,12 +4303,12 @@ { struct gzip_coding_system *data = XCODING_SYSTEM_TYPE_DATA (cs, gzip); - write_c_string ("(", printcharfun); + write_c_string (printcharfun, "("); if (data->level == -1) - write_c_string ("default", printcharfun); + write_c_string (printcharfun, "default"); else print_internal (make_int (data->level), printcharfun, 0); - write_c_string (")", printcharfun); + write_c_string (printcharfun, ")"); } static int
--- a/src/file-coding.h Thu May 02 14:35:32 2002 +0000 +++ b/src/file-coding.h Sun May 05 11:33:57 2002 +0000 @@ -452,10 +452,10 @@ #define DECLARE_CODING_SYSTEM_TYPE(type) \ \ extern struct coding_system_methods * type##_coding_system_methods; \ -INLINE_HEADER struct type##_coding_system * \ -error_check_##type##_coding_system_data (Lisp_Coding_System *cs); \ -INLINE_HEADER struct type##_coding_system * \ +DECLARE_INLINE_HEADER ( \ +struct type##_coding_system * \ error_check_##type##_coding_system_data (Lisp_Coding_System *cs) \ +) \ { \ assert (CODING_SYSTEM_TYPE_P (cs, type)); \ /* Catch accidental use of INITIALIZE_CODING_SYSTEM_TYPE in place \ @@ -464,19 +464,19 @@ return (struct type##_coding_system *) cs->data; \ } \ \ -INLINE_HEADER struct type##_coding_stream * \ -error_check_##type##_coding_stream_data (struct coding_stream *s); \ -INLINE_HEADER struct type##_coding_stream * \ +DECLARE_INLINE_HEADER ( \ +struct type##_coding_stream * \ error_check_##type##_coding_stream_data (struct coding_stream *s) \ +) \ { \ assert (XCODING_SYSTEM_TYPE_P (s->codesys, type)); \ return (struct type##_coding_stream *) s->data; \ } \ \ -INLINE_HEADER Lisp_Coding_System * \ -error_check_##type##_coding_system_type (Lisp_Object obj); \ -INLINE_HEADER Lisp_Coding_System * \ +DECLARE_INLINE_HEADER ( \ +Lisp_Coding_System * \ error_check_##type##_coding_system_type (Lisp_Object obj) \ +) \ { \ Lisp_Coding_System *cs = XCODING_SYSTEM (obj); \ assert (CODING_SYSTEM_TYPE_P (cs, type)); \ @@ -959,9 +959,9 @@ #define DECODE_ADD_BINARY_CHAR(c, dst) \ do { \ - if (BYTE_ASCII_P (c)) \ + if (byte_ascii_p (c)) \ Dynarr_add (dst, c); \ - else if (BYTE_C1_P (c)) \ + else if (byte_c1_p (c)) \ { \ Dynarr_add (dst, LEADING_BYTE_CONTROL_1); \ Dynarr_add (dst, c + 0x20); \
--- a/src/fileio.c Thu May 02 14:35:32 2002 +0000 +++ b/src/fileio.c Sun May 05 11:33:57 2002 +0000 @@ -1423,7 +1423,7 @@ { Lisp_Object resolved_name; int rlen = qxestrlen (resolved_path); - if (elen > 0 && IS_DIRECTORY_SEP (XSTRING_BYTE (expanded_name, elen - 1)) + if (elen > 0 && IS_DIRECTORY_SEP (string_byte (expanded_name, elen - 1)) && !(rlen > 0 && IS_DIRECTORY_SEP (resolved_path[rlen - 1]))) { if (rlen + 1 > countof (resolved_path)) @@ -1657,8 +1657,8 @@ /* Remove final slash, if any (unless path is root). stat behaves differently depending! */ if (XSTRING_LENGTH (abspath) > 1 - && IS_DIRECTORY_SEP (XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 1)) - && !IS_DEVICE_SEP (XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 2))) + && IS_DIRECTORY_SEP (string_byte (abspath, XSTRING_LENGTH (abspath) - 1)) + && !IS_DEVICE_SEP (string_byte (abspath, XSTRING_LENGTH (abspath) - 2))) /* We cannot take shortcuts; they might be wrong for magic file names. */ abspath = Fdirectory_file_name (abspath); UNGCPRO; @@ -1773,7 +1773,7 @@ args[1] = Qnil; args[2] = Qnil; NGCPRO1 (*args); ngcpro1.nvars = 3; - if (!IS_DIRECTORY_SEP (XSTRING_BYTE (newname, + if (!IS_DIRECTORY_SEP (string_byte (newname, XSTRING_LENGTH (newname) - 1))) args[i++] = Fchar_to_string (Vdirectory_sep_char); @@ -2014,7 +2014,7 @@ args[1] = Qnil; args[2] = Qnil; NGCPRO1 (*args); ngcpro1.nvars = 3; - if (XSTRING_BYTE (newname, XSTRING_LENGTH (newname) - 1) != '/') + if (string_byte (newname, XSTRING_LENGTH (newname) - 1) != '/') args[i++] = build_string ("/"); args[i++] = Ffile_name_nondirectory (filename); newname = Fconcat (i, args); @@ -2124,7 +2124,7 @@ /* If the link target has a ~, we must expand it to get a truly valid file name. Otherwise, do not expand; we want to permit links to relative file names. */ - if (XSTRING_BYTE (filename, 0) == '~') + if (string_byte (filename, 0) == '~') filename = Fexpand_file_name (filename, Qnil); linkname = Fexpand_file_name (linkname, Qnil);
--- a/src/fns.c Thu May 02 14:35:32 2002 +0000 +++ b/src/fns.c Sun May 05 11:33:57 2002 +0000 @@ -81,17 +81,17 @@ if (INTP (Vprint_length)) last = min (len, XINT (Vprint_length)); - write_c_string ("#*", printcharfun); + write_c_string (printcharfun, "#*"); for (i = 0; i < last; i++) { if (bit_vector_bit (v, i)) - write_c_string ("1", printcharfun); + write_c_string (printcharfun, "1"); else - write_c_string ("0", printcharfun); + write_c_string (printcharfun, "0"); } if (last != len) - write_c_string ("...", printcharfun); + write_c_string (printcharfun, "..."); } static int @@ -222,7 +222,7 @@ { retry: if (STRINGP (sequence)) - return make_int (XSTRING_CHAR_LENGTH (sequence)); + return make_int (string_char_length (sequence)); else if (CONSP (sequence)) { Elemcount len; @@ -381,8 +381,8 @@ p2 = string2; } - end = XSTRING_CHAR_LENGTH (p1); - len2 = XSTRING_CHAR_LENGTH (p2); + end = string_char_length (p1); + len2 = string_char_length (p2); if (end > len2) end = len2; @@ -1114,7 +1114,7 @@ CHECK_STRING (path); while (!STRINGP (Vpath_separator) - || (XSTRING_CHAR_LENGTH (Vpath_separator) != 1)) + || (string_char_length (Vpath_separator) != 1)) Vpath_separator = signal_continuable_error (Qinvalid_state, "`path-separator' should be set to a single-character string", @@ -2887,7 +2887,7 @@ sledgehammer_check_ascii_begin (array); item_bytecount = set_charptr_emchar (item_buf, XCHAR (item)); - new_bytecount = item_bytecount * (Bytecount) XSTRING_CHAR_LENGTH (array); + new_bytecount = item_bytecount * (Bytecount) string_char_length (array); resize_string (array, -1, new_bytecount - old_bytecount); @@ -3855,7 +3855,7 @@ CHECK_STRING (string); - length = XSTRING_CHAR_LENGTH (string); + length = string_char_length (string); allength = length + length/3 + 1; allength += allength / MIME_LINE_LENGTH + 1 + 6; @@ -3930,7 +3930,7 @@ CHECK_STRING (string); - length = XSTRING_CHAR_LENGTH (string); + length = string_char_length (string); /* We need to allocate enough room for decoding the text. */ XMALLOC_OR_ALLOCA (decoded, length * MAX_EMCHAR_LEN, Intbyte);
--- a/src/font-lock.c Thu May 02 14:35:32 2002 +0000 +++ b/src/font-lock.c Sun May 05 11:33:57 2002 +0000 @@ -1,6 +1,7 @@ /* Routines to compute the current syntactic context, for font-lock mode. Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. + Copyright (C) 2002 Ben Wing. This file is part of XEmacs. @@ -43,6 +44,8 @@ This way there would be no guessing or incorrect results. */ +#if 0 /* no longer used */ + #include <config.h> #include "lisp.h" @@ -424,21 +427,19 @@ find_context (struct buffer *buf, Charbpos pt) { /* This function can GC */ -#ifndef emacs - Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table); - Lisp_Object syntaxtab = buf->syntax_table; -#endif Emchar prev_c, c; int prev_syncode, syncode; Charbpos target = pt; + struct syntax_cache *scache; + setup_context_cache (buf, pt); pt = context_cache.cur_point; - SETUP_SYNTAX_CACHE (pt - 1, 1); + scache = setup_buffer_syntax_cache (buf, pt - 1, 1); if (pt > BUF_BEGV (buf)) { c = BUF_FETCH_CHAR (buf, pt - 1); - syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c); + syncode = SYNTAX_CODE_FROM_CACHE (scache, c); } else { @@ -479,11 +480,11 @@ } } - UPDATE_SYNTAX_CACHE_FORWARD (pt); + UPDATE_SYNTAX_CACHE_FORWARD (scache, pt); prev_c = c; prev_syncode = syncode; c = BUF_FETCH_CHAR (buf, pt); - syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c); + syncode = SYNTAX_CODE_FROM_CACHE (scache, c); if (prev_c == '\n') bol_context_cache = context_cache; @@ -494,7 +495,7 @@ continue; } - switch (SYNTAX_FROM_CACHE (mirrortab, c)) + switch (SYNTAX_FROM_CODE (syncode)) { case Sescape: context_cache.backslash_p = 1; @@ -549,7 +550,7 @@ else if (context_cache.context == context_none) { Lisp_Object stringtermobj = - syntax_match (syntax_cache.current_syntax_table, c); + syntax_match (scache->current_syntax_table, c); Emchar stringterm; if (CHARP (stringtermobj)) @@ -841,3 +842,4 @@ { reinit_vars_of_font_lock (); } +#endif /* 0 */
--- a/src/frame-gtk.c Thu May 02 14:35:32 2002 +0000 +++ b/src/frame-gtk.c Sun May 05 11:33:57 2002 +0000 @@ -291,7 +291,7 @@ /* Optimize for common ASCII case */ for (ptr = value; *ptr; ptr++) - if (!BYTE_ASCII_P (*ptr)) + if (!byte_ascii_p (*ptr)) { char *tmp; C_STRING_TO_EXTERNAL (value, tmp, Qctext);
--- a/src/frame-msw.c Thu May 02 14:35:32 2002 +0000 +++ b/src/frame-msw.c Sun May 05 11:33:57 2002 +0000 @@ -494,7 +494,7 @@ /* Yippie! */ ScreenToClient (hwnd, &pt); - VOID_TO_LISP (*frame, qxeGetWindowLong (hwnd, XWL_FRAMEOBJ)); + *frame = VOID_TO_LISP ((void *) qxeGetWindowLong (hwnd, XWL_FRAMEOBJ)); *x = pt.x; *y = pt.y; return 1; @@ -746,7 +746,7 @@ if (hwnd) { Lisp_Object parent; - VOID_TO_LISP (parent, qxeGetWindowLong (hwnd, XWL_FRAMEOBJ)); + parent = VOID_TO_LISP ((void *) qxeGetWindowLong (hwnd, XWL_FRAMEOBJ)); assert (FRAME_MSWINDOWS_P (XFRAME (parent))); return parent; }
--- a/src/frame-x.c Thu May 02 14:35:32 2002 +0000 +++ b/src/frame-x.c Sun May 05 11:33:57 2002 +0000 @@ -1,6 +1,6 @@ /* Functions for the X window system. Copyright (C) 1989, 1992-5, 1997 Free Software Foundation, Inc. - Copyright (C) 1995, 1996, 2001 Ben Wing. + Copyright (C) 1995, 1996, 2001, 2002 Ben Wing. This file is part of XEmacs. @@ -665,7 +665,7 @@ Intbyte *ptr; /* Optimize for common ASCII case */ for (ptr = value; *ptr; ptr++) - if (!BYTE_ASCII_P (*ptr)) + if (!byte_ascii_p (*ptr)) { const char * tmp; encoding = DEVICE_XATOM_COMPOUND_TEXT (XDEVICE (FRAME_DEVICE (f)));
--- a/src/frame.c Thu May 02 14:35:32 2002 +0000 +++ b/src/frame.c Sun May 05 11:33:57 2002 +0000 @@ -228,7 +228,7 @@ buf = Fcurrent_buffer (); /* If buf is a 'hidden' buffer (i.e. one whose name starts with a space), try to find another one. */ - if (XSTRING_CHAR (Fbuffer_name (buf), 0) == ' ') + if (string_emchar (Fbuffer_name (buf), 0) == ' ') buf = Fother_buffer (buf, Qnil, Qnil); Fset_window_buffer (root_window, buf, Qnil); } @@ -818,7 +818,7 @@ #if 0 /* FSFmacs */ -xxDEFUN ("handle-switch-frame", Fhandle_switch_frame, 1, 2, "e", /* +DEFUN ("handle-switch-frame", Fhandle_switch_frame, 1, 2, "e", /* Handle a switch-frame event EVENT. Switch-frame events are usually bound to this function. A switch-frame event tells Emacs that the window manager has requested @@ -839,7 +839,7 @@ } /* A load of garbage. */ -xxDEFUN ("ignore-event", Fignore_event, 0, 0, "", /* +DEFUN ("ignore-event", Fignore_event, 0, 0, "", /* Do nothing, but preserve any prefix argument already specified. This is a suitable binding for iconify-frame and make-frame-visible. */
--- a/src/frame.h Thu May 02 14:35:32 2002 +0000 +++ b/src/frame.h Sun May 05 11:33:57 2002 +0000 @@ -1,5 +1,6 @@ /* Define frame-object for XEmacs. Copyright (C) 1988, 1992, 1993, 1994 Free Software Foundation, Inc. + Copyright (C) 1995 Ben Wing. This file is part of XEmacs. @@ -246,10 +247,10 @@ #define FRAME_TYPE_P(f, type) EQ (FRAME_TYPE (f), Q##type) #ifdef ERROR_CHECK_TYPES -INLINE_HEADER struct frame * -error_check_frame_type (struct frame * f, Lisp_Object sym); -INLINE_HEADER struct frame * +DECLARE_INLINE_HEADER ( +struct frame * error_check_frame_type (struct frame * f, Lisp_Object sym) +) { assert (EQ (FRAME_TYPE (f), sym)); return f;
--- a/src/glade.c Thu May 02 14:35:32 2002 +0000 +++ b/src/glade.c Sun May 05 11:33:57 2002 +0000 @@ -32,7 +32,7 @@ Lisp_Object func; Lisp_Object lisp_data = Qnil; - VOID_TO_LISP (func, user_data); + func = VOID_TO_LISP (user_data); if (NILP (func)) {
--- a/src/glyphs-gtk.c Thu May 02 14:35:32 2002 +0000 +++ b/src/glyphs-gtk.c Sun May 05 11:33:57 2002 +0000 @@ -74,16 +74,6 @@ #include "file-coding.h" -#if INTBITS == 32 -# define FOUR_BYTE_TYPE unsigned int -#elif LONGBITS == 32 -# define FOUR_BYTE_TYPE unsigned long -#elif SHORTBITS == 32 -# define FOUR_BYTE_TYPE unsigned short -#else -#error What kind of strange-ass system are we running on? -#endif - DECLARE_IMAGE_INSTANTIATOR_FORMAT (nothing); DECLARE_IMAGE_INSTANTIATOR_FORMAT (string); DECLARE_IMAGE_INSTANTIATOR_FORMAT (formatted_string); @@ -181,7 +171,7 @@ unsigned char *data, *ip, *dp = NULL; quant_table *qtable = NULL; union { - FOUR_BYTE_TYPE val; + UINT_32_BIT val; char cp[4]; } conv; @@ -366,7 +356,7 @@ if (IMAGE_INSTANCE_GTK_MASK (p)) write_fmt_string (printcharfun, "/0x%lx", (unsigned long) IMAGE_INSTANCE_GTK_MASK (p)); - write_c_string (")", printcharfun); + write_c_string (printcharfun, ")"); break; #if HAVE_SUBWINDOWS case IMAGE_SUBWINDOW: @@ -553,11 +543,11 @@ /* Check non-absolute pathnames with a directory component relative to the search path; that's the way Xt does it. */ /* #### Unix-specific */ - if (XSTRING_BYTE (name, 0) == '/' || - (XSTRING_BYTE (name, 0) == '.' && - (XSTRING_BYTE (name, 1) == '/' || - (XSTRING_BYTE (name, 1) == '.' && - (XSTRING_BYTE (name, 2) == '/'))))) + if (string_byte (name, 0) == '/' || + (string_byte (name, 0) == '.' && + (string_byte (name, 1) == '/' || + (string_byte (name, 1) == '.' && + (string_byte (name, 2) == '/'))))) { if (!NILP (Ffile_readable_p (name))) return name;
--- a/src/glyphs-msw.c Thu May 02 14:35:32 2002 +0000 +++ b/src/glyphs-msw.c Sun May 05 11:33:57 2002 +0000 @@ -304,11 +304,11 @@ /* Check non-absolute pathnames with a directory component relative to the search path; that's the way Xt does it. */ - if (IS_DIRECTORY_SEP(XSTRING_BYTE (name, 0)) || - (XSTRING_BYTE (name, 0) == '.' && - (IS_DIRECTORY_SEP(XSTRING_BYTE (name, 1)) || - (XSTRING_BYTE (name, 1) == '.' && - (IS_DIRECTORY_SEP(XSTRING_BYTE (name, 2))))))) + if (IS_DIRECTORY_SEP(string_byte (name, 0)) || + (string_byte (name, 0) == '.' && + (IS_DIRECTORY_SEP(string_byte (name, 1)) || + (string_byte (name, 1) == '.' && + (IS_DIRECTORY_SEP(string_byte (name, 2))))))) { if (!NILP (Ffile_readable_p (name))) return Fexpand_file_name (name, Qnil); @@ -1716,7 +1716,7 @@ write_fmt_string (printcharfun, "/0x%lx", (unsigned long) IMAGE_INSTANCE_MSWINDOWS_MASK (p)); } - write_c_string (")", printcharfun); + write_c_string (printcharfun, ")"); break; default: @@ -1810,8 +1810,8 @@ for (p = XSTRING_DATA (text); *p;) { Emchar c = charptr_emchar (p); - if (!EQ (CHAR_CHARSET (c), Vcharset_ascii)) - return CHAR_CHARSET (c); + if (!EQ (emchar_charset (c), Vcharset_ascii)) + return emchar_charset (c); INC_CHARPTR (p); } #endif /* MULE */
--- a/src/glyphs-msw.h Thu May 02 14:35:32 2002 +0000 +++ b/src/glyphs-msw.h Sun May 05 11:33:57 2002 +0000 @@ -68,21 +68,17 @@ #define XIMAGE_INSTANCE_MSWINDOWS_ICON(i) \ IMAGE_INSTANCE_MSWINDOWS_ICON (XIMAGE_INSTANCE (i)) -int -mswindows_resize_dibitmap_instance (Lisp_Image_Instance *ii, - struct frame *f, - int newx, int newy); -HBITMAP -mswindows_create_resized_bitmap (Lisp_Image_Instance *ii, - struct frame *f, - int newx, int newy); -HBITMAP -mswindows_create_resized_mask (Lisp_Image_Instance *ii, - struct frame *f, - int newx, int newy); -void -mswindows_initialize_image_instance_icon (Lisp_Image_Instance *image, - int cursor); +int mswindows_resize_dibitmap_instance (Lisp_Image_Instance *ii, + struct frame *f, + int newx, int newy); +HBITMAP mswindows_create_resized_bitmap (Lisp_Image_Instance *ii, + struct frame *f, + int newx, int newy); +HBITMAP mswindows_create_resized_mask (Lisp_Image_Instance *ii, + struct frame *f, + int newx, int newy); +void mswindows_initialize_image_instance_icon (Lisp_Image_Instance *image, + int cursor); #define WIDGET_INSTANCE_MSWINDOWS_HANDLE(i) \ (HWND) (IMAGE_INSTANCE_SUBWINDOW_ID (i))
--- a/src/glyphs-x.c Thu May 02 14:35:32 2002 +0000 +++ b/src/glyphs-x.c Sun May 05 11:33:57 2002 +0000 @@ -85,16 +85,6 @@ #endif #include <X11/IntrinsicP.h> -#if INTBITS == 32 -# define FOUR_BYTE_TYPE unsigned int -#elif LONGBITS == 32 -# define FOUR_BYTE_TYPE unsigned long -#elif SHORTBITS == 32 -# define FOUR_BYTE_TYPE unsigned short -#else -#error What kind of strange-ass system are we running on? -#endif - #define LISP_DEVICE_TO_X_SCREEN(dev) XDefaultScreenOfDisplay (DEVICE_X_DISPLAY (XDEVICE (dev))) DECLARE_IMAGE_INSTANTIATOR_FORMAT (nothing); @@ -186,7 +176,7 @@ UChar_Binary *data, *ip, *dp; quant_table *qtable = 0; union { - FOUR_BYTE_TYPE val; + UINT_32_BIT val; char cp[4]; } conv; @@ -381,7 +371,7 @@ write_fmt_string (printcharfun, "/0x%lx", (unsigned long) IMAGE_INSTANCE_X_MASK (p)); } - write_c_string (")", printcharfun); + write_c_string (printcharfun, ")"); break; default: break; @@ -570,11 +560,11 @@ /* Check non-absolute pathnames with a directory component relative to the search path; that's the way Xt does it. */ /* #### Unix-specific */ - if (XSTRING_BYTE (name, 0) == '/' || - (XSTRING_BYTE (name, 0) == '.' && - (XSTRING_BYTE (name, 1) == '/' || - (XSTRING_BYTE (name, 1) == '.' && - (XSTRING_BYTE (name, 2) == '/'))))) + if (string_byte (name, 0) == '/' || + (string_byte (name, 0) == '.' && + (string_byte (name, 1) == '/' || + (string_byte (name, 1) == '.' && + (string_byte (name, 2) == '/'))))) { if (!NILP (Ffile_readable_p (name))) return Fexpand_file_name (name, Qnil);
--- a/src/glyphs.c Thu May 02 14:35:32 2002 +0000 +++ b/src/glyphs.c Sun May 05 11:33:57 2002 +0000 @@ -646,7 +646,7 @@ if (!NILP (value)) { Lisp_Object window; - VOID_TO_LISP (window, flag_closure); + window = VOID_TO_LISP (flag_closure); assert (EQ (XIMAGE_INSTANCE_DOMAIN (value), window)); } @@ -948,37 +948,37 @@ if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) || !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii))) { - write_c_string (" @", printcharfun); + write_c_string (printcharfun, " @"); if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii))) write_fmt_string (printcharfun, "%ld", XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii))); else - write_c_string ("??", printcharfun); - write_c_string (",", printcharfun); + write_c_string (printcharfun, "??"); + write_c_string (printcharfun, ","); if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii))) write_fmt_string (printcharfun, "%ld", XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii))); else - write_c_string ("??", printcharfun); + write_c_string (printcharfun, "??"); } if (!NILP (IMAGE_INSTANCE_PIXMAP_FG (ii)) || !NILP (IMAGE_INSTANCE_PIXMAP_BG (ii))) { - write_c_string (" (", printcharfun); + write_c_string (printcharfun, " ("); if (!NILP (IMAGE_INSTANCE_PIXMAP_FG (ii))) { print_internal (XCOLOR_INSTANCE (IMAGE_INSTANCE_PIXMAP_FG (ii))->name, printcharfun, 0); } - write_c_string ("/", printcharfun); + write_c_string (printcharfun, "/"); if (!NILP (IMAGE_INSTANCE_PIXMAP_BG (ii))) { print_internal (XCOLOR_INSTANCE (IMAGE_INSTANCE_PIXMAP_BG (ii))->name, printcharfun, 0); } - write_c_string (")", printcharfun); + write_c_string (printcharfun, ")"); } break; @@ -1002,17 +1002,17 @@ are specific to a particular frame so we want to print in their description what that frame is. */ - write_c_string (" on #<", printcharfun); + write_c_string (printcharfun, " on #<"); { struct frame* f = XFRAME (IMAGE_INSTANCE_FRAME (ii)); if (!FRAME_LIVE_P (f)) - write_c_string ("dead", printcharfun); + write_c_string (printcharfun, "dead"); else - write_c_string (DEVICE_TYPE_NAME (XDEVICE (FRAME_DEVICE (f))), - printcharfun); + write_c_string (printcharfun, + DEVICE_TYPE_NAME (XDEVICE (FRAME_DEVICE (f)))); } - write_c_string ("-frame>", printcharfun); + write_c_string (printcharfun, "-frame>"); write_fmt_string (printcharfun, " 0x%p", IMAGE_INSTANCE_SUBWINDOW_ID (ii)); @@ -2345,7 +2345,7 @@ if (charsets[i]) { return FACE_CACHEL_FONT (cachel, - CHARSET_BY_LEADING_BYTE (i + + charset_by_leading_byte (i + MIN_LEADING_BYTE)); } @@ -2538,7 +2538,7 @@ if (!NATNUMP (height)) invalid_argument ("Height must be a natural number", height); - if (((XINT (width) * XINT (height)) / 8) > XSTRING_CHAR_LENGTH (bits)) + if (((XINT (width) * XINT (height)) / 8) > string_char_length (bits)) invalid_argument ("data is too short for width and height", vector3 (width, height, bits)); } @@ -4871,12 +4871,12 @@ else if (CHAR_TABLEP (table) && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR) { - return get_char_table (ch, XCHAR_TABLE (table)); + return get_char_table (ch, table); } else if (CHAR_TABLEP (table) && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC) { - Lisp_Object gotit = get_char_table (ch, XCHAR_TABLE (table)); + Lisp_Object gotit = get_char_table (ch, table); if (!NILP (gotit)) return gotit; else
--- a/src/glyphs.h Thu May 02 14:35:32 2002 +0000 +++ b/src/glyphs.h Sun May 05 11:33:57 2002 +0000 @@ -1,6 +1,6 @@ /* Generic glyph data structures + display tables Copyright (C) 1994 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996 Ben Wing + Copyright (C) 1995, 1996, 2002 Ben Wing This file is part of XEmacs. @@ -329,16 +329,21 @@ #define INSTANTIATOR_TYPE(inst) (XVECTOR_DATA ((inst))[0]) -struct image_instantiator_methods * -decode_device_ii_format (Lisp_Object device, Lisp_Object format, - Error_Behavior errb); -struct image_instantiator_methods * -decode_image_instantiator_format (Lisp_Object format, Error_Behavior errb); +struct image_instantiator_methods *decode_device_ii_format (Lisp_Object device, + Lisp_Object format, + Error_Behavior + errb); +struct image_instantiator_methods *decode_image_instantiator_format + (Lisp_Object format, Error_Behavior errb); void add_entry_to_image_instantiator_format_list (Lisp_Object symbol, - struct image_instantiator_methods *meths); -void add_entry_to_device_ii_format_list (Lisp_Object device, Lisp_Object symbol, - struct image_instantiator_methods *meths); + struct + image_instantiator_methods * + meths); +void add_entry_to_device_ii_format_list (Lisp_Object device, + Lisp_Object symbol, + struct image_instantiator_methods * + meths); Lisp_Object find_keyword_in_vector (Lisp_Object vector, Lisp_Object keyword); Lisp_Object find_keyword_in_vector_or_given (Lisp_Object vector, @@ -1059,28 +1064,30 @@ #ifdef ERROR_CHECK_GLYPHS -INLINE_HEADER int -GLYPH_CACHEL_WIDTH (struct window *window, int ind); -INLINE_HEADER int +DECLARE_INLINE_HEADER ( +int GLYPH_CACHEL_WIDTH (struct window *window, int ind) +) { int wid = Dynarr_atp (window->glyph_cachels, ind)->width; assert (wid >= 0 && wid < 10000); return wid; } -INLINE_HEADER int -GLYPH_CACHEL_ASCENT (struct window *window, int ind); -INLINE_HEADER int + +DECLARE_INLINE_HEADER ( +int GLYPH_CACHEL_ASCENT (struct window *window, int ind) +) { int wid = Dynarr_atp (window->glyph_cachels, ind)->ascent; assert (wid >= 0 && wid < 10000); return wid; } -INLINE_HEADER int -GLYPH_CACHEL_DESCENT (struct window *window, int ind); -INLINE_HEADER int + +DECLARE_INLINE_HEADER ( +int GLYPH_CACHEL_DESCENT (struct window *window, int ind) +) { int wid = Dynarr_atp (window->glyph_cachels, ind)->descent; assert (wid >= 0 && wid < 10000);
--- a/src/gui-msw.c Thu May 02 14:35:32 2002 +0000 +++ b/src/gui-msw.c Sun May 05 11:33:57 2002 +0000 @@ -48,10 +48,7 @@ frame = wrap_frame (f); - /* #### make_int should assert that --kkm */ - assert (XINT (make_int (id)) == id); - - image_instance = Fgethash (make_int (id), + image_instance = Fgethash (make_int_verify (id), FRAME_MSWINDOWS_WIDGET_HASH_TABLE1 (f), Qnil); /* It is possible for a widget action to cause it to get out of sync with its instantiator. Thus it is necessary to signal this
--- a/src/gui-x.c Thu May 02 14:35:32 2002 +0000 +++ b/src/gui-x.c Sun May 05 11:33:57 2002 +0000 @@ -66,13 +66,13 @@ Lisp_Object markee; if (val->call_data) { - VOID_TO_LISP (markee, val->call_data); + markee = VOID_TO_LISP (val->call_data); mark_object (markee); } if (val->accel) { - VOID_TO_LISP (markee, val->accel); + markee = VOID_TO_LISP (val->accel); mark_object (markee); } return 0; @@ -227,7 +227,7 @@ return; if (((EMACS_INT) client_data) == 0) return; - VOID_TO_LISP (data, client_data); + data = VOID_TO_LISP (client_data); frame = wrap_frame (f); #if 0
--- a/src/gui.h Thu May 02 14:35:32 2002 +0000 +++ b/src/gui.h Sun May 05 11:33:57 2002 +0000 @@ -1,6 +1,6 @@ /* Generic GUI code. (menubars, scrollbars, toolbars, dialogs) Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996 Ben Wing. + Copyright (C) 1995, 1996, 2002 Ben Wing. Copyright (C) 1995 Sun Microsystems, Inc. This file is part of XEmacs.
--- a/src/gutter.h Thu May 02 14:35:32 2002 +0000 +++ b/src/gutter.h Sun May 05 11:33:57 2002 +0000 @@ -46,7 +46,7 @@ /* Iterate over all possible gutter positions */ #define GUTTER_POS_LOOP(var) \ -for (var = (enum gutter_pos) 0; var < 4; var = (enum gutter_pos) (var + 1)) + for (var = (enum gutter_pos) 0; var < 4; var = (enum gutter_pos) (var + 1)) extern Lisp_Object Qgutter;
--- a/src/hash.h Thu May 02 14:35:32 2002 +0000 +++ b/src/hash.h Sun May 05 11:33:57 2002 +0000 @@ -44,10 +44,11 @@ automatically if the number of entries approaches the size */ struct hash_table *make_hash_table (Elemcount size); -struct hash_table * -make_general_hash_table (Elemcount size, - hash_table_hash_function hash_function, - hash_table_test_function test_function); +struct hash_table *make_general_hash_table (Elemcount size, + hash_table_hash_function + hash_function, + hash_table_test_function + test_function); /* Clear HASH-TABLE. A freshly created hash table is already cleared up. */ void clrhash (struct hash_table *hash_table);
--- a/src/indent.c Thu May 02 14:35:32 2002 +0000 +++ b/src/indent.c Sun May 05 11:33:57 2002 +0000 @@ -1,8 +1,8 @@ /* Indentation functions. Copyright (C) 1995 Board of Trustees, University of Illinois. Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993, 1994, 1995 + Free Software Foundation, Inc. Copyright (C) 2002 Ben Wing. - Free Software Foundation, Inc. This file is part of XEmacs. @@ -170,7 +170,7 @@ + displayed_glyphs->end_columns)); #else /* XEmacs */ #ifdef MULE - col += XCHARSET_COLUMNS (CHAR_CHARSET (c)); + col += XCHARSET_COLUMNS (emchar_charset (c)); #else col ++; #endif /* MULE */ @@ -213,7 +213,7 @@ break; pos--; - c = XSTRING_CHAR (s, pos); + c = string_emchar (s, pos); if (c == '\t') { if (tab_seen) @@ -227,7 +227,7 @@ break; else #ifdef MULE - col += XCHARSET_COLUMNS (CHAR_CHARSET (c)); + col += XCHARSET_COLUMNS (emchar_charset (c)); #else col ++; #endif /* MULE */ @@ -341,9 +341,9 @@ } int -bi_spaces_at_point (struct buffer *b, Bytebpos bi_pos) +byte_spaces_at_point (struct buffer *b, Bytebpos byte_pos) { - Bytebpos bi_end = BI_BUF_ZV (b); + Bytebpos byte_end = BYTE_BUF_ZV (b); int col = 0; Emchar c; int tab_width = XINT (b->tab_width); @@ -351,12 +351,12 @@ if (tab_width <= 0 || tab_width > 1000) tab_width = 8; - while (bi_pos < bi_end && - (c = BI_BUF_FETCH_CHAR (b, bi_pos), + while (byte_pos < byte_end && + (c = BYTE_BUF_FETCH_CHAR (b, byte_pos), (c == '\t' ? (col += tab_width - col % tab_width) : (c == ' ' ? ++col : 0)))) - INC_BYTEBPOS (b, bi_pos); + INC_BYTEBPOS (b, byte_pos); return col; } @@ -377,7 +377,7 @@ if (!NILP (Fextent_at (make_int (pos), buffer, Qinvisible, Qnil, Qnil))) return Qzero; - return make_int (bi_spaces_at_point (buf, charbpos_to_bytebpos (buf, pos))); + return make_int (byte_spaces_at_point (buf, charbpos_to_bytebpos (buf, pos))); } @@ -457,7 +457,7 @@ + displayed_glyphs->end_columns)); #else /* XEmacs */ #ifdef MULE - col += XCHARSET_COLUMNS (CHAR_CHARSET (c)); + col += XCHARSET_COLUMNS (emchar_charset (c)); #else col ++; #endif /* MULE */ @@ -497,7 +497,7 @@ #if 0 /* #### OK boys, this function needs to be present, I think. It was there before the 19.12 redisplay rewrite. */ -xxDEFUN ("compute-motion", Fcompute_motion, 7, 7, 0, /* +DEFUN ("compute-motion", Fcompute_motion, 7, 7, 0, /* "Scan through the current buffer, calculating screen position. Scan the current buffer forward from offset FROM, assuming it is at position FROMPOS--a cons of the form (HPOS . VPOS)--
--- a/src/insdel.c Thu May 02 14:35:32 2002 +0000 +++ b/src/insdel.c Sun May 05 11:33:57 2002 +0000 @@ -60,11 +60,11 @@ do { (buf)->text->end_gap_size = (value); } while (0) /* Gap location. */ -#define BI_BUF_GPT(buf) ((buf)->text->gpt + 0) -#define BUF_GPT_ADDR(buf) (BUF_BEG_ADDR (buf) + BI_BUF_GPT (buf) - 1) +#define BYTE_BUF_GPT(buf) ((buf)->text->gpt + 0) +#define BUF_GPT_ADDR(buf) (BUF_BEG_ADDR (buf) + BYTE_BUF_GPT (buf) - 1) /* Set gap location. */ -#define SET_BI_BUF_GPT(buf, value) do { (buf)->text->gpt = (value); } while (0) +#define SET_BYTE_BUF_GPT(buf, value) do { (buf)->text->gpt = (value); } while (0) /* Set end of buffer. */ #define SET_BOTH_BUF_Z(buf, val, bival) \ @@ -95,7 +95,7 @@ # define SET_GAP_SENTINEL(buf) (*BUF_GPT_ADDR (buf) = 0) # define BUF_END_SENTINEL_SIZE 1 # define SET_END_SENTINEL(buf) \ - (*(BUF_BEG_ADDR (buf) + BUF_GAP_SIZE (buf) + BI_BUF_Z (buf) - 1) = 0) + (*(BUF_BEG_ADDR (buf) + BUF_GAP_SIZE (buf) + BYTE_BUF_Z (buf) - 1) = 0) #else # define GAP_CAN_HOLD_SIZE_P(buf, len) (BUF_GAP_SIZE (buf) >= (len)) # define SET_GAP_SENTINEL(buf) @@ -137,8 +137,8 @@ void set_buffer_point (struct buffer *buf, Charbpos charbpos, Bytebpos bytpos) { - assert (bytpos >= BI_BUF_BEGV (buf) && bytpos <= BI_BUF_ZV (buf)); - if (bytpos == BI_BUF_PT (buf)) + assert (bytpos >= BYTE_BUF_BEGV (buf) && bytpos <= BYTE_BUF_ZV (buf)); + if (bytpos == BYTE_BUF_PT (buf)) return; JUST_SET_POINT (buf, charbpos, bytpos); MARK_POINT_CHANGED; @@ -261,7 +261,7 @@ from = BUF_GPT_ADDR (buf); to = from + BUF_GAP_SIZE (buf); - new_s1 = BI_BUF_GPT (buf); + new_s1 = BYTE_BUF_GPT (buf); /* Now copy the characters. To move the gap down, copy characters up. */ @@ -303,14 +303,14 @@ or may be where a quit was detected. */ MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) { - adjust_markers (mbuf, pos, BI_BUF_GPT (mbuf), BUF_GAP_SIZE (mbuf)); + adjust_markers (mbuf, pos, BYTE_BUF_GPT (mbuf), BUF_GAP_SIZE (mbuf)); } MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) { - adjust_extents (wrap_buffer (mbuf), pos, BI_BUF_GPT (mbuf), + adjust_extents (wrap_buffer (mbuf), pos, BYTE_BUF_GPT (mbuf), BUF_GAP_SIZE (mbuf)); } - SET_BI_BUF_GPT (buf, pos); + SET_BYTE_BUF_GPT (buf, pos); SET_GAP_SENTINEL (buf); #ifdef ERROR_CHECK_EXTENTS MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) @@ -332,7 +332,7 @@ to = BUF_GPT_ADDR (buf); from = to + BUF_GAP_SIZE (buf); - new_s1 = BI_BUF_GPT (buf); + new_s1 = BYTE_BUF_GPT (buf); /* Now copy the characters. To move the gap up, copy characters down. */ @@ -373,14 +373,14 @@ int gsize = BUF_GAP_SIZE (buf); MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) { - adjust_markers (mbuf, BI_BUF_GPT (mbuf) + gsize, pos + gsize, - gsize); + adjust_markers (mbuf, BYTE_BUF_GPT (mbuf) + gsize, pos + gsize, - gsize); } MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) { - adjust_extents (wrap_buffer (mbuf), BI_BUF_GPT (mbuf) + gsize, + adjust_extents (wrap_buffer (mbuf), BYTE_BUF_GPT (mbuf) + gsize, pos + gsize, - gsize); } - SET_BI_BUF_GPT (buf, pos); + SET_BYTE_BUF_GPT (buf, pos); SET_GAP_SENTINEL (buf); #ifdef ERROR_CHECK_EXTENTS MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) @@ -389,7 +389,7 @@ } #endif } - if (pos == BI_BUF_Z (buf)) + if (pos == BYTE_BUF_Z (buf)) { /* merge gap with end gap */ @@ -409,9 +409,9 @@ { if (! BUF_BEG_ADDR (buf)) abort (); - if (pos < BI_BUF_GPT (buf)) + if (pos < BYTE_BUF_GPT (buf)) gap_left (buf, pos); - else if (pos > BI_BUF_GPT (buf)) + else if (pos > BYTE_BUF_GPT (buf)) gap_right (buf, pos); } @@ -434,11 +434,11 @@ tem = Vinhibit_quit; Vinhibit_quit = Qt; - real_gap_loc = BI_BUF_GPT (buf); + real_gap_loc = BYTE_BUF_GPT (buf); old_gap_size = BUF_GAP_SIZE (buf); /* Pretend the end gap is the gap */ - SET_BI_BUF_GPT (buf, BI_BUF_Z (buf) + BUF_GAP_SIZE (buf)); + SET_BYTE_BUF_GPT (buf, BYTE_BUF_Z (buf) + BUF_GAP_SIZE (buf)); SET_BUF_GAP_SIZE (buf, increment); /* Move the new gap down to be consecutive with the end of the old one. @@ -447,7 +447,7 @@ /* Now combine the two into one large gap. */ SET_BUF_GAP_SIZE (buf, BUF_GAP_SIZE (buf) + old_gap_size); - SET_BI_BUF_GPT (buf, real_gap_loc); + SET_BYTE_BUF_GPT (buf, real_gap_loc); SET_GAP_SENTINEL (buf); /* We changed the total size of the buffer (including gap), @@ -470,7 +470,11 @@ /* If we have to get more space, get enough to last a while. We use a geometric progression that saves on realloc space. */ - increment += 2000 + ((BI_BUF_Z (buf) - BI_BUF_BEG (buf)) / 8); + increment += 2000 + ((BYTE_BUF_Z (buf) - BYTE_BUF_BEG (buf)) / 8); + /* Make sure the gap is always aligned properly in case we're using a + 16-bit or 32-bit fixed-width format. (Other sizes should already be + aligned in such a case.) */ + increment = MAX_ALIGN_SIZE (increment); if (increment > BUF_END_GAP_SIZE (buf)) { @@ -483,7 +487,7 @@ out_of_memory ("Maximum buffer size exceeded", Qunbound); result = BUFFER_REALLOC (buf->text->beg, - BI_BUF_Z (buf) - BI_BUF_BEG (buf) + + BYTE_BUF_Z (buf) - BYTE_BUF_BEG (buf) + BUF_GAP_SIZE (buf) + increment + BUF_END_SENTINEL_SIZE); if (result == 0) @@ -498,11 +502,11 @@ tem = Vinhibit_quit; Vinhibit_quit = Qt; - real_gap_loc = BI_BUF_GPT (buf); + real_gap_loc = BYTE_BUF_GPT (buf); old_gap_size = BUF_GAP_SIZE (buf); /* Call the newly allocated space a gap at the end of the whole space. */ - SET_BI_BUF_GPT (buf, BI_BUF_Z (buf) + BUF_GAP_SIZE (buf)); + SET_BYTE_BUF_GPT (buf, BYTE_BUF_Z (buf) + BUF_GAP_SIZE (buf)); SET_BUF_GAP_SIZE (buf, increment); SET_BUF_END_GAP_SIZE (buf, 0); @@ -513,7 +517,7 @@ /* Now combine the two into one large gap. */ SET_BUF_GAP_SIZE (buf, BUF_GAP_SIZE (buf) + old_gap_size); - SET_BI_BUF_GPT (buf, real_gap_loc); + SET_BYTE_BUF_GPT (buf, real_gap_loc); SET_GAP_SENTINEL (buf); /* We changed the total size of the buffer (including gap), @@ -811,8 +815,7 @@ MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) { - buffer = wrap_buffer (mbuf); - report_extent_modification (buffer, start, end, 0); + report_extent_modification (wrap_buffer (mbuf), start, end, 0); } unbind_to (speccount); @@ -841,12 +844,14 @@ /* always do this. */ buffer_signal_changed_region (mbuf, start, new_end); } +#ifdef USE_C_FONT_LOCK MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) { /* #### This seems inefficient. Wouldn't it be better to just keep one cache per base buffer? */ font_lock_maybe_update_syntactic_caches (mbuf, start, orig_end, new_end); } +#endif /* USE_C_FONT_LOCK */ if (!inside_change_hook) { @@ -1030,7 +1035,8 @@ { /* This function can GC */ struct gcpro gcpro1; - Bytebpos ind; + Bytebpos bytepos; + Bytecount length_in_buffer; Charcount cclen; int move_point = 0; struct buffer *mbuf; @@ -1080,7 +1086,7 @@ if (pos > BUF_ZV (buf)) pos = BUF_ZV (buf); - ind = charbpos_to_bytebpos (buf, pos); + bytepos = charbpos_to_bytebpos (buf, pos); /* string may have been relocated up to this point */ if (STRINGP (reloc)) @@ -1090,20 +1096,35 @@ } else cclen = bytecount_to_charcount (nonreloc + offset, length); + /* &&#### Here we check if the text can't fit into the format of the buffer, + and if so convert it to another format (either default or 32-bit-fixed, + according to some flag; if no flag, use default). */ + + length_in_buffer = copy_text_between_formats (nonreloc + offset, length, + FORMAT_DEFAULT, + STRINGP (reloc) ? reloc : Qnil, + NULL, 0, + BUF_FORMAT (buf), + wrap_buffer (buf), + NULL); - if (ind != BI_BUF_GPT (buf)) + if (bytepos != BYTE_BUF_GPT (buf)) /* #### if debug-on-quit is invoked and the user changes the buffer, bad things can happen. This is a rampant problem in Emacs. */ - move_gap (buf, ind); /* may QUIT */ - if (! GAP_CAN_HOLD_SIZE_P (buf, length)) + move_gap (buf, bytepos); /* may QUIT */ + if (! GAP_CAN_HOLD_SIZE_P (buf, length_in_buffer)) { - if (BUF_END_GAP_SIZE (buf) >= length) + if (BUF_END_GAP_SIZE (buf) >= length_in_buffer) merge_gap_with_end_gap (buf); else - make_gap (buf, length - BUF_GAP_SIZE (buf)); + make_gap (buf, length_in_buffer - BUF_GAP_SIZE (buf)); } + /* At this point, no more QUITting or processing of Lisp code. Buffer is + in a consistent state. Following code puts buffer in an inconsistent + state and can be considered a "critical section". */ + insert_invalidate_line_number_cache (buf, pos, nonreloc + offset, length); MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) @@ -1114,35 +1135,63 @@ BUF_MODIFF (buf)++; MARK_BUFFERS_CHANGED; - /* string may have been relocated up to this point */ + /* string may have been relocated up to this point #### if string is + modified during quit processing, bad things can happen. */ if (STRINGP (reloc)) nonreloc = XSTRING_DATA (reloc); - memcpy (BUF_GPT_ADDR (buf), nonreloc + offset, length); - - SET_BUF_GAP_SIZE (buf, BUF_GAP_SIZE (buf) - length); - SET_BI_BUF_GPT (buf, BI_BUF_GPT (buf) + length); + copy_text_between_formats (nonreloc + offset, length, FORMAT_DEFAULT, + STRINGP (reloc) ? reloc : Qnil, + BUF_GPT_ADDR (buf), length_in_buffer, + BUF_FORMAT (buf), wrap_buffer (buf), NULL); + + SET_BUF_GAP_SIZE (buf, BUF_GAP_SIZE (buf) - length_in_buffer); + SET_BYTE_BUF_GPT (buf, BYTE_BUF_GPT (buf) + length_in_buffer); MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) { - SET_BOTH_BUF_ZV (mbuf, BUF_ZV (mbuf) + cclen, BI_BUF_ZV (mbuf) + length); + SET_BOTH_BUF_ZV (mbuf, BUF_ZV (mbuf) + cclen, + BYTE_BUF_ZV (mbuf) + length_in_buffer); } - SET_BOTH_BUF_Z (buf, BUF_Z (buf) + cclen, BI_BUF_Z (buf) + length); + SET_BOTH_BUF_Z (buf, BUF_Z (buf) + cclen, BYTE_BUF_Z (buf) + length_in_buffer); SET_GAP_SENTINEL (buf); #ifdef MULE - buffer_mule_signal_inserted_region (buf, pos, length, cclen); + buffer_mule_signal_inserted_region (buf, pos, length_in_buffer, cclen); + /* Update our count of ASCII, 8-bit and 16-bit chars and the + entirely-one-byte flag */ + { + const Intbyte *ptr = nonreloc + offset; + const Intbyte *ptrend = ptr + length; + + while (ptr < ptrend) + { + Emchar ch = charptr_emchar (ptr); + if (emchar_ascii_p (ch)) + buf->text->num_ascii_chars++; + if (emchar_8_bit_fixed_p (ch, wrap_buffer (buf))) + buf->text->num_8_bit_fixed_chars++; + if (emchar_16_bit_fixed_p (ch, wrap_buffer (buf))) + buf->text->num_16_bit_fixed_chars++; + INC_CHARPTR (ptr); + } + + buf->text->entirely_one_byte_p = + (BUF_FORMAT (buf) == FORMAT_8_BIT_FIXED || + (BUF_FORMAT (buf) == FORMAT_DEFAULT && BUF_Z (buf) == BYTE_BUF_Z (buf))); + } #endif MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) { - process_extents_for_insertion (wrap_buffer (mbuf), ind, length); + process_extents_for_insertion (wrap_buffer (mbuf), bytepos, + length_in_buffer); } MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) { - /* We know the gap is at IND so the cast is OK. */ - adjust_markers_for_insert (mbuf, (Membpos) ind, length); + /* We know the gap is at BYTEPOS so the cast is OK. */ + adjust_markers_for_insert (mbuf, (Membpos) bytepos, length_in_buffer); } /* Point logically doesn't move, but may need to be adjusted because @@ -1150,20 +1199,20 @@ memory index. */ MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) { - if (BI_BUF_PT (mbuf) > ind) + if (BYTE_BUF_PT (mbuf) > bytepos) JUST_SET_POINT (mbuf, BUF_PT (mbuf) + cclen, - BI_BUF_PT (mbuf) + length); + BYTE_BUF_PT (mbuf) + length_in_buffer); } /* Well, point might move. */ if (move_point) - BI_BUF_SET_PT (buf, ind + length); + BYTE_BUF_SET_PT (buf, bytepos + length_in_buffer); if (STRINGP (reloc)) { MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) { - splice_in_string_extents (reloc, mbuf, ind, length, offset); + splice_in_string_extents (reloc, mbuf, bytepos, length, offset); } } @@ -1171,13 +1220,18 @@ { MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) { - /* ind - 1 is correct because the FROM argument is exclusive. + /* bytepos - 1 is correct because the FROM argument is exclusive. I formerly used DEC_BYTEBPOS() but that caused problems at the beginning of the buffer. */ - adjust_markers (mbuf, ind - 1, ind, length); + adjust_markers (mbuf, bytepos - 1, bytepos, length_in_buffer); } } + MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) + { + signal_syntax_table_extent_adjust (mbuf); + } + signal_after_change (buf, pos, pos, pos + cclen); UNGCPRO; @@ -1266,11 +1320,12 @@ { /* This function can GC */ Charcount numdel; - Bytebpos bi_from, bi_to; - Bytecount bc_numdel; + Bytebpos byte_from, byte_to; + Bytecount byte_numdel; EMACS_INT shortage; struct buffer *mbuf; Lisp_Object bufcons; + int do_move_gap = 0; /* Defensive steps just in case a buffer gets deleted and a calling function doesn't notice it. */ @@ -1301,6 +1356,42 @@ if ((numdel = to - from) <= 0) return; + byte_from = charbpos_to_bytebpos (buf, from); + byte_to = charbpos_to_bytebpos (buf, to); + byte_numdel = byte_to - byte_from; + + if (to == BUF_Z (buf) && + byte_from > BYTE_BUF_GPT (buf)) + /* avoid moving the gap just to delete from the bottom. */ + do_move_gap = 0; + else + { + /* Make sure the gap is somewhere in or next to what we are deleting. */ + /* NOTE: Can QUIT! */ + if (byte_to < BYTE_BUF_GPT (buf)) + gap_left (buf, byte_to); + if (byte_from > BYTE_BUF_GPT (buf)) + gap_right (buf, byte_from); + do_move_gap = 1; + } + + /* At this point, no more QUITting or processing of Lisp code. Buffer is + in a consistent state. Following code puts buffer in an inconsistent + state and can be considered a "critical section". */ + + MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) + { + record_delete (mbuf, from, numdel); + } + BUF_MODIFF (buf)++; + MARK_BUFFERS_CHANGED; + + /* We used to do the following before the gap move. But that might QUIT, + and (as a result of this) the gap code always leaves the buffer in + a consistent state. Therefore, it's totally safe to do these operations + now, and just as well not before, as we're making state changes + related to the deletion. */ + /* Redisplay needs to know if a newline was in the deleted region. If we've already marked the changed region as having a deleted newline there is no use in performing the check. */ @@ -1316,162 +1407,98 @@ } } - bi_from = charbpos_to_bytebpos (buf, from); - bi_to = charbpos_to_bytebpos (buf, to); - bc_numdel = bi_to - bi_from; - delete_invalidate_line_number_cache (buf, from, to); - if (to == BUF_Z (buf) && - bi_from > BI_BUF_GPT (buf)) - { - /* avoid moving the gap just to delete from the bottom. */ - - MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) - { - record_delete (mbuf, from, numdel); - } - BUF_MODIFF (buf)++; - MARK_BUFFERS_CHANGED; - - /* #### Point used to be modified here, but this causes problems - with MULE, as point is used to calculate bytebposs, and if the - offset in bc_numdel causes point to move to a non first-byte - location, causing some other function to throw an assertion - in ASSERT_VALID_BYTEBPOS. I've moved the code to right after - the other movements and adjustments, but before the gap is - moved. -- jh 970813 */ - - /* Detach any extents that are completely within the range [FROM, TO], - if the extents are detachable. - - This must come AFTER record_delete(), so that the appropriate - extents will be present to be recorded, and BEFORE the gap - size is increased, as otherwise we will be confused about - where the extents end. */ - MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) - { - process_extents_for_deletion (wrap_buffer (mbuf), bi_from, bi_to, 0); - } - - /* Relocate all markers pointing into the new, larger gap to - point at the end of the text before the gap. */ - MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) - { - adjust_markers (mbuf, - (bi_to + BUF_GAP_SIZE (mbuf)), - (bi_to + BUF_GAP_SIZE (mbuf)), - (- bc_numdel)); - } - - MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) - { - /* Relocate any extent endpoints just like markers. */ - adjust_extents_for_deletion (wrap_buffer (mbuf), bi_from, bi_to, - BUF_GAP_SIZE (mbuf), bc_numdel, 0); - } - - MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) - { - /* Relocate point as if it were a marker. */ - if (bi_from < BI_BUF_PT (mbuf)) - { - if (BI_BUF_PT (mbuf) < bi_to) - JUST_SET_POINT (mbuf, from, bi_from); - else - JUST_SET_POINT (mbuf, BUF_PT (mbuf) - numdel, - BI_BUF_PT (mbuf) - bc_numdel); - } - } - - SET_BUF_END_GAP_SIZE (buf, BUF_END_GAP_SIZE (buf) + bc_numdel); +#ifdef MULE + /* Update our count of ASCII, 8-bit and 16-bit chars and the + entirely-one-byte flag */ + { + Bytebpos i; - MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) - { - SET_BOTH_BUF_ZV (mbuf, BUF_ZV (mbuf) - numdel, - BI_BUF_ZV (mbuf) - bc_numdel); - } - SET_BOTH_BUF_Z (buf, BUF_Z (buf) - numdel, BI_BUF_Z (buf) - bc_numdel); - SET_GAP_SENTINEL (buf); - } - else - { - /* Make sure the gap is somewhere in or next to what we are deleting. */ - if (bi_to < BI_BUF_GPT (buf)) - gap_left (buf, bi_to); - if (bi_from > BI_BUF_GPT (buf)) - gap_right (buf, bi_from); - - MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) - { - record_delete (mbuf, from, numdel); - } - BUF_MODIFF (buf)++; - MARK_BUFFERS_CHANGED; - - /* #### Point used to be modified here, but this causes problems - with MULE, as point is used to calculate bytebposs, and if the - offset in bc_numdel causes point to move to a non first-byte - location, causing some other function to throw an assertion - in ASSERT_VALID_BYTEBPOS. I've moved the code to right after - the other movements and adjustments, but before the gap is - moved. -- jh 970813 */ - - /* Detach any extents that are completely within the range [FROM, TO], - if the extents are detachable. + for (i = byte_from; i < byte_to; i = next_bytebpos (buf, i)) + { + Emchar ch = BYTE_BUF_FETCH_CHAR (buf, i); + if (emchar_ascii_p (ch)) + buf->text->num_ascii_chars--; + if (emchar_8_bit_fixed_p (ch, wrap_buffer (buf))) + buf->text->num_8_bit_fixed_chars--; + if (emchar_16_bit_fixed_p (ch, wrap_buffer (buf))) + buf->text->num_16_bit_fixed_chars--; + } + } +#endif /* MULE */ - This must come AFTER record_delete(), so that the appropriate extents - will be present to be recorded, and BEFORE the gap size is increased, - as otherwise we will be confused about where the extents end. */ - MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) - { - process_extents_for_deletion (wrap_buffer (mbuf), bi_from, bi_to, 0); - } - - /* Relocate all markers pointing into the new, larger gap to - point at the end of the text before the gap. */ - MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) - { - adjust_markers (mbuf, - (bi_to + BUF_GAP_SIZE (mbuf)), - (bi_to + BUF_GAP_SIZE (mbuf)), - (- bc_numdel - BUF_GAP_SIZE (mbuf))); - } + /* #### Point used to be modified here, but this causes problems + with MULE, as point is used to calculate bytebpos's, and if the + offset in byte_numdel causes point to move to a non first-byte + location, causing some other function to throw an assertion + in ASSERT_VALID_BYTEBPOS. I've moved the code to right after + the other movements and adjustments, but before the gap is + moved. -- jh 970813 */ - /* Relocate any extent endpoints just like markers. */ - MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) - { - adjust_extents_for_deletion (wrap_buffer (mbuf), bi_from, bi_to, - BUF_GAP_SIZE (mbuf), - bc_numdel, BUF_GAP_SIZE (mbuf)); - } - - MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) - { - /* Relocate point as if it were a marker. */ - if (bi_from < BI_BUF_PT (mbuf)) - { - if (BI_BUF_PT (mbuf) < bi_to) - JUST_SET_POINT (mbuf, from, bi_from); - else - JUST_SET_POINT (mbuf, BUF_PT (mbuf) - numdel, - BI_BUF_PT (mbuf) - bc_numdel); - } - } - - SET_BUF_GAP_SIZE (buf, BUF_GAP_SIZE (buf) + bc_numdel); - MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) - { - SET_BOTH_BUF_ZV (mbuf, BUF_ZV (mbuf) - numdel, - BI_BUF_ZV (mbuf) - bc_numdel); - } - SET_BOTH_BUF_Z (buf, BUF_Z (buf) - numdel, BI_BUF_Z (buf) - bc_numdel); - SET_BI_BUF_GPT (buf, bi_from); - SET_GAP_SENTINEL (buf); + /* Detach any extents that are completely within the range [FROM, TO], + if the extents are detachable. + + This must come AFTER record_delete(), so that the appropriate extents + will be present to be recorded, and BEFORE the gap size is increased, + as otherwise we will be confused about where the extents end. */ + MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) + { + process_extents_for_deletion (wrap_buffer (mbuf), byte_from, byte_to, 0); } + /* Relocate all markers pointing into the new, larger gap to + point at the end of the text before the gap. */ + MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) + { + adjust_markers (mbuf, + (byte_to + BUF_GAP_SIZE (mbuf)), + (byte_to + BUF_GAP_SIZE (mbuf)), + (- byte_numdel - + (do_move_gap ? BUF_GAP_SIZE (mbuf) : 0))); + } + + /* Relocate any extent endpoints just like markers. */ + MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) + { + adjust_extents_for_deletion (wrap_buffer (mbuf), byte_from, byte_to, + BUF_GAP_SIZE (mbuf), + byte_numdel, + do_move_gap ? BUF_GAP_SIZE (mbuf) : 0); + } + + MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) + { + /* Relocate point as if it were a marker. */ + if (byte_from < BYTE_BUF_PT (mbuf)) + { + if (BYTE_BUF_PT (mbuf) < byte_to) + JUST_SET_POINT (mbuf, from, byte_from); + else + JUST_SET_POINT (mbuf, BUF_PT (mbuf) - numdel, + BYTE_BUF_PT (mbuf) - byte_numdel); + } + } + + if (do_move_gap) + SET_BUF_GAP_SIZE (buf, BUF_GAP_SIZE (buf) + byte_numdel); + else + SET_BUF_END_GAP_SIZE (buf, BUF_END_GAP_SIZE (buf) + byte_numdel); + MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) + { + SET_BOTH_BUF_ZV (mbuf, BUF_ZV (mbuf) - numdel, + BYTE_BUF_ZV (mbuf) - byte_numdel); + } + SET_BOTH_BUF_Z (buf, BUF_Z (buf) - numdel, BYTE_BUF_Z (buf) - byte_numdel); + if (do_move_gap) + SET_BYTE_BUF_GPT (buf, byte_from); + SET_GAP_SENTINEL (buf); + #ifdef MULE - buffer_mule_signal_deleted_region (buf, from, to, bi_from, bi_to); + buffer_mule_signal_deleted_region (buf, from, to, byte_from, byte_to); + buf->text->entirely_one_byte_p = + (BUF_FORMAT (buf) == FORMAT_8_BIT_FIXED || + (BUF_FORMAT (buf) == FORMAT_DEFAULT && BUF_Z (buf) == BYTE_BUF_Z (buf))); #endif #ifdef ERROR_CHECK_EXTENTS @@ -1481,6 +1508,15 @@ } #endif + MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) + { + signal_syntax_table_extent_adjust (mbuf); + } + + /* &&#### Here we consider converting the buffer from default to + 8-bit-fixed if is entirely 8-bit-fixed chars and has been that way for + a long time, e.g. 20 minutes. And if the buffer just switched to all + 8-bit-fixed chars, start the timer. */ signal_after_change (buf, from, to, from); } @@ -1496,19 +1532,20 @@ int not_real_change, int force_lock_check) { /* This function can GC */ - Intbyte curstr[MAX_EMCHAR_LEN]; Intbyte newstr[MAX_EMCHAR_LEN]; - Bytecount curlen, newlen; + Bytecount newlen; + Emchar oldch; /* Defensive steps just in case a buffer gets deleted and a calling function doesn't notice it. */ if (!BUFFER_LIVE_P (buf)) return; - curlen = BUF_CHARPTR_COPY_CHAR (buf, pos, curstr); - newlen = set_charptr_emchar (newstr, ch); - - if (curlen == newlen) + newlen = set_charptr_emchar_fmt (newstr, ch, BUF_FORMAT (buf), + wrap_buffer (buf)); + oldch = BUF_FETCH_CHAR (buf, pos); + if (emchar_fits_in_format (ch, BUF_FORMAT (buf), wrap_buffer (buf)) && + newlen == emchar_len_fmt (oldch, BUF_FORMAT (buf))) { struct buffer *mbuf; Lisp_Object bufcons; @@ -1547,6 +1584,22 @@ } BUF_MODIFF (buf)++; } + +#ifdef MULE + if (emchar_ascii_p (oldch)) + buf->text->num_ascii_chars--; + if (emchar_8_bit_fixed_p (oldch, wrap_buffer (buf))) + buf->text->num_8_bit_fixed_chars--; + if (emchar_16_bit_fixed_p (oldch, wrap_buffer (buf))) + buf->text->num_16_bit_fixed_chars--; + if (emchar_ascii_p (ch)) + buf->text->num_ascii_chars++; + if (emchar_8_bit_fixed_p (ch, wrap_buffer (buf))) + buf->text->num_8_bit_fixed_chars++; + if (emchar_16_bit_fixed_p (ch, wrap_buffer (buf))) + buf->text->num_16_bit_fixed_chars++; +#endif /* MULE */ + memcpy (BUF_BYTE_ADDRESS (buf, pos), newstr, newlen); signal_after_change (buf, pos, pos + 1, pos + 1); @@ -1604,42 +1657,19 @@ int no_extents) { /* This function can GC */ - Bytebpos bi_ind = charbpos_to_bytebpos (buf, pos); - Bytecount bi_len = charbpos_to_bytebpos (buf, pos + length) - bi_ind; - Lisp_Object val = make_uninit_string (bi_len); + Bytebpos bytepos = charbpos_to_bytebpos (buf, pos); + Bytecount bytelen = charbpos_to_bytebpos (buf, pos + length) - bytepos; + Bytecount needed = copy_buffer_text_out (buf, bytepos, bytelen, NULL, 0, + FORMAT_DEFAULT, Qnil, NULL); + Lisp_Object val = make_uninit_string (needed); struct gcpro gcpro1; GCPRO1 (val); if (!no_extents) - add_string_extents (val, buf, bi_ind, bi_len); - - { - Bytecount len1 = BI_BUF_GPT (buf) - bi_ind; - Intbyte *start1 = BI_BUF_BYTE_ADDRESS (buf, bi_ind); - Intbyte *dest = XSTRING_DATA (val); - - if (len1 < 0) - { - /* Completely after gap */ - memcpy (dest, start1, bi_len); - } - else if (bi_len <= len1) - { - /* Completely before gap */ - memcpy (dest, start1, bi_len); - } - else - { - /* Spans gap */ - Bytebpos pos2 = bi_ind + len1; - Intbyte *start2 = BI_BUF_BYTE_ADDRESS (buf, pos2); - - memcpy (dest, start1, len1); - memcpy (dest + len1, start2, bi_len - len1); - } - } - + add_string_extents (val, buf, bytepos, bytelen); + copy_buffer_text_out (buf, bytepos, bytelen, XSTRING_DATA (val), needed, + FORMAT_DEFAULT, Qnil, NULL); init_string_ascii_begin (val); sledgehammer_check_ascii_begin (val); @@ -1717,7 +1747,7 @@ memory_full (); SET_BUF_END_GAP_SIZE (b, 0); - SET_BI_BUF_GPT (b, 1); + SET_BYTE_BUF_GPT (b, 1); SET_BOTH_BUF_Z (b, 1, 1); SET_GAP_SENTINEL (b); SET_END_SENTINEL (b); @@ -1727,9 +1757,7 @@ b->text->mule_bufmin = b->text->mule_bufmax = 1; b->text->mule_bytmin = b->text->mule_bytmax = 1; - b->text->mule_shifter = 0; - b->text->mule_three_p = 0; - b->text->entirely_ascii_p = 1; + b->text->entirely_one_byte_p = 1; for (i = 0; i < 16; i++) { @@ -1737,6 +1765,8 @@ b->text->mule_bytebpos_cache[i] = 1; } } + /* &&#### Set to FORMAT_8_BIT_FIXED when that code is working */ + BUF_FORMAT (b) = FORMAT_DEFAULT; #endif /* MULE */ b->text->line_number_cache = Qnil; @@ -1751,11 +1781,11 @@ } else { - JUST_SET_POINT (b, BUF_PT (b->base_buffer), BI_BUF_PT (b->base_buffer)); + JUST_SET_POINT (b, BUF_PT (b->base_buffer), BYTE_BUF_PT (b->base_buffer)); SET_BOTH_BUF_BEGV (b, BUF_BEGV (b->base_buffer), - BI_BUF_BEGV (b->base_buffer)); + BYTE_BUF_BEGV (b->base_buffer)); SET_BOTH_BUF_ZV (b, BUF_ZV (b->base_buffer), - BI_BUF_ZV (b->base_buffer)); + BYTE_BUF_ZV (b->base_buffer)); } b->changes = xnew_and_zero (struct each_buffer_change_data);
--- a/src/intl-win32.c Thu May 02 14:35:32 2002 +0000 +++ b/src/intl-win32.c Sun May 05 11:33:57 2002 +0000 @@ -1274,7 +1274,7 @@ #if 0 /* #### from Emacs 20.6; consider porting */ -xxDEFUN ("mswindows-get-locale-info", Fmswindows_get_locale_info, 1, 2, 0, /* +DEFUN ("mswindows-get-locale-info", Fmswindows_get_locale_info, 1, 2, 0, /* Return information about the Windows locale LCID. By default, return a three letter locale code which encodes the default language as the first two characters, and the country or regionial variant @@ -1339,7 +1339,7 @@ return TRUE; } -xxDEFUN ("mswindows-get-valid-code-pages", Fmswindows_get_valid_code_pages, 0, 0, 0, /* +DEFUN ("mswindows-get-valid-code-pages", Fmswindows_get_valid_code_pages, 0, 0, 0, /* Return list of all valid Windows code pages. */ ()) @@ -1352,7 +1352,7 @@ return Vmswindows_valid_code_pages; } -xxDEFUN ("mswindows-get-console-code-page", Fmswindows_get_console_code_page, 0, 0, 0, /* +DEFUN ("mswindows-get-console-code-page", Fmswindows_get_console_code_page, 0, 0, 0, /* Return current Windows code page for console input. */ ()) @@ -1360,7 +1360,7 @@ return make_int (GetConsoleCP ()); } -xxDEFUN ("mswindows-set-console-code-page", Fmswindows_set_console_code_page, 1, 1, 0, /* +DEFUN ("mswindows-set-console-code-page", Fmswindows_set_console_code_page, 1, 1, 0, /* Make Windows code page CP be the current code page setting for Emacs. The code page setting affects keyboard input and display in tty mode. If successful, the new CP is returned, otherwise nil. @@ -1378,7 +1378,7 @@ return make_int (GetConsoleCP ()); } -xxDEFUN ("mswindows-get-console-output-code-page", Fmswindows_get_console_output_code_page, 0, 0, 0, /* +DEFUN ("mswindows-get-console-output-code-page", Fmswindows_get_console_output_code_page, 0, 0, 0, /* Return current Windows code page for console output. */ ()) @@ -1386,7 +1386,7 @@ return make_int (GetConsoleOutputCP ()); } -xxDEFUN ("mswindows-set-console-output-code-page", Fmswindows_set_console_output_code_page, 1, 1, 0, /* +DEFUN ("mswindows-set-console-output-code-page", Fmswindows_set_console_output_code_page, 1, 1, 0, /* Make Windows code page CP be the current code page setting for Emacs. The code page setting affects keyboard input and display in tty mode. If successful, the new CP is returned, otherwise nil. @@ -1404,7 +1404,7 @@ return make_int (GetConsoleOutputCP ()); } -xxDEFUN ("mswindows-get-code-page-charset", Fmswindows_get_code_page_charset, 1, 1, 0, /* +DEFUN ("mswindows-get-code-page-charset", Fmswindows_get_code_page_charset, 1, 1, 0, /* Return charset of code page CP. Returns nil if the code page is not valid. */ @@ -1423,7 +1423,7 @@ return Qnil; } -xxDEFUN ("mswindows-get-valid-keyboard-layouts", Fmswindows_get_valid_keyboard_layouts, 0, 0, 0, /* +DEFUN ("mswindows-get-valid-keyboard-layouts", Fmswindows_get_valid_keyboard_layouts, 0, 0, 0, /* Return list of Windows keyboard languages and layouts. The return value is a list of pairs of language id and layout id. */ @@ -1448,7 +1448,7 @@ return obj; } -xxDEFUN ("mswindows-get-keyboard-layout", Fmswindows_get_keyboard_layout, 0, 0, 0, /* +DEFUN ("mswindows-get-keyboard-layout", Fmswindows_get_keyboard_layout, 0, 0, 0, /* Return current Windows keyboard language and layout. The return value is the cons of the language id and the layout id. */ @@ -1460,7 +1460,7 @@ make_int ((kl >> 16) & 0xffff)); } -xxDEFUN ("mswindows-set-keyboard-layout", Fmswindows_set_keyboard_layout, 1, 1, 0, /* +DEFUN ("mswindows-set-keyboard-layout", Fmswindows_set_keyboard_layout, 1, 1, 0, /* Make LAYOUT be the current keyboard layout for Emacs. The keyboard layout setting affects interpretation of keyboard input. If successful, the new layout id is returned, otherwise nil. @@ -1827,7 +1827,7 @@ struct mswindows_multibyte_to_unicode_coding_system *data = XCODING_SYSTEM_TYPE_DATA (cs, mswindows_multibyte_to_unicode); - write_c_string ("(", printcharfun); + write_c_string (printcharfun, "("); if (data->locale_type == MULTIBYTE_SPECIFIED_CODE_PAGE) print_internal (make_int (data->cp), printcharfun, 1); else @@ -1835,7 +1835,7 @@ write_fmt_string_lisp (printcharfun, "%s, ", 1, mswindows_multibyte_to_unicode_getprop (cs, Qlocale)); print_internal (mswindows_multibyte_to_unicode_getprop (cs, Qcode_page), printcharfun, 0); } - write_c_string (")", printcharfun); + write_c_string (printcharfun, ")"); } /* Convert multibyte to Unicode according to the specified code page
--- a/src/intl.c Thu May 02 14:35:32 2002 +0000 +++ b/src/intl.c Sun May 05 11:33:57 2002 +0000 @@ -1,6 +1,6 @@ /* Various functions for internationalizing XEmacs. Copyright (C) 1993, 1994, 1995 Board of Trustees, University of Illinois. - Copyright (C) 2000, 2001 Ben Wing. + Copyright (C) 2000, 2001, 2002 Ben Wing. This file is part of XEmacs. @@ -101,7 +101,7 @@ Lisp_Object Qdefer_gettext; -xxDEFUN ("ignore-defer-gettext", Fignore_defer_gettext, 1, 1, 0, /* +DEFUN ("ignore-defer-gettext", Fignore_defer_gettext, 1, 1, 0, /* If OBJECT is of the form (defer-gettext "string"), return the string. The purpose of the defer-gettext symbol is to identify strings which are translated when they are referenced instead of when they are defined.
--- a/src/keymap.c Thu May 02 14:35:32 2002 +0000 +++ b/src/keymap.c Sun May 05 11:33:57 2002 +0000 @@ -259,7 +259,7 @@ Lisp_Keymap *keymap = XKEYMAP (obj); if (print_readably) printing_unreadable_object ("#<keymap 0x%x>", keymap->header.uid); - write_c_string ("#<keymap ", printcharfun); + write_c_string (printcharfun, "#<keymap "); if (!NILP (keymap->name)) { write_fmt_string_lisp (printcharfun, "%S ", 1, keymap->name); @@ -475,10 +475,10 @@ k = XKEYMAP (keymap); /* If the keysym is a one-character symbol, use the char code instead. */ - if (SYMBOLP (keysym) && XSTRING_CHAR_LENGTH (XSYMBOL (keysym)->name) == 1) + if (SYMBOLP (keysym) && string_char_length (XSYMBOL (keysym)->name) == 1) { Lisp_Object i_fart_on_gcc = - make_char (XSTRING_CHAR (XSYMBOL (keysym)->name, 0)); + make_char (string_emchar (XSYMBOL (keysym)->name, 0)); keysym = i_fart_on_gcc; } @@ -653,8 +653,8 @@ | XEMACS_MOD_ALT | XEMACS_MOD_SHIFT)) == 0); /* If the keysym is a one-character symbol, use the char code instead. */ - if (SYMBOLP (keysym) && XSTRING_CHAR_LENGTH (XSYMBOL (keysym)->name) == 1) - keysym = make_char (XSTRING_CHAR (XSYMBOL (keysym)->name, 0)); + if (SYMBOLP (keysym) && string_char_length (XSYMBOL (keysym)->name) == 1) + keysym = make_char (string_emchar (XSYMBOL (keysym)->name, 0)); if (modifiers & XEMACS_MOD_META) /* Utterly hateful ESC lossage */ { @@ -1261,10 +1261,10 @@ /* Now, check and massage the trailing keysym specifier. */ if (SYMBOLP (*keysym)) { - if (XSTRING_CHAR_LENGTH (XSYMBOL (*keysym)->name) == 1) + if (string_char_length (XSYMBOL (*keysym)->name) == 1) { Lisp_Object ream_gcc_up_the_ass = - make_char (XSTRING_CHAR (XSYMBOL (*keysym)->name, 0)); + make_char (string_emchar (XSYMBOL (*keysym)->name, 0)); *keysym = ream_gcc_up_the_ass; goto fixnum_keysym; } @@ -1861,7 +1861,7 @@ if (VECTORP (keys)) len = XVECTOR_LENGTH (keys); else if (STRINGP (keys)) - len = XSTRING_CHAR_LENGTH (keys); + len = string_char_length (keys); else if (CHAR_OR_CHAR_INTP (keys) || SYMBOLP (keys) || CONSP (keys)) { if (!CONSP (keys)) keys = list1 (keys); @@ -1899,7 +1899,7 @@ struct key_data raw_key2; if (STRINGP (keys)) - c = make_char (XSTRING_CHAR (keys, idx)); + c = make_char (string_emchar (keys, idx)); else c = XVECTOR_DATA (keys) [idx]; @@ -2217,7 +2217,7 @@ return lookup_keys (keymap, 1, &keys, !NILP (accept_default)); else if (STRINGP (keys)) { - int length = XSTRING_CHAR_LENGTH (keys); + int length = string_char_length (keys); int i; struct key_data *raw_keys = alloca_array (struct key_data, length); if (length == 0) @@ -2225,7 +2225,7 @@ for (i = 0; i < length; i++) { - Emchar n = XSTRING_CHAR (keys, i); + Emchar n = string_emchar (keys, i); define_key_parser (make_char (n), &(raw_keys[i])); } return raw_lookup_key (keymap, raw_keys, length, 0, @@ -2984,7 +2984,7 @@ { /* This function can GC */ Lisp_Object fn; - VOID_TO_LISP (fn, function); + fn = VOID_TO_LISP (function); call2 (fn, make_key_description (key, 1), binding); } @@ -3240,7 +3240,7 @@ { Lisp_Object s2 = Fsingle_key_description (STRINGP (keys) - ? make_char (XSTRING_CHAR (keys, i)) + ? make_char (string_emchar (keys, i)) : XVECTOR_DATA (keys)[i]); if (i == 0)
--- a/src/lisp-disunion.h Thu May 02 14:35:32 2002 +0000 +++ b/src/lisp-disunion.h Sun May 05 11:33:57 2002 +0000 @@ -1,6 +1,6 @@ /* Fundamental definitions for XEmacs Lisp interpreter -- non-union objects. Copyright (C) 1985, 1986, 1987, 1992, 1993 Free Software Foundation, Inc. - Copyright (C) 2001 Ben Wing. + Copyright (C) 2001, 2002 Ben Wing. This file is part of XEmacs. @@ -79,16 +79,30 @@ typedef EMACS_INT Lisp_Object; #define Lisp_Type_Int_Bit (Lisp_Type_Int_Even & Lisp_Type_Int_Odd) -#define wrap_pointer_1(ptr) ((Lisp_Object) (ptr)) -#define make_int(x) ((Lisp_Object) (((x) << INT_GCBITS) | Lisp_Type_Int_Bit)) -#define volatile_make_int(x) make_int (x) -#define make_char(x) ((Lisp_Object) (((x) << GCBITS) | Lisp_Type_Char)) #define VALMASK (((1UL << VALBITS) - 1UL) << GCTYPEBITS) #define XTYPE(x) ((enum Lisp_Type) (((EMACS_UINT)(x)) & ~VALMASK)) #define XPNTRVAL(x) (x) /* This depends on Lisp_Type_Record == 0 */ #define XCHARVAL(x) ((x) >> GCBITS) #define XREALINT(x) ((x) >> INT_GCBITS) #define XUINT(x) ((EMACS_UINT)(x) >> INT_GCBITS) + +#define wrap_pointer_1(ptr) ((Lisp_Object) (ptr)) + +DECLARE_INLINE_HEADER ( +Lisp_Object +make_int_verify (EMACS_INT val) +) +{ + Lisp_Object obj = (Lisp_Object) ((val << INT_GCBITS) | Lisp_Type_Int_Bit); + type_checking_assert (XREALINT (obj) == val); + return obj; +} + +#define make_int(x) ((Lisp_Object) (((x) << INT_GCBITS) | Lisp_Type_Int_Bit)) + +#define volatile_make_int(x) make_int (x) +#define make_char(x) ((Lisp_Object) (((x) << GCBITS) | Lisp_Type_Char)) + #define INTP(x) ((EMACS_UINT)(x) & Lisp_Type_Int_Bit) #define INT_PLUS(x,y) ((x)+(y)-Lisp_Type_Int_Bit) #define INT_MINUS(x,y) ((x)-(y)+Lisp_Type_Int_Bit) @@ -101,10 +115,8 @@ /* Convert between a (void *) and a Lisp_Object, as when the Lisp_Object is passed to a toolkit callback function */ -#define VOID_TO_LISP(larg,varg) ((void) ((larg) = ((Lisp_Object) (varg)))) -#define CVOID_TO_LISP VOID_TO_LISP +#define VOID_TO_LISP(varg) ((Lisp_Object) (varg)) #define LISP_TO_VOID(larg) ((void *) (larg)) -#define LISP_TO_CVOID(larg) ((const void *) (larg)) /* Convert a Lisp_Object into something that can't be used as an lvalue. Useful for type-checking. */
--- a/src/lisp-union.h Thu May 02 14:35:32 2002 +0000 +++ b/src/lisp-union.h Sun May 05 11:33:57 2002 +0000 @@ -77,16 +77,33 @@ GCC to accept any (yes, any) pointer as the argument of a function declared to accept a Lisp_Object. */ struct nosuchstruct *v; - const struct nosuchstruct *cv; } Lisp_Object; #define XCHARVAL(x) ((x).gu.val) -# define XPNTRVAL(x) ((x).ui) +#define XPNTRVAL(x) ((x).ui) + +#define XREALINT(x) ((x).s.val) +#define XUINT(x) ((x).u.val) +#define XTYPE(x) ((x).gu.type) +#define EQ(x,y) ((x).v == (y).v) -INLINE_HEADER Lisp_Object make_int (EMACS_INT val); -INLINE_HEADER Lisp_Object +DECLARE_INLINE_HEADER ( +Lisp_Object +make_int_verify (EMACS_INT val) +) +{ + Lisp_Object obj; + obj.s.bits = 1; + obj.s.val = val; + type_checking_assert (XREALINT (obj) == val); + return obj; +} + +DECLARE_INLINE_HEADER ( +Lisp_Object make_int (EMACS_INT val) +) { Lisp_Object obj; obj.s.bits = 1; @@ -94,7 +111,6 @@ return obj; } - #ifdef __cplusplus #define volatile_make_int(val) make_int (val) @@ -109,9 +125,10 @@ already has a built-in system for dealing with non-local exits and such, in a smart way that doesn't clobber registers, and incorporates longjmp() into that. */ -INLINE_HEADER Lisp_Object volatile_make_int (EMACS_INT val); -INLINE_HEADER Lisp_Object +DECLARE_INLINE_HEADER ( +Lisp_Object volatile_make_int (EMACS_INT val) +) { volatile Lisp_Object obj; obj.s.bits = 1; @@ -122,9 +139,10 @@ #endif /* __cplusplus */ -INLINE_HEADER Lisp_Object make_char (Emchar val); -INLINE_HEADER Lisp_Object +DECLARE_INLINE_HEADER ( +Lisp_Object make_char (Emchar val) +) { Lisp_Object obj; obj.gu.type = Lisp_Type_Char; @@ -132,9 +150,10 @@ return obj; } -INLINE_HEADER Lisp_Object wrap_pointer_1 (const void *ptr); -INLINE_HEADER Lisp_Object +DECLARE_INLINE_HEADER ( +Lisp_Object wrap_pointer_1 (const void *ptr) +) { Lisp_Object obj; obj.ui = (EMACS_UINT) ptr; @@ -143,11 +162,6 @@ extern Lisp_Object Qnull_pointer, Qzero; -#define XREALINT(x) ((x).s.val) -#define XUINT(x) ((x).u.val) -#define XTYPE(x) ((x).gu.type) -#define EQ(x,y) ((x).v == (y).v) - #define INTP(x) ((x).s.bits) #define INT_PLUS(x,y) make_int (XINT (x) + XINT (y)) #define INT_MINUS(x,y) make_int (XINT (x) - XINT (y)) @@ -156,12 +170,17 @@ /* Convert between a (void *) and a Lisp_Object, as when the Lisp_Object is passed to a toolkit callback function */ -#define VOID_TO_LISP(larg,varg) \ - ((void) ((larg).v = (struct nosuchstruct *) (varg))) -#define CVOID_TO_LISP(larg,varg) \ - ((void) ((larg).cv = (const struct nosuchstruct *) (varg))) +DECLARE_INLINE_HEADER ( +Lisp_Object +VOID_TO_LISP (const void *arg) +) +{ + Lisp_Object larg; + larg.v = (struct nosuchstruct *) arg; + return larg; +} + #define LISP_TO_VOID(larg) ((void *) ((larg).v)) -#define LISP_TO_CVOID(larg) ((const void *) ((larg).cv)) /* Convert a Lisp_Object into something that can't be used as an lvalue. Useful for type-checking. */
--- a/src/lisp.h Thu May 02 14:35:32 2002 +0000 +++ b/src/lisp.h Sun May 05 11:33:57 2002 +0000 @@ -77,6 +77,64 @@ #define BITS_PER_EMACS_INT (SIZEOF_EMACS_INT * BITS_PER_CHAR) +#if SIZEOF_SHORT == 2 +#define INT_16_BIT short +#define UINT_16_BIT unsigned short +#elif SIZEOF_INT == 2 +/* Bwa ha ha. As if XEmacs could actually support such systems. */ +#define INT_16_BIT int +#define UINT_16_BIT unsigned int +#else +#error Unable to find a 16-bit integral type +#endif + +#if SIZEOF_INT == 4 +#define INT_32_BIT int +#define UINT_32_BIT unsigned int +#define MAKE_32_BIT_UNSIGNED_CONSTANT(num) num##U +#elif SIZEOF_LONG == 4 +/* Bwa ha ha again. */ +#define INT_32_BIT long +#define UINT_32_BIT unsigned long +#define MAKE_32_BIT_UNSIGNED_CONSTANT(num) num##UL +#elif SIZEOF_SHORT == 4 +/* And again. */ +#define INT_32_BIT short +#define UINT_32_BIT unsigned short +#define MAKE_32_BIT_UNSIGNED_CONSTANT(num) num##U +#elif /* Unable to find a 32-bit integral type! */ +#error What kind of strange-ass system are you running on? +#endif + +#if SIZEOF_LONG == 8 +#define INT_64_BIT long +#define UINT_64_BIT unsigned long +#define MAKE_64_BIT_UNSIGNED_CONSTANT(num) num##UL +#elif SIZEOF_LONG_LONG == 8 +#define INT_64_BIT long long +#define UINT_64_BIT unsigned long long +#define MAKE_64_BIT_UNSIGNED_CONSTANT(num) num##ULL +/* No error otherwise; just leave undefined */ +#endif + +#if SIZEOF_LONG_LONG == 16 +#define INT_128_BIT long long +#define UINT_128_BIT unsigned long long +#define MAKE_128_BIT_UNSIGNED_CONSTANT(num) num##ULL +/* No error otherwise; just leave undefined */ +#endif + +/* #### Fill this in for other systems */ +#if defined (INT_64_BIT) && !(defined (i386) || defined (__i386__)) +#define EFFICIENT_INT_64_BIT INT_64_BIT +#define EFFICIENT_UINT_64_BIT UINT_64_BIT +#endif + +#if defined (INT_128_BIT) +#define EFFICIENT_INT_128_BIT INT_128_BIT +#define EFFICIENT_UINT_128_BIT UINT_128_BIT +#endif + /* ------------------------ basic char/int typedefs ------------------- */ /* The definitions we put here use typedefs to attribute specific meaning @@ -131,32 +189,72 @@ typedef char Char_ASCII; typedef unsigned char UChar_ASCII; - -/* To the user, a buffer is made up of characters, declared as follows. - In the non-Mule world, characters and Intbytes are equivalent. - In the Mule world, a character requires (typically) 1 to 4 - Intbytes for its representation in a buffer. */ +/* To the user, a buffer is made up of characters. In the non-Mule world, + characters and Intbytes are equivalent, restricted to the range 0 - 255. + In the Mule world, many more characters are possible (19 bits worth, + more or less), and a character requires (typically) 1 to 4 Intbytes for + its representation in a buffer or string. Note that the representation + of a character by itself, in a variable, is very different from its + representation in a string of text (in a buffer or Lisp string). + + Under Mule, text can be represented in more than one way. The "default" + format is variable-width (1 to 4 bytes) and compatible with ASCII -- + ASCII chars are stored in one byte, as themselves, and all other chars + use only high bytes. The default format is currently the only format + used for text stored anywhere but in a buffer. In a buffer, other + formats -- fixed-width formats (1, 2, or 4 bytes) -- are possible, for + speed. + + See text.c/text.h for a detailed discussion of all of this. */ + +/* A character, as represented on its own. */ typedef int Emchar; +/* The "raw value" of a character as stored in the buffer. In the default + format, this is just the same as the character. In fixed-width formats, + this is the actual value in the buffer, which will be limited to the + range as established by the format. This is used when searching for a + character in a buffer -- it's faster to convert the character to the raw + value and look for that, than repeatedly convert each raw value in the + buffer into a character. */ + +typedef int Raw_Emchar; + + +#if !defined (__cplusplus) || !defined (CPLUSPLUS_INTEGRAL_CLASSES_NOT_YET) + +/* Counts of bytes or chars */ + +typedef EMACS_INT Bytecount; +typedef EMACS_INT Charcount; + /* Different ways of referring to a position in a buffer. We use the typedefs in preference to 'EMACS_INT' to make it clearer what - sort of position is being used. See extents.c for a description - of the different positions. We put them here instead of in - buffer.h (where they rightfully belong) to avoid syntax errors - in function prototypes. */ - -#if !defined (__cplusplus) || !defined (CPLUSPLUS_INTEGRAL_CLASSES_NOT_YET) + sort of position is being used. See text.c for a description + of the different positions. + + Note that buffer positions are 1-based, and there's a gap in the middle + of a buffer; that's why we have separate typedefs. For Lisp strings and + other strings of text, we just use Bytecount and Charcount. */ typedef EMACS_INT Charbpos; typedef EMACS_INT Bytebpos; typedef EMACS_INT Membpos; -/* Counts of bytes or chars */ -typedef EMACS_INT Bytecount; -typedef EMACS_INT Charcount; - -/* Not yet used */ +/* Different ways of referring to a position that can be either in a buffer + or string; used when passing around an object that can be either a + buffer or string, and an associated position. Conceptually, they + resolve as follows: + + Typedef Buffer String + ------------------------------------------------------ + Charxpos Charbpos Charcount + Bytexpos Bytebpos Bytecount + Memxpos Membpos Bytecount + + */ + typedef EMACS_INT Charxpos; typedef EMACS_INT Bytexpos; typedef EMACS_INT Memxpos; @@ -532,14 +630,14 @@ DECLARE_BAD_MEM_INTCLASS_ARITH_COMPARE (Memxpos) }; -#define DECLARE_POINTER_TYPE_ARITH_COUNT(pointer, countcl) \ -inline pointer operator += (pointer & x, const countcl& y) \ -{ x += y.data; return x; } \ -inline pointer operator -= (pointer & x, const countcl& y) \ -{ x -= y.data; return x; } \ -inline pointer operator + (pointer x, const countcl& y) \ -{ return x + y.data; } \ -inline pointer operator - (pointer x, const countcl& y) \ +#define DECLARE_POINTER_TYPE_ARITH_COUNT(pointer, countcl) \ +inline pointer operator += (const pointer & x, const countcl& y) \ +{ x += y.data; return x; } \ +inline pointer operator -= (const pointer & x, const countcl& y) \ +{ x -= y.data; return x; } \ +inline pointer operator + (const pointer x, const countcl& y) \ +{ return x + y.data; } \ +inline pointer operator - (const pointer x, const countcl& y) \ { return x - y.data; } #define DECLARE_INTEGRAL_TYPE_ARITH_COUNT(integral, countcl) \ @@ -576,8 +674,8 @@ { return b ? x : cl (y); } #endif /* 0 */ -DECLARE_POINTER_TYPE_ARITH_COUNT (const Intbyte *, Bytecount); -DECLARE_POINTER_TYPE_ARITH_COUNT (const Extbyte *, Bytecount); +/* DECLARE_POINTER_TYPE_ARITH_COUNT (const Intbyte *, Bytecount); + DECLARE_POINTER_TYPE_ARITH_COUNT (const Extbyte *, Bytecount); */ DECLARE_POINTER_TYPE_ARITH_COUNT (Intbyte *, Bytecount); DECLARE_POINTER_TYPE_ARITH_COUNT (Extbyte *, Bytecount); @@ -757,16 +855,25 @@ #define ALIGN_SIZE(len, unit) \ ((((len) + (unit) - 1) / (unit)) * (unit)) +/* ALIGN_FOR_TYPE returns the smallest size greater than or equal to LEN + which is aligned for the given type. This can be used to assure that + data that follows a block of the returned size is of correct alignment + for the type (provided that the block itself is correctly aligned for + this type; memory returned by malloc() is guaranteed to be correctly + aligned for all types). */ + +#define ALIGN_FOR_TYPE(len, type) ALIGN_SIZE (len, ALIGNOF (type)) + /* MAX_ALIGN_SIZE returns the smallest size greater than or equal to LEN which guarantees that data following a block of such size is correctly aligned for all types (provided that the block itself is so aligned, which is the case for memory returned by malloc()). */ -#define MAX_ALIGN_SIZE(len) ALIGN_SIZE (len, ALIGNOF (max_align_t)) - -/* #### Yuck, this is kind of evil */ -#define ALIGN_PTR(ptr, unit) \ - ((void *) ALIGN_SIZE ((size_t) (ptr), unit)) +#define MAX_ALIGN_SIZE(len) ALIGN_FOR_TYPE (len, max_align_t) + +/* ALIGN_PTR returns the smallest pointer >= PTR which is aligned for + data of TYPE. */ +#define ALIGN_PTR(ptr, type) ((void *) ALIGN_FOR_TYPE ((size_t) (ptr), type)) /* ------------------------ assertions ------------------- */ @@ -1749,9 +1856,10 @@ ) /* Return 1 if LIST is properly acyclic and nil-terminated, else 0. */ -INLINE_HEADER int TRUE_LIST_P (Lisp_Object object); -INLINE_HEADER int +DECLARE_INLINE_HEADER ( +int TRUE_LIST_P (Lisp_Object object) +) { Lisp_Object hare, tortoise; EMACS_INT len; @@ -1811,7 +1919,7 @@ unsigned int c_readonly :1; unsigned int lisp_readonly :1; /* Number of chars at beginning of string that are one byte in length - (BYTE_ASCII_P) */ + (byte_ascii_p) */ unsigned int ascii_begin :21; } v; } u; @@ -1830,187 +1938,27 @@ #define CHECK_STRING(x) CHECK_RECORD (x, string) #define CONCHECK_STRING(x) CONCHECK_RECORD (x, string) -#ifdef MULE - -Charcount bytecount_to_charcount (const Intbyte *ptr, Bytecount len); -Bytecount charcount_to_bytecount (const Intbyte *ptr, Charcount len); - -#else /* not MULE */ - -# define bytecount_to_charcount(ptr, len) (len) -# define charcount_to_bytecount(ptr, len) (len) - -#endif /* not MULE */ +/* Most basic macros for strings -- basically just accessing or setting + fields -- are here. Everything else is in text.h, since they depend on + stuff there. */ /* Operations on Lisp_String *'s; only ones left */ -#define set_string_length(s, len) ((void) ((s)->size_ = (len))) -#define set_string_data(s, ptr) ((void) ((s)->data_ = (ptr))) - +#define set_lispstringp_length(s, len) ((void) ((s)->size_ = (len))) +#define set_lispstringp_data(s, ptr) ((void) ((s)->data_ = (ptr))) + +/* Operations on strings as Lisp_Objects. Don't manipulate Lisp_String *'s + in any new code. */ #define XSTRING_LENGTH(s) (XSTRING (s)->size_) #define XSTRING_PLIST(s) (XSTRING (s)->plist) #define XSTRING_DATA(s) (XSTRING (s)->data_ + 0) #define XSTRING_ASCII_BEGIN(s) (XSTRING (s)->u.v.ascii_begin + 0) -#define XSTRING_CHAR_LENGTH(s) \ - string_index_byte_to_char (s, XSTRING_LENGTH (s)) -#define XSTRING_BYTE(s, i) (XSTRING (s)->data_[i] + 0) -#define set_string_byte(s, i, c) (XSTRING (s)->data_[i] = (c)) - -#define string_byte_addr(s, i) (&((XSTRING (s))->data_[i])) -#define XSTRING_CHAR(s, i) charptr_emchar (string_char_addr (s, i)) -#define XSET_STRING_LENGTH(s, ptr) set_string_length (XSTRING (s), ptr) -#define XSET_STRING_DATA(s, ptr) set_string_data (XSTRING (s), ptr) +#define XSET_STRING_LENGTH(s, ptr) set_lispstringp_length (XSTRING (s), ptr) +#define XSET_STRING_DATA(s, ptr) set_lispstringp_data (XSTRING (s), ptr) /* WARNING: If you modify an existing string, you must call bump_string_modiff() afterwards. */ #define XSET_STRING_ASCII_BEGIN(s, val) \ ((void) (XSTRING (s)->u.v.ascii_begin = (val))) - -#ifdef ERROR_CHECK_TEXT -#define SLEDGEHAMMER_CHECK_ASCII_BEGIN -#endif - -#ifdef SLEDGEHAMMER_CHECK_ASCII_BEGIN -void sledgehammer_check_ascii_begin (Lisp_Object str); -#else -#define sledgehammer_check_ascii_begin(str) -#endif - -/* Make an alloca'd copy of a Lisp string */ -#define LISP_STRING_TO_ALLOCA(s, lval) \ -do { \ - Intbyte **_lta_ = (Intbyte **) &(lval); \ - Lisp_Object _lta_2 = (s); \ - *_lta_ = alloca_array (Intbyte, 1 + XSTRING_LENGTH (_lta_2)); \ - memcpy (*_lta_, XSTRING_DATA (_lta_2), 1 + XSTRING_LENGTH (_lta_2)); \ -} while (0) - -/* Make an alloca'd copy of a Intbyte * */ -#define INTBYTE_STRING_TO_ALLOCA(p, lval) \ -do { \ - Intbyte **_bsta_ = (Intbyte **) &(lval); \ - const Intbyte *_bsta_2 = (p); \ - Bytecount _bsta_3 = qxestrlen (_bsta_2); \ - *_bsta_ = alloca_array (Intbyte, 1 + _bsta_3); \ - memcpy (*_bsta_, _bsta_2, 1 + _bsta_3); \ -} while (0) - -#define alloca_intbytes(num) alloca_array (Intbyte, num) -#define alloca_extbytes(num) alloca_array (Extbyte, num) - -void resize_string (Lisp_Object s, Bytecount pos, Bytecount delta); - -#ifdef MULE - -/* Convert a byte index into a string into a char index. */ -DECLARE_INLINE_HEADER ( -Charcount -string_index_byte_to_char (Lisp_Object s, Bytecount idx) -) -{ - Charcount retval; - if (idx <= (Bytecount) XSTRING_ASCII_BEGIN (s)) - retval = (Charcount) idx; - else - retval = (XSTRING_ASCII_BEGIN (s) + - bytecount_to_charcount (XSTRING_DATA (s) + - XSTRING_ASCII_BEGIN (s), - idx - XSTRING_ASCII_BEGIN (s))); -#ifdef SLEDGEHAMMER_CHECK_ASCII_BEGIN - assert (retval == bytecount_to_charcount (XSTRING_DATA (s), idx)); -#endif - return retval; -} - -/* Convert a char index into a string into a byte index. */ -DECLARE_INLINE_HEADER ( -Bytecount -string_index_char_to_byte (Lisp_Object s, Charcount idx) -) -{ - Bytecount retval; - if (idx <= (Charcount) XSTRING_ASCII_BEGIN (s)) - retval = (Bytecount) idx; - else - retval = (XSTRING_ASCII_BEGIN (s) + - charcount_to_bytecount (XSTRING_DATA (s) + - XSTRING_ASCII_BEGIN (s), - idx - XSTRING_ASCII_BEGIN (s))); -#ifdef SLEDGEHAMMER_CHECK_ASCII_BEGIN - assert (retval == charcount_to_bytecount (XSTRING_DATA (s), idx)); -#endif - return retval; -} - -/* Convert a substring length (starting at byte offset OFF) from bytes to - chars. */ -DECLARE_INLINE_HEADER ( -Charcount -string_offset_byte_to_char_len (Lisp_Object s, Bytecount off, Bytecount len) -) -{ - Charcount retval; - if (off + len <= (Bytecount) XSTRING_ASCII_BEGIN (s)) - retval = (Charcount) len; - else if (off < (Bytecount) XSTRING_ASCII_BEGIN (s)) - retval = - XSTRING_ASCII_BEGIN (s) - (Charcount) off + - bytecount_to_charcount (XSTRING_DATA (s) + XSTRING_ASCII_BEGIN (s), - len - (XSTRING_ASCII_BEGIN (s) - off)); - else - retval = bytecount_to_charcount (XSTRING_DATA (s) + off, len); -#ifdef SLEDGEHAMMER_CHECK_ASCII_BEGIN - assert (retval == bytecount_to_charcount (XSTRING_DATA (s) + off, len)); -#endif - return retval; -} - -/* Convert a substring length (starting at byte offset OFF) from chars to - bytes. */ -DECLARE_INLINE_HEADER ( -Bytecount -string_offset_char_to_byte_len (Lisp_Object s, Bytecount off, Charcount len) -) -{ - Bytecount retval; - /* casts to avoid errors from combining Bytecount/Charcount and warnings - from signed/unsigned comparisons */ - if (off + (Bytecount) len <= (Bytecount) XSTRING_ASCII_BEGIN (s)) - retval = (Bytecount) len; - else if (off < (Bytecount) XSTRING_ASCII_BEGIN (s)) - retval = - XSTRING_ASCII_BEGIN (s) - off + - charcount_to_bytecount (XSTRING_DATA (s) + XSTRING_ASCII_BEGIN (s), - len - (XSTRING_ASCII_BEGIN (s) - - (Charcount) off)); - else - retval = charcount_to_bytecount (XSTRING_DATA (s) + off, len); -#ifdef SLEDGEHAMMER_CHECK_ASCII_BEGIN - assert (retval == charcount_to_bytecount (XSTRING_DATA (s) + off, len)); -#endif - return retval; -} - -DECLARE_INLINE_HEADER ( -const Intbyte * -string_char_addr (Lisp_Object s, Charcount idx) -) -{ - return XSTRING_DATA (s) + string_index_char_to_byte (s, idx); -} - -void set_string_char (Lisp_Object s, Charcount i, Emchar c); - -#else /* not MULE */ - -#define string_index_byte_to_char(s, idx) (idx) -#define string_index_char_to_byte(s, idx) (idx) -#define string_offset_byte_to_char_len(s, off, len) (len) -#define string_offset_char_to_byte_len(s, off, len) (len) -# define string_char_addr(s, i) string_byte_addr (s, i) -/* WARNING: If you modify an existing string, you must call - bump_string_modiff() afterwards. */ -# define set_string_char(s, i, c) set_string_byte (s, i, c) - -#endif /* not MULE */ +#define XSTRING_FORMAT(s) FORMAT_DEFAULT /* Return the true aligned size of a struct whose last member is a variable-length array field. (this is known as the "struct hack") */ @@ -2028,12 +1976,12 @@ (offsetof (structtype, fieldname[1]) - \ offsetof (structtype, fieldname[0])) * \ (array_length)) \ - : (ALIGN_SIZE \ + : (ALIGN_FOR_TYPE \ ((offsetof (structtype, fieldname) + \ (offsetof (structtype, fieldname[1]) - \ offsetof (structtype, fieldname[0])) * \ (array_length)), \ - ALIGNOF (structtype)))) + structtype))) /*------------------------------ vector --------------------------------*/ @@ -2108,17 +2056,19 @@ #define bit_vector_length(v) ((v)->size) #define bit_vector_next(v) ((v)->next) -INLINE_HEADER int bit_vector_bit (Lisp_Bit_Vector *v, Elemcount n); -INLINE_HEADER int +DECLARE_INLINE_HEADER ( +int bit_vector_bit (Lisp_Bit_Vector *v, Elemcount n) +) { return ((v->bits[n >> LONGBITS_LOG2] >> (n & (LONGBITS_POWER_OF_2 - 1))) & 1); } -INLINE_HEADER void set_bit_vector_bit (Lisp_Bit_Vector *v, Elemcount n, int value); -INLINE_HEADER void +DECLARE_INLINE_HEADER ( +void set_bit_vector_bit (Lisp_Bit_Vector *v, Elemcount n, int value) +) { if (value) v->bits[n >> LONGBITS_LOG2] |= (1UL << (n & (LONGBITS_POWER_OF_2 - 1))); @@ -2145,7 +2095,7 @@ }; #define SYMBOL_IS_KEYWORD(sym) \ - ((XSTRING_BYTE (symbol_name (XSYMBOL (sym)), 0) == ':') \ + ((string_byte (symbol_name (XSYMBOL (sym)), 0) == ':') \ && EQ (sym, oblookup (Vobarray, \ XSTRING_DATA (symbol_name (XSYMBOL (sym))), \ XSTRING_LENGTH (symbol_name (XSYMBOL (sym)))))) @@ -2232,9 +2182,10 @@ #ifdef ERROR_CHECK_TYPES -INLINE_HEADER Emchar XCHAR_1 (Lisp_Object obj, const char *file, int line); -INLINE_HEADER Emchar +DECLARE_INLINE_HEADER ( +Emchar XCHAR_1 (Lisp_Object obj, const char *file, int line) +) { assert_at_line (CHARP (obj), file, line); return XCHARVAL (obj); @@ -2315,18 +2266,19 @@ #define XCHAR_OR_INT(x) XCHAR_OR_INT_1 (x, __FILE__, __LINE__) #define XINT(x) XINT_1 (x, __FILE__, __LINE__) -INLINE_HEADER EMACS_INT XINT_1 (Lisp_Object obj, const char *file, int line); -INLINE_HEADER EMACS_INT +DECLARE_INLINE_HEADER ( +EMACS_INT XINT_1 (Lisp_Object obj, const char *file, int line) +) { assert_at_line (INTP (obj), file, line); return XREALINT (obj); } -INLINE_HEADER EMACS_INT XCHAR_OR_INT_1 (Lisp_Object obj, const char *file, - int line); -INLINE_HEADER EMACS_INT +DECLARE_INLINE_HEADER ( +EMACS_INT XCHAR_OR_INT_1 (Lisp_Object obj, const char *file, int line) +) { assert_at_line (INTP (obj) || CHARP (obj), file, line); return CHARP (obj) ? XCHAR (obj) : XINT (obj); @@ -3110,7 +3062,19 @@ /* Prototypes for all init/syms_of/vars_of initialization functions. */ #include "symsinit.h" +/* Defined in abbrev.c */ +EXFUN (Fexpand_abbrev, 0); + /* Defined in alloc.c */ +EXFUN (Fcons, 2); +EXFUN (Flist, MANY); +EXFUN (Fmake_byte_code, MANY); +EXFUN (Fmake_list, 2); +EXFUN (Fmake_string, 2); +EXFUN (Fmake_symbol, 1); +EXFUN (Fmake_vector, 2); +EXFUN (Fvector, MANY); + void release_breathing_space (void); Lisp_Object noseeum_cons (Lisp_Object, Lisp_Object); Lisp_Object make_vector (Elemcount, Lisp_Object); @@ -3218,6 +3182,8 @@ extern Lisp_Object Vinhibit_read_only, Vtransient_mark_mode; /* Defined in bytecode.c */ +EXFUN (Fbyte_code, 3); + DECLARE_DOESNT_RETURN (invalid_byte_code (const CIntbyte *reason, Lisp_Object frob)); @@ -3226,6 +3192,29 @@ void eputenv (const CIntbyte *var, const CIntbyte *value); extern int env_initted; +/* Defined in callint.c */ +EXFUN (Fcall_interactively, 3); +EXFUN (Fprefix_numeric_value, 1); + +/* Defined in casefiddle.c */ +EXFUN (Fdowncase, 2); +EXFUN (Fupcase, 2); +EXFUN (Fupcase_initials, 2); +EXFUN (Fupcase_initials_region, 3); +EXFUN (Fupcase_region, 3); + +/* Defined in casetab.c */ +EXFUN (Fset_standard_case_table, 1); + +/* Defined in chartab.c */ +EXFUN (Freset_char_table, 1); + +/* Defined in cmds.c */ +EXFUN (Fbeginning_of_line, 2); +EXFUN (Fend_of_line, 2); +EXFUN (Fforward_char, 2); +EXFUN (Fforward_line, 2); + /* Defined in console.c */ void stuff_buffered_input (Lisp_Object); @@ -3237,6 +3226,32 @@ void write_string_to_mswindows_debugging_output (Intbyte *str, Bytecount len); /* Defined in data.c */ +EXFUN (Fadd1, 1); +EXFUN (Faref, 2); +EXFUN (Faset, 3); +EXFUN (Fcar, 1); +EXFUN (Fcar_safe, 1); +EXFUN (Fcdr, 1); +EXFUN (Fgeq, MANY); +EXFUN (Fgtr, MANY); +EXFUN (Findirect_function, 1); +EXFUN (Fleq, MANY); +EXFUN (Flistp, 1); +EXFUN (Flss, MANY); +EXFUN (Fmax, MANY); +EXFUN (Fmin, MANY); +EXFUN (Fminus, MANY); +EXFUN (Fnumber_to_string, 1); +EXFUN (Fplus, MANY); +EXFUN (Fquo, MANY); +EXFUN (Frem, 2); +EXFUN (Fsetcar, 2); +EXFUN (Fsetcdr, 2); +EXFUN (Fsub1, 1); +EXFUN (Fsubr_max_args, 1); +EXFUN (Fsubr_min_args, 1); +EXFUN (Ftimes, MANY); + DECLARE_DOESNT_RETURN (c_write_error (Lisp_Object)); DECLARE_DOESNT_RETURN (lisp_write_error (Lisp_Object)); DECLARE_DOESNT_RETURN (args_out_of_range (Lisp_Object, Lisp_Object)); @@ -3269,6 +3284,8 @@ Lisp_Object wasteful_word_to_lisp (unsigned int); /* Defined in doc.c */ +EXFUN (Fsubstitute_command_keys, 1); + Lisp_Object unparesseuxify_doc_string (int fd, EMACS_INT position, Intbyte *name_nonreloc, Lisp_Object name_reloc, @@ -3276,7 +3293,6 @@ Lisp_Object read_doc_string (Lisp_Object); /* Defined in doprnt.c */ - Bytecount emacs_doprnt_va (Lisp_Object stream, const Intbyte *format_nonreloc, Bytecount format_length, Lisp_Object format_reloc, va_list vargs); @@ -3309,11 +3325,34 @@ /* Defined in editfns.c */ +EXFUN (Fbobp, 1); +EXFUN (Fbolp, 1); +EXFUN (Fbuffer_substring, 3); +EXFUN (Fchar_after, 2); +EXFUN (Fchar_to_string, 1); +EXFUN (Fdelete_region, 3); +EXFUN (Feobp, 1); +EXFUN (Feolp, 1); +EXFUN (Ffollowing_char, 1); +EXFUN (Fformat, MANY); +EXFUN (Fgoto_char, 2); +EXFUN (Finsert, MANY); +EXFUN (Finsert_buffer_substring, 3); +EXFUN (Finsert_char, 4); +EXFUN (Fnarrow_to_region, 3); +EXFUN (Fpoint, 1); +EXFUN (Fpoint_marker, 2); +EXFUN (Fpoint_max, 1); +EXFUN (Fpoint_min, 1); +EXFUN (Fpreceding_char, 1); +EXFUN (Fsystem_name, 0); +EXFUN (Fuser_home_directory, 0); +EXFUN (Fuser_login_name, 1); +EXFUN (Fwiden, 1); + void uncache_home_directory (void); Intbyte *get_home_directory (void); Intbyte *user_login_name (uid_t *); -Charbpos charbpos_clip_to_bounds (Charbpos, Charbpos, Charbpos); -Bytebpos bytebpos_clip_to_bounds (Bytebpos, Bytebpos, Bytebpos); void buffer_insert1 (struct buffer *, Lisp_Object); Lisp_Object make_string_from_buffer (struct buffer *, Charbpos, Charcount); Lisp_Object make_string_from_buffer_no_extents (struct buffer *, Charbpos, Charcount); @@ -3329,6 +3368,9 @@ Lisp_Object save_current_buffer_restore (Lisp_Object); /* Defined in emacs.c */ +EXFUN (Fkill_emacs, 1); +EXFUN (Frunning_temacs_p, 0); + SIGTYPE fatal_error_signal (int); Lisp_Object make_arg_list (int, Extbyte **); void make_argc_argv (Lisp_Object, int *, Extbyte ***); @@ -3348,7 +3390,24 @@ void really_abort (void); void zero_out_command_line_status_vars (void); +/* Defined in emodules.c */ +EXFUN (Flist_modules, 0); +EXFUN (Fload_module, 3); + + /* Defined in eval.c */ +EXFUN (Fapply, MANY); +EXFUN (Fbacktrace, 2); +EXFUN (Fcommand_execute, 3); +EXFUN (Fcommandp, 1); +EXFUN (Feval, 1); +EXFUN (Ffuncall, MANY); +EXFUN (Ffunctionp, 1); +EXFUN (Finteractive_p, 0); +EXFUN (Fprogn, UNEVALLED); +EXFUN (Fsignal, 2); +EXFUN (Fthrow, 2); + DECLARE_DOESNT_RETURN (signal_error_1 (Lisp_Object, Lisp_Object)); void maybe_signal_error_1 (Lisp_Object, Lisp_Object, Lisp_Object, Error_Behavior); @@ -3544,6 +3603,17 @@ /* Defined in event-stream.c */ +EXFUN (Faccept_process_output, 3); +EXFUN (Fadd_timeout, 4); +EXFUN (Fdisable_timeout, 1); +EXFUN (Fdiscard_input, 0); +EXFUN (Fdispatch_event, 1); +EXFUN (Fenqueue_eval_event, 2); +EXFUN (Fnext_event, 2); +EXFUN (Fread_key_sequence, 3); +EXFUN (Fsit_for, 2); +EXFUN (Fsleep_for, 1); + void wait_delaying_user_input (int (*) (void *), void *); int detect_input_pending (void); void reset_this_command_keys (Lisp_Object, int); @@ -3558,6 +3628,9 @@ /* Defined in events.c */ +EXFUN (Fcopy_event, 2); +EXFUN (Fevent_to_character, 4); + void clear_event_resource (void); Lisp_Object allocate_event (void); @@ -3565,6 +3638,71 @@ EXFUN (Fevent_y_pixel, 1); +/* Defined in extents.c */ +EXFUN (Fextent_at, 5); +EXFUN (Fextent_property, 3); +EXFUN (Fput_text_property, 5); + +EXFUN (Fdetach_extent, 1); +EXFUN (Fextent_end_position, 1); +EXFUN (Fextent_object, 1); +EXFUN (Fextent_properties, 1); +EXFUN (Fextent_start_position, 1); +EXFUN (Fget_char_property, 4); +EXFUN (Fmake_extent, 3); +EXFUN (Fnext_extent_change, 2); +EXFUN (Fprevious_extent_change, 2); +EXFUN (Fprevious_single_property_change, 4); +EXFUN (Fset_extent_endpoints, 4); +EXFUN (Fset_extent_parent, 2); +EXFUN (Fset_extent_property, 3); + +enum extent_at_flag +{ + EXTENT_AT_DEFAULT = 0, + EXTENT_AT_AFTER = 0, + EXTENT_AT_BEFORE, + EXTENT_AT_AT +}; + +Bytexpos extent_endpoint_byte (EXTENT extent, int endp); +Charxpos extent_endpoint_char (EXTENT extent, int endp); +Bytexpos next_single_property_change (Bytexpos pos, Lisp_Object prop, + Lisp_Object object, Bytexpos limit); +Bytexpos previous_single_property_change (Bytexpos pos, Lisp_Object prop, + Lisp_Object object, Bytexpos limit); +Lisp_Object get_char_property (Bytexpos position, Lisp_Object prop, + Lisp_Object object, enum extent_at_flag fl, + int text_props_only); +void adjust_extents (Lisp_Object object, Memxpos from, + Memxpos to, int amount); +void adjust_extents_for_deletion (Lisp_Object object, Bytexpos from, + Bytexpos to, int gapsize, + int numdel, int movegapsize); +void verify_extent_modification (Lisp_Object object, Bytexpos from, + Bytexpos to, + Lisp_Object inhibit_read_only_value); +void process_extents_for_insertion (Lisp_Object object, + Bytexpos opoint, Bytecount length); +void process_extents_for_deletion (Lisp_Object object, Bytexpos from, + Bytexpos to, int destroy_them); +/* Note the following function is in Charbpos's */ +void report_extent_modification (Lisp_Object buffer, Charbpos start, + Charbpos end, int afterp); +void add_string_extents (Lisp_Object string, struct buffer *buf, + Bytexpos opoint, Bytecount length); +void splice_in_string_extents (Lisp_Object string, struct buffer *buf, + Bytexpos opoint, Bytecount length, + Bytecount pos); +void copy_string_extents (Lisp_Object new_string, + Lisp_Object old_string, + Bytecount new_pos, Bytecount old_pos, + Bytecount length); +void detach_all_extents (Lisp_Object object); +Lisp_Object extent_at (Bytexpos position, Lisp_Object object, + Lisp_Object property, EXTENT before, + enum extent_at_flag at_flag, int all_extents); + /* Defined in file-coding.c */ EXFUN (Fcoding_category_list, 0); EXFUN (Fcoding_category_system, 1); @@ -3620,6 +3758,27 @@ /* Defined in fileio.c */ +EXFUN (Fdirectory_file_name, 1); +EXFUN (Fdo_auto_save, 2); +EXFUN (Fexpand_file_name, 2); +EXFUN (Ffile_accessible_directory_p, 1); +EXFUN (Ffile_directory_p, 1); +EXFUN (Ffile_executable_p, 1); +EXFUN (Ffile_exists_p, 1); +EXFUN (Ffile_name_absolute_p, 1); +EXFUN (Ffile_name_as_directory, 1); +EXFUN (Ffile_name_directory, 1); +EXFUN (Ffile_name_nondirectory, 1); +EXFUN (Ffile_readable_p, 1); +EXFUN (Ffile_symlink_p, 1); +EXFUN (Ffile_truename, 2); +EXFUN (Ffind_file_name_handler, 2); +EXFUN (Finsert_file_contents_internal, 7); +EXFUN (Fmake_temp_name, 1); +EXFUN (Fsubstitute_in_file_name, 1); +EXFUN (Funhandled_file_name_directory, 1); +EXFUN (Fverify_visited_file_modtime, 1); + void record_auto_save (void); void force_auto_save_soon (void); DECLARE_DOESNT_RETURN (report_error_with_errno (Lisp_Object errtype, @@ -3635,6 +3794,8 @@ int internal_delete_file (Lisp_Object); /* Defined in filelock.c */ +EXFUN (Funlock_buffer, 0); + void lock_file (Lisp_Object); void unlock_file (Lisp_Object); void unlock_all_files (void); @@ -3644,9 +3805,56 @@ void filemodestring (struct stat *, char *); /* Defined in floatfns.c */ +EXFUN (Ftruncate, 1); + double extract_float (Lisp_Object); /* Defined in fns.c */ +EXFUN (Fappend, MANY); +EXFUN (Fassoc, 2); +EXFUN (Fassq, 2); +EXFUN (Fcanonicalize_lax_plist, 2); +EXFUN (Fcanonicalize_plist, 2); +EXFUN (Fcheck_valid_plist, 1); +EXFUN (Fconcat, MANY); +EXFUN (Fcopy_alist, 1); +EXFUN (Fcopy_list, 1); +EXFUN (Fcopy_sequence, 1); +EXFUN (Fcopy_tree, 2); +EXFUN (Fdelete, 2); +EXFUN (Fdelq, 2); +EXFUN (Fdestructive_alist_to_plist, 1); +EXFUN (Felt, 2); +EXFUN (Fequal, 2); +EXFUN (Fget, 3); +EXFUN (Flast, 2); +EXFUN (Flax_plist_get, 3); +EXFUN (Flax_plist_remprop, 2); +EXFUN (Flength, 1); +EXFUN (Fmapcar, 2); +EXFUN (Fmember, 2); +EXFUN (Fmemq, 2); +EXFUN (Fnconc, MANY); +EXFUN (Fnreverse, 1); +EXFUN (Fnthcdr, 2); +EXFUN (Fold_assq, 2); +EXFUN (Fold_equal, 2); +EXFUN (Fold_member, 2); +EXFUN (Fold_memq, 2); +EXFUN (Fplist_get, 3); +EXFUN (Fplist_member, 2); +EXFUN (Fplist_put, 3); +EXFUN (Fprovide, 1); +EXFUN (Fput, 3); +EXFUN (Frassq, 2); +EXFUN (Fremassq, 2); +EXFUN (Freplace_list, 2); +EXFUN (Fsort, 2); +EXFUN (Fstring_equal, 2); +EXFUN (Fstring_lessp, 2); +EXFUN (Fsubstring, 3); +EXFUN (Fvalid_plist_p, 1); + Lisp_Object list_sort (Lisp_Object, Lisp_Object, int (*) (Lisp_Object, Lisp_Object, Lisp_Object)); Lisp_Object merge (Lisp_Object, Lisp_Object, Lisp_Object); @@ -3686,7 +3894,15 @@ Lisp_Object add_prefix_to_symbol (const Char_ASCII *ascii_string, Lisp_Object symbol); +/* Defined in frame.c */ +EXFUN (Fselected_frame, 1); + +/* Defined in free-hook.c */ +EXFUN (Freally_free, 1); + /* Defined in glyphs.c */ +EXFUN (Fmake_glyph_internal, 1); + Error_Behavior decode_error_behavior_flag (Lisp_Object); Lisp_Object encode_error_behavior_flag (Error_Behavior); @@ -3704,7 +3920,10 @@ DECLARE_DOESNT_RETURN (gui_error_2 (const char *reason, Lisp_Object frob0, Lisp_Object frob1)); /* Defined in indent.c */ -int bi_spaces_at_point (struct buffer *, Bytebpos); +EXFUN (Findent_to, 3); +EXFUN (Fvertical_motion, 3); + +int byte_spaces_at_point (struct buffer *, Bytebpos); int column_at_point (struct buffer *, Charbpos, int); int string_column_at_point (Lisp_Object, Charbpos, int); int current_column (struct buffer *); @@ -3715,6 +3934,10 @@ /* Defined in insdel.c */ void set_buffer_point (struct buffer *buf, Charbpos pos, Bytebpos bipos); +/* Defined in intl.c */ +EXFUN (Fgettext, 1); + + /* Defined in intl-win32.c */ EXFUN (Fmswindows_set_current_locale, 1); EXFUN (Fmswindows_current_locale, 0); @@ -3729,9 +3952,16 @@ extern Lisp_Object Qmswindows_multibyte, Qmswindows_multibyte_to_unicode; /* Defined in keymap.c */ +EXFUN (Fdefine_key, 3); +EXFUN (Fkey_description, 1); +EXFUN (Flookup_key, 3); +EXFUN (Fmake_sparse_keymap, 1); + void where_is_to_char (Lisp_Object, Eistring *); /* Defined in lread.c */ +EXFUN (Fread, 1); + void ebolify_bytecode_constants (Lisp_Object); void close_load_descs (void); int locate_file (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object *, int); @@ -3754,10 +3984,20 @@ # define LOADHIST_ATTACH(x) #endif /*! LOADHIST */ +/* Defined in macros.c */ +EXFUN (Fexecute_kbd_macro, 2); + /* Defined in marker.c */ -Bytebpos bi_marker_position (Lisp_Object); +EXFUN (Fcopy_marker, 2); +EXFUN (Fmake_marker, 0); +EXFUN (Fmarker_buffer, 1); +EXFUN (Fmarker_position, 1); +EXFUN (Fset_marker, 3); +EXFUN (Fset_marker_insertion_type, 2); + +Bytebpos byte_marker_position (Lisp_Object); Charbpos marker_position (Lisp_Object); -void set_bi_marker_position (Lisp_Object, Bytebpos); +void set_byte_marker_position (Lisp_Object, Bytebpos); void set_marker_position (Lisp_Object, Charbpos); void unchain_marker (Lisp_Object); Lisp_Object noseeum_copy_marker (Lisp_Object, Lisp_Object); @@ -3798,9 +4038,18 @@ void clear_message (void); /* Defined in mule-charset.c */ +EXFUN (Fmake_charset, 3); + extern Lisp_Object Ql2r, Qr2l; /* Defined in print.c */ +EXFUN (Fdisplay_error, 2); +EXFUN (Ferror_message_string, 1); +EXFUN (Fprin1, 2); +EXFUN (Fprin1_to_string, 2); +EXFUN (Fprinc, 2); +EXFUN (Fprint, 2); + /* Lower-level ways to output data: */ void print_internal (Lisp_Object, Lisp_Object, int); @@ -3808,12 +4057,12 @@ /* NOTE: Do not call this with the data of a Lisp_String. Use princ. * Note: stream should be defaulted before calling * (eg Qnil means stdout, not Vstandard_output, etc) */ -void write_c_string (const CIntbyte *str, Lisp_Object stream); +void write_c_string (Lisp_Object stream, const CIntbyte *str); /* Same goes for this function. */ -void write_string (const Intbyte *str, Lisp_Object stream); +void write_string (Lisp_Object stream, const Intbyte *str); /* Same goes for this function. */ -void write_string_1 (const Intbyte *str, Bytecount size, Lisp_Object stream); -void write_eistring (const Eistring *ei, Lisp_Object stream); +void write_string_1 (Lisp_Object stream, const Intbyte *str, Bytecount size); +void write_eistring (Lisp_Object stream, const Eistring *ei); /* Higher-level (printf-style) ways to output data: */ void write_fmt_string (Lisp_Object stream, const CIntbyte *fmt, ...); @@ -3856,6 +4105,11 @@ void debug_backtrace (void); /* Defined in process.c */ +EXFUN (Fdelete_process, 1); +EXFUN (Fget_buffer_process, 1); +EXFUN (Fget_process, 1); +EXFUN (Fprocess_status, 1); + DECLARE_DOESNT_RETURN (report_process_error (const char *, Lisp_Object)); DECLARE_DOESNT_RETURN (report_network_error (const char *, Lisp_Object)); extern Lisp_Object Vlisp_EXEC_SUFFIXES; @@ -3867,6 +4121,11 @@ extern int profiling_redisplay_flag; /* Defined in rangetab.c */ +EXFUN (Fclear_range_table, 1); +EXFUN (Fget_range_table, 3); +EXFUN (Fmake_range_table, 0); +EXFUN (Fput_range_table, 4); + void put_range_table (Lisp_Object, EMACS_INT, EMACS_INT, Lisp_Object); int unified_range_table_bytes_needed (Lisp_Object); int unified_range_table_bytes_used (void *); @@ -3877,17 +4136,29 @@ Lisp_Object *); /* Defined in search.c */ +EXFUN (Fmatch_beginning, 1); +EXFUN (Fmatch_end, 1); +EXFUN (Fskip_chars_backward, 3); +EXFUN (Fskip_chars_forward, 3); +EXFUN (Fstring_match, 4); + struct re_pattern_buffer; struct re_registers; -Charbpos scan_buffer (struct buffer *, Emchar, Charbpos, Charbpos, EMACS_INT, EMACS_INT *, int); +Charbpos scan_buffer (struct buffer *, Emchar, Charbpos, Charbpos, EMACS_INT, + EMACS_INT *, int); Charbpos find_next_newline (struct buffer *, Charbpos, int); Charbpos find_next_newline_no_quit (struct buffer *, Charbpos, int); -Bytebpos bi_find_next_newline_no_quit (struct buffer *, Bytebpos, int); -Bytebpos bi_find_next_emchar_in_string (Lisp_Object, Emchar, Bytebpos, EMACS_INT); +Bytebpos byte_find_next_newline_no_quit (struct buffer *, Bytebpos, int); +Bytecount byte_find_next_emchar_in_string (Lisp_Object, Emchar, Bytecount, + EMACS_INT); Charbpos find_before_next_newline (struct buffer *, Charbpos, Charbpos, int); -struct re_pattern_buffer *compile_pattern (Lisp_Object, struct re_registers *, - Lisp_Object, int, Error_Behavior); -Bytecount fast_string_match (Lisp_Object, const Intbyte *, +struct re_pattern_buffer *compile_pattern (Lisp_Object pattern, + struct re_registers *regp, + Lisp_Object translate, + Lisp_Object searchobj, + struct buffer *searchbuf, + int posix, Error_Behavior errb); +Bytecount fast_string_match (Lisp_Object, const Intbyte *, Lisp_Object, Bytecount, Bytecount, int, Error_Behavior, int); Bytecount fast_lisp_string_match (Lisp_Object, Lisp_Object); @@ -3900,16 +4171,37 @@ int begin_dont_check_for_quit (void); /* Defined in sound.c */ +EXFUN (Fding, 3); + void init_device_sound (struct device *); DECLARE_DOESNT_RETURN (report_sound_error (const Char_ASCII *, Lisp_Object)); /* Defined in specifier.c */ +EXFUN (Fadd_spec_to_specifier, 5); +EXFUN (Fspecifier_spec_list, 4); + Lisp_Object specifier_instance (Lisp_Object, Lisp_Object, Lisp_Object, Error_Behavior, int, int, Lisp_Object); Lisp_Object specifier_instance_no_quit (Lisp_Object, Lisp_Object, Lisp_Object, Error_Behavior, int, Lisp_Object); /* Defined in symbols.c */ +EXFUN (Fboundp, 1); +EXFUN (Fbuilt_in_variable_type, 1); +EXFUN (Fdefault_boundp, 1); +EXFUN (Fdefault_value, 1); +EXFUN (Ffboundp, 1); +EXFUN (Ffset, 2); +EXFUN (Fintern, 2); +EXFUN (Fintern_soft, 2); +EXFUN (Fkill_local_variable, 1); +EXFUN (Fset, 2); +EXFUN (Fset_default, 2); +EXFUN (Fsymbol_function, 1); +EXFUN (Fsymbol_name, 1); +EXFUN (Fsymbol_plist, 1); +EXFUN (Fsymbol_value, 1); + unsigned int hash_string (const Intbyte *, Bytecount); Lisp_Object intern_int (const Intbyte *str); Lisp_Object intern (const CIntbyte *str); @@ -3929,6 +4221,15 @@ /* Defined in syntax.c */ Charbpos scan_words (struct buffer *, Charbpos, int); +EXFUN (Fchar_syntax, 2); +EXFUN (Fforward_word, 2); +extern Lisp_Object Vstandard_syntax_table; +void signal_syntax_table_extent_changed (EXTENT extent); +void signal_syntax_table_extent_adjust (struct buffer *buf); +void init_buffer_syntax_cache (struct buffer *buf); +void mark_buffer_syntax_cache (struct buffer *buf); +void uninit_buffer_syntax_cache (struct buffer *buf); +extern Lisp_Object Qsyntax_table; /* Defined in sysdep.c */ long get_random (void); @@ -3954,6 +4255,17 @@ Intbyte_dynarr *dyn); Intbyte *convert_emchar_string_into_malloced_string (Emchar *arr, int nels, Bytecount *len_out); +Bytecount copy_text_between_formats (const Intbyte *src, Bytecount srclen, + Internal_Format srcfmt, + Lisp_Object srcobj, + Intbyte *dst, Bytecount dstlen, + Internal_Format dstfmt, + Lisp_Object dstobj, + Bytecount *src_used); +Bytecount copy_buffer_text_out (struct buffer *buf, Bytebpos pos, + Bytecount len, Intbyte *dst, Bytecount dstlen, + Internal_Format dstfmt, Lisp_Object dstobj, + Bytecount *src_used); /* flags for get_buffer_pos_char(), get_buffer_range_char(), etc. */ /* At most one of GB_COERCE_RANGE and GB_NO_ERROR_IF_BAD should be @@ -3988,24 +4300,41 @@ void get_string_range_byte (Lisp_Object string, Lisp_Object from, Lisp_Object to, Bytecount *from_out, Bytecount *to_out, unsigned int flags); -Charbpos get_buffer_or_string_pos_char (Lisp_Object object, Lisp_Object pos, - unsigned int flags); -Bytebpos get_buffer_or_string_pos_byte (Lisp_Object object, Lisp_Object pos, - unsigned int flags); +Charxpos get_buffer_or_string_pos_char (Lisp_Object object, Lisp_Object pos, + unsigned int flags); +Bytexpos get_buffer_or_string_pos_byte (Lisp_Object object, Lisp_Object pos, + unsigned int flags); void get_buffer_or_string_range_char (Lisp_Object object, Lisp_Object from, - Lisp_Object to, Charbpos *from_out, - Charbpos *to_out, unsigned int flags); + Lisp_Object to, Charxpos *from_out, + Charxpos *to_out, unsigned int flags); void get_buffer_or_string_range_byte (Lisp_Object object, Lisp_Object from, - Lisp_Object to, Bytebpos *from_out, - Bytebpos *to_out, unsigned int flags); -Charbpos buffer_or_string_accessible_begin_char (Lisp_Object object); -Charbpos buffer_or_string_accessible_end_char (Lisp_Object object); -Bytebpos buffer_or_string_accessible_begin_byte (Lisp_Object object); -Bytebpos buffer_or_string_accessible_end_byte (Lisp_Object object); -Charbpos buffer_or_string_absolute_begin_char (Lisp_Object object); -Charbpos buffer_or_string_absolute_end_char (Lisp_Object object); -Bytebpos buffer_or_string_absolute_begin_byte (Lisp_Object object); -Bytebpos buffer_or_string_absolute_end_byte (Lisp_Object object); + Lisp_Object to, Bytexpos *from_out, + Bytexpos *to_out, unsigned int flags); +Charxpos buffer_or_string_accessible_begin_char (Lisp_Object object); +Charxpos buffer_or_string_accessible_end_char (Lisp_Object object); +Bytexpos buffer_or_string_accessible_begin_byte (Lisp_Object object); +Bytexpos buffer_or_string_accessible_end_byte (Lisp_Object object); +Charxpos buffer_or_string_absolute_begin_char (Lisp_Object object); +Charxpos buffer_or_string_absolute_end_char (Lisp_Object object); +Bytexpos buffer_or_string_absolute_begin_byte (Lisp_Object object); +Bytexpos buffer_or_string_absolute_end_byte (Lisp_Object object); +Charbpos charbpos_clip_to_bounds (Charbpos lower, Charbpos num, + Charbpos upper); +Bytebpos bytebpos_clip_to_bounds (Bytebpos lower, Bytebpos num, + Bytebpos upper); +Charxpos charxpos_clip_to_bounds (Charxpos lower, Charxpos num, + Charxpos upper); +Bytexpos bytexpos_clip_to_bounds (Bytexpos lower, Bytexpos num, + Bytexpos upper); +Charxpos buffer_or_string_clip_to_accessible_char (Lisp_Object object, + Charxpos pos); +Bytexpos buffer_or_string_clip_to_accessible_byte (Lisp_Object object, + Bytexpos pos); +Charxpos buffer_or_string_clip_to_absolute_char (Lisp_Object object, + Charxpos pos); +Bytexpos buffer_or_string_clip_to_absolute_byte (Lisp_Object object, + Bytexpos pos); + #ifdef ENABLE_COMPOSITE_CHARS @@ -4247,8 +4576,8 @@ Bytecount bytelength, Charcount charlength); void buffer_mule_signal_deleted_region (struct buffer *buf, Charbpos start, - Charbpos end, Bytebpos bi_start, - Bytebpos bi_end); + Charbpos end, Bytebpos byte_start, + Bytebpos byte_end); /* Defined in unicode.c */ extern const struct struct_description to_unicode_description[]; @@ -4266,6 +4595,8 @@ #endif /* MEMORY_USAGE_STATS */ /* Defined in undo.c */ +EXFUN (Fundo_boundary, 0); + Lisp_Object truncate_undo_list (Lisp_Object, int, int); void record_extent (Lisp_Object, int); void record_insert (struct buffer *, Charbpos, Charcount); @@ -4286,242 +4617,16 @@ void memory_warnings (void *, void (*) (const char *)); /* Defined in window.c */ +EXFUN (Fcurrent_window_configuration, 1); + Lisp_Object save_window_excursion_unwind (Lisp_Object); Lisp_Object display_buffer (Lisp_Object, Lisp_Object, Lisp_Object); -/*--------------- prototypes for Lisp primitives in C ------------*/ - -/* The following were machine generated 19980312 */ - -EXFUN (Faccept_process_output, 3); -EXFUN (Fadd1, 1); -EXFUN (Fadd_spec_to_specifier, 5); -EXFUN (Fadd_timeout, 4); -EXFUN (Fappend, MANY); -EXFUN (Fapply, MANY); -EXFUN (Faref, 2); -EXFUN (Faset, 3); -EXFUN (Fassoc, 2); -EXFUN (Fassq, 2); -EXFUN (Fbacktrace, 2); -EXFUN (Fbeginning_of_line, 2); -EXFUN (Fbobp, 1); -EXFUN (Fbolp, 1); -EXFUN (Fboundp, 1); -EXFUN (Fbuffer_substring, 3); -EXFUN (Fbuilt_in_variable_type, 1); -EXFUN (Fbyte_code, 3); -EXFUN (Fcall_interactively, 3); -EXFUN (Fcanonicalize_lax_plist, 2); -EXFUN (Fcanonicalize_plist, 2); -EXFUN (Fcar, 1); -EXFUN (Fcar_safe, 1); -EXFUN (Fcdr, 1); -EXFUN (Fchar_after, 2); -EXFUN (Fchar_to_string, 1); -EXFUN (Fcheck_valid_plist, 1); -EXFUN (Fvalid_plist_p, 1); -EXFUN (Fclear_range_table, 1); -EXFUN (Fcommand_execute, 3); -EXFUN (Fcommandp, 1); -EXFUN (Fconcat, MANY); -EXFUN (Fcons, 2); -EXFUN (Fcopy_alist, 1); -EXFUN (Fcopy_event, 2); -EXFUN (Fcopy_list, 1); -EXFUN (Fcopy_marker, 2); -EXFUN (Fcopy_sequence, 1); -EXFUN (Fcopy_tree, 2); -EXFUN (Fcurrent_window_configuration, 1); -EXFUN (Fdefault_boundp, 1); -EXFUN (Fdefault_value, 1); -EXFUN (Fdefine_key, 3); -EXFUN (Fdelete, 2); -EXFUN (Fdelete_region, 3); -EXFUN (Fdelete_process, 1); -EXFUN (Fdelq, 2); -EXFUN (Fdestructive_alist_to_plist, 1); -EXFUN (Fdgettext, 2); -EXFUN (Fding, 3); -EXFUN (Fdirectory_file_name, 1); -EXFUN (Fdisable_timeout, 1); -EXFUN (Fdiscard_input, 0); -EXFUN (Fdispatch_event, 1); -EXFUN (Fdisplay_error, 2); -EXFUN (Fdo_auto_save, 2); -EXFUN (Fdowncase, 2); -EXFUN (Felt, 2); -EXFUN (Fend_of_line, 2); -EXFUN (Fenqueue_eval_event, 2); -EXFUN (Feobp, 1); -EXFUN (Feolp, 1); -EXFUN (Fequal, 2); -EXFUN (Ferror_message_string, 1); -EXFUN (Feval, 1); -EXFUN (Fevent_to_character, 4); -EXFUN (Fexecute_kbd_macro, 2); -EXFUN (Fexpand_abbrev, 0); -EXFUN (Fexpand_file_name, 2); -EXFUN (Fextent_at, 5); -EXFUN (Fextent_property, 3); -EXFUN (Ffboundp, 1); -EXFUN (Ffile_accessible_directory_p, 1); -EXFUN (Ffile_directory_p, 1); -EXFUN (Ffile_executable_p, 1); -EXFUN (Ffile_exists_p, 1); -EXFUN (Ffile_name_absolute_p, 1); -EXFUN (Ffile_name_as_directory, 1); -EXFUN (Ffile_name_directory, 1); -EXFUN (Ffile_name_nondirectory, 1); -EXFUN (Ffile_readable_p, 1); -EXFUN (Ffile_symlink_p, 1); -EXFUN (Ffile_truename, 2); -EXFUN (Ffind_file_name_handler, 2); -EXFUN (Ffollowing_char, 1); -EXFUN (Fformat, MANY); -EXFUN (Fforward_char, 2); -EXFUN (Fforward_line, 2); -EXFUN (Ffset, 2); -EXFUN (Ffuncall, MANY); -EXFUN (Ffunctionp, 1); -EXFUN (Fgeq, MANY); -EXFUN (Fget, 3); -EXFUN (Fget_buffer_process, 1); -EXFUN (Fget_process, 1); -EXFUN (Fget_range_table, 3); -EXFUN (Fgettext, 1); -EXFUN (Fgoto_char, 2); -EXFUN (Fgtr, MANY); -EXFUN (Findent_to, 3); -EXFUN (Findirect_function, 1); -EXFUN (Finsert, MANY); -EXFUN (Finsert_buffer_substring, 3); -EXFUN (Finsert_char, 4); -EXFUN (Finsert_file_contents_internal, 7); -EXFUN (Finteractive_p, 0); -EXFUN (Fintern, 2); -EXFUN (Fintern_soft, 2); -EXFUN (Fkey_description, 1); -EXFUN (Fkill_emacs, 1); -EXFUN (Fkill_local_variable, 1); -EXFUN (Flast, 2); -EXFUN (Flax_plist_get, 3); -EXFUN (Flax_plist_remprop, 2); -EXFUN (Flength, 1); -EXFUN (Fleq, MANY); -EXFUN (Flist, MANY); -EXFUN (Flistp, 1); -EXFUN (Flist_modules, 0); -EXFUN (Fload_module, 3); -EXFUN (Flookup_key, 3); -EXFUN (Flss, MANY); -EXFUN (Fmake_byte_code, MANY); -EXFUN (Fmake_charset, 3); -EXFUN (Fmake_glyph_internal, 1); -EXFUN (Fmake_list, 2); -EXFUN (Fmake_marker, 0); -EXFUN (Fmake_range_table, 0); -EXFUN (Fmake_temp_name, 1); -EXFUN (Fmake_sparse_keymap, 1); -EXFUN (Fmake_string, 2); -EXFUN (Fmake_symbol, 1); -EXFUN (Fmake_vector, 2); -EXFUN (Fmapcar, 2); -EXFUN (Fmarker_buffer, 1); -EXFUN (Fmarker_position, 1); -EXFUN (Fmatch_beginning, 1); -EXFUN (Fmatch_end, 1); -EXFUN (Fmax, MANY); -EXFUN (Fmember, 2); -EXFUN (Fmemq, 2); -EXFUN (Fmin, MANY); -EXFUN (Fminus, MANY); -EXFUN (Fnarrow_to_region, 3); -EXFUN (Fnconc, MANY); -EXFUN (Fnext_event, 2); -EXFUN (Fnreverse, 1); -EXFUN (Fnthcdr, 2); -EXFUN (Fnumber_to_string, 1); -EXFUN (Fold_assq, 2); -EXFUN (Fold_equal, 2); -EXFUN (Fold_member, 2); -EXFUN (Fold_memq, 2); -EXFUN (Fplist_get, 3); -EXFUN (Fplist_member, 2); -EXFUN (Fplist_put, 3); -EXFUN (Fplus, MANY); -EXFUN (Fpoint, 1); -EXFUN (Fpoint_marker, 2); -EXFUN (Fpoint_max, 1); -EXFUN (Fpoint_min, 1); -EXFUN (Fpreceding_char, 1); -EXFUN (Fprefix_numeric_value, 1); -EXFUN (Fprin1, 2); -EXFUN (Fprin1_to_string, 2); -EXFUN (Fprinc, 2); -EXFUN (Fprint, 2); -EXFUN (Fprocess_status, 1); -EXFUN (Fprogn, UNEVALLED); -EXFUN (Fprovide, 1); -EXFUN (Fput, 3); -EXFUN (Fput_range_table, 4); -EXFUN (Fput_text_property, 5); -EXFUN (Fquo, MANY); -EXFUN (Frassq, 2); -EXFUN (Fread, 1); -EXFUN (Fread_key_sequence, 3); -EXFUN (Freally_free, 1); -EXFUN (Frem, 2); -EXFUN (Fremassq, 2); -EXFUN (Freplace_list, 2); -EXFUN (Frunning_temacs_p, 0); -EXFUN (Fselected_frame, 1); -EXFUN (Fset, 2); -EXFUN (Fset_default, 2); -EXFUN (Fset_marker, 3); -EXFUN (Fset_standard_case_table, 1); -EXFUN (Fsetcar, 2); -EXFUN (Fsetcdr, 2); -EXFUN (Fsignal, 2); -EXFUN (Fsit_for, 2); -EXFUN (Fskip_chars_backward, 3); -EXFUN (Fskip_chars_forward, 3); -EXFUN (Fsleep_for, 1); -EXFUN (Fsort, 2); -EXFUN (Fspecifier_spec_list, 4); -EXFUN (Fstring_equal, 2); -EXFUN (Fstring_lessp, 2); -EXFUN (Fstring_match, 4); -EXFUN (Fsub1, 1); -EXFUN (Fsubr_max_args, 1); -EXFUN (Fsubr_min_args, 1); -EXFUN (Fsubstitute_command_keys, 1); -EXFUN (Fsubstitute_in_file_name, 1); -EXFUN (Fsubstring, 3); -EXFUN (Fsymbol_function, 1); -EXFUN (Fsymbol_name, 1); -EXFUN (Fsymbol_plist, 1); -EXFUN (Fsymbol_value, 1); -EXFUN (Fsystem_name, 0); -EXFUN (Fthrow, 2); -EXFUN (Ftimes, MANY); -EXFUN (Ftruncate, 1); -EXFUN (Fundo_boundary, 0); -EXFUN (Funhandled_file_name_directory, 1); -EXFUN (Funlock_buffer, 0); -EXFUN (Fupcase, 2); -EXFUN (Fupcase_initials, 2); -EXFUN (Fupcase_initials_region, 3); -EXFUN (Fupcase_region, 3); -EXFUN (Fuser_home_directory, 0); -EXFUN (Fuser_login_name, 1); -EXFUN (Fvector, MANY); -EXFUN (Fverify_visited_file_modtime, 1); -EXFUN (Fvertical_motion, 3); -EXFUN (Fwiden, 1); - /*--------------- prototypes for constant symbols ------------*/ +/* #### We should get rid of this and put the prototypes back up there in + #### the per-file stuff, where they belong. */ + /* Use the following when you have to add a bunch of symbols. */ /* @@ -4642,6 +4747,9 @@ /*--------------- prototypes for variables of type Lisp_Object ------------*/ +/* #### We should get rid of this and put the prototypes back up there in + #### the per-file stuff, where they belong. */ + extern Lisp_Object Vactivate_menubar_hook; extern Lisp_Object Vautoload_queue, Vblank_menubar; extern Lisp_Object Vcommand_history;
--- a/src/lread.c Thu May 02 14:35:32 2002 +0000 +++ b/src/lread.c Sun May 05 11:33:57 2002 +0000 @@ -1464,7 +1464,7 @@ } #if 0 -xxDEFUN ("eval-current-buffer", Feval_current_buffer, 0, 1, "", /* +DEFUN ("eval-current-buffer", Feval_current_buffer, 0, 1, "", /* Execute the current buffer as Lisp code. Programs can pass argument PRINTFLAG which controls printing of output: nil means discard it; anything else is stream for print.
--- a/src/lrecord.h Thu May 02 14:35:32 2002 +0000 +++ b/src/lrecord.h Sun May 05 11:33:57 2002 +0000 @@ -843,10 +843,10 @@ # define DECLARE_LRECORD(c_name, structtype) \ extern const struct lrecord_implementation lrecord_##c_name; \ -INLINE_HEADER structtype * \ -error_check_##c_name (Lisp_Object obj, const char *file, int line); \ -INLINE_HEADER structtype * \ +DECLARE_INLINE_HEADER ( \ +structtype * \ error_check_##c_name (Lisp_Object obj, const char *file, int line) \ +) \ { \ assert_at_line (RECORD_TYPEP (obj, lrecord_type_##c_name), file, line); \ return (structtype *) XPNTR (obj); \ @@ -856,10 +856,10 @@ # define DECLARE_EXTERNAL_LRECORD(c_name, structtype) \ extern int lrecord_type_##c_name; \ extern struct lrecord_implementation lrecord_##c_name; \ -INLINE_HEADER structtype * \ -error_check_##c_name (Lisp_Object obj, const char *file, int line); \ -INLINE_HEADER structtype * \ +DECLARE_INLINE_HEADER ( \ +structtype * \ error_check_##c_name (Lisp_Object obj, const char *file, int line) \ +) \ { \ assert_at_line (RECORD_TYPEP (obj, lrecord_type_##c_name), file, line); \ return (structtype *) XPNTR (obj); \ @@ -867,10 +867,10 @@ extern Lisp_Object Q##c_name##p # define DECLARE_NONRECORD(c_name, type_enum, structtype) \ -INLINE_HEADER structtype * \ -error_check_##c_name (Lisp_Object obj, const char *file, int line); \ -INLINE_HEADER structtype * \ +DECLARE_INLINE_HEADER ( \ +structtype * \ error_check_##c_name (Lisp_Object obj, const char *file, int line) \ +) \ { \ assert_at_line (XTYPE (obj) == type_enum, file, line); \ return (structtype *) XPNTR (obj); \ @@ -882,11 +882,11 @@ # define XNONRECORD(x, c_name, type_enum, structtype) \ error_check_##c_name (x, __FILE__, __LINE__) -INLINE_HEADER Lisp_Object wrap_record_1 (const void *ptr, enum lrecord_type ty, - const char *file, int line); -INLINE_HEADER Lisp_Object +DECLARE_INLINE_HEADER ( +Lisp_Object wrap_record_1 (const void *ptr, enum lrecord_type ty, const char *file, int line) +) { Lisp_Object obj = wrap_pointer_1 (ptr); @@ -959,6 +959,9 @@ dead_wrong_type_argument (predicate, x); \ } while (0) +/* Various ways of allocating lcrecords. All bytes (except lcrecord + header) are zeroed in returned structure. */ + void *alloc_lcrecord (Bytecount size, const struct lrecord_implementation *);
--- a/src/lstream.c Thu May 02 14:35:32 2002 +0000 +++ b/src/lstream.c Sun May 05 11:33:57 2002 +0000 @@ -104,8 +104,8 @@ inline static Bytecount aligned_sizeof_lstream (Bytecount lstream_type_specific_size) { - return ALIGN_SIZE (offsetof (Lstream, data) + lstream_type_specific_size, - ALIGNOF (max_align_t)); + return MAX_ALIGN_SIZE (offsetof (Lstream, data) + + lstream_type_specific_size); } static Bytecount @@ -308,13 +308,13 @@ const unsigned char *dataend = data + size - 1; assert (size > 0); /* safety check ... */ /* Optimize the most common case. */ - if (!BYTE_ASCII_P (*dataend)) + if (!byte_ascii_p (*dataend)) { /* Go back to the beginning of the last (and possibly partial) character, and bump forward to see if the character is complete. */ VALIDATE_CHARPTR_BACKWARD (dataend); - if (dataend + REP_BYTES_BY_FIRST_BYTE (*dataend) != data + size) + if (dataend + rep_bytes_by_first_byte (*dataend) != data + size) /* If not, chop the size down to ignore the last char and stash it away for next time. */ size = dataend - data; @@ -1586,7 +1586,7 @@ static Lisp_Object make_lisp_buffer_stream_1 (struct buffer *buf, Charbpos start, Charbpos end, - int flags, const char *mode) + int flags, const Char_ASCII *mode) { Lstream *lstr; struct lisp_buffer_stream *str; @@ -1648,8 +1648,8 @@ } Lisp_Object -make_lisp_buffer_input_stream (struct buffer *buf, Charbpos start, Charbpos end, - int flags) +make_lisp_buffer_input_stream (struct buffer *buf, Charbpos start, + Charbpos end, int flags) { return make_lisp_buffer_stream_1 (buf, start, end, flags, "r"); } @@ -1664,66 +1664,47 @@ } static Bytecount -lisp_buffer_reader (Lstream *stream, unsigned char *data, - Bytecount size) +lisp_buffer_reader (Lstream *stream, Intbyte *data, Bytecount size) { struct lisp_buffer_stream *str = LISP_BUFFER_STREAM_DATA (stream); - unsigned char *orig_data = data; + Intbyte *orig_data = data; Bytebpos start; Bytebpos end; struct buffer *buf = XBUFFER (str->buffer); + Bytecount src_used; if (!BUFFER_LIVE_P (buf)) return 0; /* Fut. */ - /* NOTE: We do all our operations in Bytebpos's. - Keep in mind that SIZE is a value in bytes, not chars. */ - - start = bi_marker_position (str->start); - end = bi_marker_position (str->end); + start = byte_marker_position (str->start); + end = byte_marker_position (str->end); if (!(str->flags & LSTR_IGNORE_ACCESSIBLE)) { - start = bytebpos_clip_to_bounds (BI_BUF_BEGV (buf), start, - BI_BUF_ZV (buf)); - end = bytebpos_clip_to_bounds (BI_BUF_BEGV (buf), end, - BI_BUF_ZV (buf)); + start = bytebpos_clip_to_bounds (BYTE_BUF_BEGV (buf), start, + BYTE_BUF_ZV (buf)); + end = bytebpos_clip_to_bounds (BYTE_BUF_BEGV (buf), end, + BYTE_BUF_ZV (buf)); } - size = min (size, (Bytecount) (end - start)); - end = start + size; - /* We cannot return a partial character. */ - VALIDATE_BYTEBPOS_BACKWARD (buf, end); - - while (start < end) - { - Bytebpos ceil; - Bytecount chunk; - - if (str->flags & LSTR_IGNORE_ACCESSIBLE) - ceil = BI_BUF_CEILING_OF_IGNORE_ACCESSIBLE (buf, start); - else - ceil = BI_BUF_CEILING_OF (buf, start); - chunk = min (ceil, end) - start; - memcpy (data, BI_BUF_BYTE_ADDRESS (buf, start), chunk); - data += chunk; - start += chunk; - } + size = copy_buffer_text_out (buf, start, end - start, data, size, + FORMAT_DEFAULT, Qnil, &src_used); + end = start + src_used; if (EQ (buf->selective_display, Qt) && str->flags & LSTR_SELECTIVE) { /* What a kludge. What a kludge. What a kludge. */ - unsigned char *p; + Intbyte *p; for (p = orig_data; p < data; p++) if (*p == '\r') *p = '\n'; } - set_bi_marker_position (str->start, end); - return data - orig_data; + set_byte_marker_position (str->start, end); + return size; } static Bytecount -lisp_buffer_writer (Lstream *stream, const unsigned char *data, +lisp_buffer_writer (Lstream *stream, const Intbyte *data, Bytecount size) { struct lisp_buffer_stream *str = LISP_BUFFER_STREAM_DATA (stream);
--- a/src/lstream.h Thu May 02 14:35:32 2002 +0000 +++ b/src/lstream.h Sun May 05 11:33:57 2002 +0000 @@ -248,12 +248,11 @@ ((lstr)->imp == lstream_##type) #ifdef ERROR_CHECK_TYPES -INLINE_HEADER struct lstream * -error_check_lstream_type (struct lstream *stream, - const Lstream_implementation *imp); -INLINE_HEADER struct lstream * +DECLARE_INLINE_HEADER ( +struct lstream * error_check_lstream_type (struct lstream *stream, const Lstream_implementation *imp) +) { assert (stream->imp == imp); return stream; @@ -361,12 +360,13 @@ #ifdef MULE -INLINE_HEADER Emchar Lstream_get_emchar (Lstream *stream); -INLINE_HEADER Emchar +DECLARE_INLINE_HEADER ( +Emchar Lstream_get_emchar (Lstream *stream) +) { int c = Lstream_getc (stream); - return (c < 0x80 /* c == EOF || BYTE_ASCII_P (c) */ + return (c < 0x80 /* c == EOF || byte_ascii_p (c) */ ? (Emchar) c : Lstream_get_emchar_1 (stream, c)); } @@ -374,20 +374,22 @@ /* Write an Emchar to a stream. Return value is 0 for success, -1 for failure. */ -INLINE_HEADER int Lstream_put_emchar (Lstream *stream, Emchar ch); -INLINE_HEADER int +DECLARE_INLINE_HEADER ( +int Lstream_put_emchar (Lstream *stream, Emchar ch) +) { - return CHAR_ASCII_P (ch) ? + return emchar_ascii_p (ch) ? Lstream_putc (stream, ch) : Lstream_fput_emchar (stream, ch); } -INLINE_HEADER void Lstream_unget_emchar (Lstream *stream, Emchar ch); -INLINE_HEADER void +DECLARE_INLINE_HEADER ( +void Lstream_unget_emchar (Lstream *stream, Emchar ch) +) { - if (CHAR_ASCII_P (ch)) + if (emchar_ascii_p (ch)) Lstream_ungetc (stream, ch); else Lstream_funget_emchar (stream, ch);
--- a/src/marker.c Thu May 02 14:35:32 2002 +0000 +++ b/src/marker.c Sun May 05 11:33:57 2002 +0000 @@ -61,14 +61,17 @@ if (print_readably) printing_unreadable_object ("#<marker 0x%lx>", (long) marker); - write_c_string (GETTEXT ("#<marker "), printcharfun); + write_c_string (printcharfun, GETTEXT ("#<marker ")); if (!marker->buffer) - write_c_string (GETTEXT ("in no buffer"), printcharfun); + write_c_string (printcharfun, GETTEXT ("in no buffer")); else { - write_fmt_string (printcharfun, "at %ld in ", (long) marker_position (obj)); + write_fmt_string (printcharfun, "at %ld in ", + (long) marker_position (obj)); print_internal (marker->buffer->name, printcharfun, 0); } + if (marker->insertion_type) + write_c_string (printcharfun, " insertion-type=t"); write_fmt_string (printcharfun, " 0x%lx>", (long) marker); } @@ -316,7 +319,7 @@ } Bytebpos -bi_marker_position (Lisp_Object marker) +byte_marker_position (Lisp_Object marker) { Lisp_Marker *m = XMARKER (marker); struct buffer *buf = m->buffer; @@ -334,7 +337,7 @@ pos = membpos_to_bytebpos (buf, m->membpos); #ifdef ERROR_CHECK_TEXT - if (pos < BI_BUF_BEG (buf) || pos > BI_BUF_Z (buf)) + if (pos < BYTE_BUF_BEG (buf) || pos > BYTE_BUF_Z (buf)) abort (); #endif @@ -349,11 +352,11 @@ if (!buf) invalid_argument ("Marker does not point anywhere", Qunbound); - return bytebpos_to_charbpos (buf, bi_marker_position (marker)); + return bytebpos_to_charbpos (buf, byte_marker_position (marker)); } void -set_bi_marker_position (Lisp_Object marker, Bytebpos pos) +set_byte_marker_position (Lisp_Object marker, Bytebpos pos) { Lisp_Marker *m = XMARKER (marker); struct buffer *buf = m->buffer; @@ -362,7 +365,7 @@ invalid_argument ("Marker does not point anywhere", Qunbound); #ifdef ERROR_CHECK_TEXT - if (pos < BI_BUF_BEG (buf) || pos > BI_BUF_Z (buf)) + if (pos < BYTE_BUF_BEG (buf) || pos > BYTE_BUF_Z (buf)) abort (); #endif @@ -377,7 +380,7 @@ if (!buf) invalid_argument ("Marker does not point anywhere", Qunbound); - set_bi_marker_position (marker, charbpos_to_bytebpos (buf, pos)); + set_byte_marker_position (marker, charbpos_to_bytebpos (buf, pos)); } static Lisp_Object @@ -457,7 +460,7 @@ it by default (although I've debugged it). If you want to use it, use extents instead. --hniksic */ #if 0 -xxDEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, 1, 1, 0, /* +DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, 1, 1, 0, /* Return t if there are markers pointing at POSITION in the current buffer. */ (position))
--- a/src/menubar-gtk.c Thu May 02 14:35:32 2002 +0000 +++ b/src/menubar-gtk.c Sun May 05 11:33:57 2002 +0000 @@ -206,7 +206,7 @@ Lisp_Object menu_desc = Qnil; GtkWidget *old_submenu = GTK_MENU_ITEM (menu_item)->submenu; - VOID_TO_LISP (menu_desc, gtk_object_get_data (GTK_OBJECT (menu_item), XEMACS_MENU_DESCR_TAG)); + menu_desc = VOID_TO_LISP (gtk_object_get_data (GTK_OBJECT (menu_item), XEMACS_MENU_DESCR_TAG)); /* GCPRO all of our very own */ gcpro_popup_callbacks (id, menu_desc); @@ -271,7 +271,7 @@ return; } - VOID_TO_LISP (desc, gtk_object_get_data (GTK_OBJECT (item), XEMACS_MENU_DESCR_TAG)); + desc = VOID_TO_LISP (gtk_object_get_data (GTK_OBJECT (item), XEMACS_MENU_DESCR_TAG)); #ifdef TEAR_OFF_MENUS /* Lets stick in a detacher just for giggles */ @@ -290,7 +290,7 @@ Lisp_Object hook_fn; struct gcpro gcpro1, gcpro2; - VOID_TO_LISP (hook_fn, gtk_object_get_data (GTK_OBJECT (item), XEMACS_MENU_FILTER_TAG)); + hook_fn = VOID_TO_LISP (gtk_object_get_data (GTK_OBJECT (item), XEMACS_MENU_FILTER_TAG)); GCPRO2 (desc, hook_fn); @@ -566,7 +566,7 @@ channel = wrap_frame (__get_channel (GTK_WIDGET (item))); - VOID_TO_LISP (callback, user_data); + callback = VOID_TO_LISP (user_data); get_gui_callback (callback, &function, &data);
--- a/src/menubar-msw.c Thu May 02 14:35:32 2002 +0000 +++ b/src/menubar-msw.c Sun May 05 11:33:57 2002 +0000 @@ -2,7 +2,7 @@ Copyright (C) 1993, 1994 Free Software Foundation, Inc. Copyright (C) 1995 Tinker Systems and INS Engineering Corp. Copyright (C) 1997 Kirill M. Katsnelson <kkm@kis.ru>. - Copyright (C) 2000, 2001 Ben Wing. + Copyright (C) 2000, 2001, 2002 Ben Wing. This file is part of XEmacs.
--- a/src/menubar-x.c Thu May 02 14:35:32 2002 +0000 +++ b/src/menubar-x.c Sun May 05 11:33:57 2002 +0000 @@ -448,7 +448,7 @@ widget_value *wv; assert (hack_wv->type == INCREMENTAL_TYPE); - VOID_TO_LISP (submenu_desc, hack_wv->call_data); + submenu_desc = VOID_TO_LISP (hack_wv->call_data); /* * #### Fix the menu code so this isn't necessary. @@ -994,7 +994,7 @@ i++; write_fmt_string (Qexternal_debugging_output, "OPERATE (%d): ",i); print_internal (t, Qexternal_debugging_output, 1); - write_c_string ("\n", Qexternal_debugging_output); + write_c_string (Qexternal_debugging_output, "\n"); t = XEVENT_NEXT (t); } } @@ -1027,7 +1027,7 @@ while (entries) { Lisp_Object accel; - VOID_TO_LISP (accel, entries->accel); + accel = VOID_TO_LISP (entries->accel); if (entries->name && !NILP (accel)) { if (event_matches_key_specifier_p (XEVENT (evee), accel)) @@ -1260,7 +1260,7 @@ while (val) { Lisp_Object accel; - VOID_TO_LISP (accel, val->accel); + accel = VOID_TO_LISP (val->accel); if (val->name && !NILP (accel)) { Fsetcar (last, accel);
--- a/src/menubar.c Thu May 02 14:35:32 2002 +0000 +++ b/src/menubar.c Sun May 05 11:33:57 2002 +0000 @@ -1,7 +1,7 @@ /* Implements an elisp-programmable menubar. Copyright (C) 1993, 1994 Free Software Foundation, Inc. Copyright (C) 1995 Tinker Systems and INS Engineering Corp. - Copyright (C) 2001 Ben Wing. + Copyright (C) 2001, 2002 Ben Wing. This file is part of XEmacs. @@ -339,7 +339,7 @@ CHECK_STRING (name); - end = XSTRING_CHAR_LENGTH (name); + end = string_char_length (name); name_data = XSTRING_DATA (name); string_result = (Intbyte *) alloca (end * MAX_EMCHAR_LEN);
--- a/src/minibuf.c Thu May 02 14:35:32 2002 +0000 +++ b/src/minibuf.c Sun May 05 11:33:57 2002 +0000 @@ -298,8 +298,8 @@ To do so, there should probably be a map_obarray_or_alist_or_hash_table function which would be used by - both Ftry_completion and Fall_completions. But would the - additional funcalls slow things down? */ + both Ftry_completion and Fall_completions. [[ But would the + additional funcalls slow things down? ]] Seriously doubtful. --ben */ DEFUN ("try-completion", Ftry_completion, 2, 3, 0, /* Return common substring of all completions of STRING in COLLECTION. @@ -355,7 +355,7 @@ bestmatch = Qnil; blength = 0; - slength = XSTRING_CHAR_LENGTH (string); + slength = string_char_length (string); /* If COLLECTION is not a list, set TAIL just for gc pro. */ tail = collection; @@ -418,7 +418,7 @@ if (STRINGP (eltstring)) { - Charcount eltlength = XSTRING_CHAR_LENGTH (eltstring); + Charcount eltlength = string_char_length (eltstring); if (slength <= eltlength && (0 > scmp (XSTRING_DATA (eltstring), XSTRING_DATA (string), @@ -562,7 +562,7 @@ return call3 (collection, string, predicate, Qt); allmatches = Qnil; - slength = XSTRING_CHAR_LENGTH (string); + slength = string_char_length (string); /* If COLLECTION is not a list, set TAIL just for gc pro. */ tail = collection; @@ -618,12 +618,12 @@ /* Is this element a possible completion? */ if (STRINGP (eltstring) - && (slength <= XSTRING_CHAR_LENGTH (eltstring)) + && (slength <= string_char_length (eltstring)) /* Reject alternatives that start with space unless the input starts with space. */ - && ((XSTRING_CHAR_LENGTH (string) > 0 && - XSTRING_CHAR (string, 0) == ' ') - || XSTRING_CHAR (eltstring, 0) != ' ') + && ((string_char_length (string) > 0 && + string_emchar (string, 0) == ' ') + || string_emchar (eltstring, 0) != ' ') && (0 > scmp (XSTRING_DATA (eltstring), XSTRING_DATA (string), slength))) @@ -649,7 +649,7 @@ implement some braindamage in FSF which we aren't including. --cet */ #if 0 -xxDEFUN ("minibuffer-prompt", Fminibuffer_prompt, 0, 0, 0, /* +DEFUN ("minibuffer-prompt", Fminibuffer_prompt, 0, 0, 0, /* Return the prompt string of the currently-active minibuffer. If no minibuffer is active, return nil. */ @@ -658,7 +658,7 @@ return Fcopy_sequence (Vminibuf_prompt); } -xxDEFUN ("minibuffer-prompt-width", Fminibuffer_prompt_width, 0, 0, 0, /* +DEFUN ("minibuffer-prompt-width", Fminibuffer_prompt_width, 0, 0, 0, /* Return the display width of the minibuffer prompt. */ ()) @@ -756,7 +756,7 @@ { if (STRINGP (reloc)) nonreloc = XSTRING_DATA (reloc); - write_string_1 (nonreloc + offset, length, Qexternal_debugging_output); + write_string_1 (Qexternal_debugging_output, nonreloc + offset, length); } }
--- a/src/mule-ccl.c Thu May 02 14:35:32 2002 +0000 +++ b/src/mule-ccl.c Sun May 05 11:33:57 2002 +0000 @@ -1,5 +1,6 @@ /* CCL (Code Conversion Language) interpreter. Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN. + Copyright (C) 2002 Ben Wing. Licensed to the Free Software Foundation. This file is part of XEmacs. @@ -735,7 +736,7 @@ } \ else \ { \ - if (!CHAR_MULTIBYTE_P(ch)) \ + if (!emchar_multibyte_p(ch)) \ { \ Dynarr_add (destination, ch); \ } \ @@ -793,7 +794,7 @@ { \ ch = ((XINT (ccl_prog[ic + (i / 3)])) \ >> ((2 - (i % 3)) * 8)) & 0xFF; \ - if (!CHAR_MULTIBYTE_P(ch)) \ + if (!emchar_multibyte_p(ch)) \ { \ Dynarr_add (destination, ch); \ } \ @@ -827,7 +828,7 @@ /* Set C to the character code made from CHARSET and CODE. This is - like MAKE_CHAR but check the validity of CHARSET and CODE. If they + like make_emchar but check the validity of CHARSET and CODE. If they are not valid, set C to (CODE & 0xFF) because that is usually the case that CCL_ReadMultibyteChar2 read an invalid code and it set CODE to that invalid byte. */ @@ -847,7 +848,7 @@ \ if ((code) >= 256) \ c2 = c1, c1 = ((code) >> 7) & 0x7F; \ - (c) = MAKE_CHAR (charset, c1, c2); \ + (c) = make_emchar (charset, c1, c2); \ } \ else \ (c) = (code) & 0xFF; \ @@ -1350,7 +1351,7 @@ i = reg[RRR]; /* charset */ if (i == LEADING_BYTE_ASCII) i = reg[rrr] & 0xFF; - else if (XCHARSET_DIMENSION (CHARSET_BY_LEADING_BYTE (i)) == 1) + else if (XCHARSET_DIMENSION (charset_by_leading_byte (i)) == 1) i = (((i - FIELD2_TO_OFFICIAL_LEADING_BYTE) << 7) | (reg[rrr] & 0x7F)); else if (i < MAX_LEADING_BYTE_OFFICIAL_2)
--- a/src/mule-charset.c Thu May 02 14:35:32 2002 +0000 +++ b/src/mule-charset.c Sun May 05 11:33:57 2002 +0000 @@ -591,7 +591,7 @@ else type = (chars == 94) ? CHARSET_TYPE_94X94 : CHARSET_TYPE_96X96; - existing_charset = CHARSET_BY_ATTRIBUTES (type, final, direction); + existing_charset = charset_by_attributes (type, final, direction); if (!NILP (existing_charset) && !XCHARSET (existing_charset)->temporary) invalid_argument @@ -632,7 +632,7 @@ { Lisp_Object revdircs = - CHARSET_BY_ATTRIBUTES (type, final, + charset_by_attributes (type, final, direction == CHARSET_LEFT_TO_RIGHT ? CHARSET_RIGHT_TO_LEFT : CHARSET_LEFT_TO_RIGHT); if (!NILP (revdircs)) @@ -752,12 +752,12 @@ if (di == -1) { - obj = CHARSET_BY_ATTRIBUTES (type, fi, CHARSET_LEFT_TO_RIGHT); + obj = charset_by_attributes (type, fi, CHARSET_LEFT_TO_RIGHT); if (NILP (obj)) - obj = CHARSET_BY_ATTRIBUTES (type, fi, CHARSET_RIGHT_TO_LEFT); + obj = charset_by_attributes (type, fi, CHARSET_RIGHT_TO_LEFT); } else - obj = CHARSET_BY_ATTRIBUTES (type, fi, di); + obj = charset_by_attributes (type, fi, di); if (CHARSETP (obj)) return XCHARSET_NAME (obj);
--- a/src/mule-coding.c Thu May 02 14:35:32 2002 +0000 +++ b/src/mule-coding.c Sun May 05 11:33:57 2002 +0000 @@ -76,16 +76,25 @@ /* Is this the first byte of a Shift-JIS two-byte char? */ -#define BYTE_SHIFT_JIS_TWO_BYTE_1_P(c) \ - (((c) >= 0x81 && (c) <= 0x9F) || ((c) >= 0xE0 && (c) <= 0xEF)) +inline static int +byte_shift_jis_two_byte_1_p (int c) +{ + return (c >= 0x81 && c <= 0x9F) || (c >= 0xE0 && c <= 0xEF); +} /* Is this the second byte of a Shift-JIS two-byte char? */ -#define BYTE_SHIFT_JIS_TWO_BYTE_2_P(c) \ - (((c) >= 0x40 && (c) <= 0x7E) || ((c) >= 0x80 && (c) <= 0xFC)) - -#define BYTE_SHIFT_JIS_KATAKANA_P(c) \ - ((c) >= 0xA1 && (c) <= 0xDF) +inline static int +byte_shift_jis_two_byte_2_p (int c) +{ + return (c >= 0x40 && c <= 0x7E) || (c >= 0x80 && c <= 0xFC); +} + +inline static int +byte_shift_jis_katakana_p (int c) +{ + return c >= 0xA1 && c <= 0xDF; +} /* Convert Shift-JIS data to internal format. */ @@ -105,7 +114,7 @@ if (ch) { /* Previous character was first byte of Shift-JIS Kanji char. */ - if (BYTE_SHIFT_JIS_TWO_BYTE_2_P (c)) + if (byte_shift_jis_two_byte_2_p (c)) { Intbyte e1, e2; @@ -123,9 +132,9 @@ } else { - if (BYTE_SHIFT_JIS_TWO_BYTE_1_P (c)) + if (byte_shift_jis_two_byte_1_p (c)) ch = c; - else if (BYTE_SHIFT_JIS_KATAKANA_P (c)) + else if (byte_shift_jis_katakana_p (c)) { Dynarr_add (dst, LEADING_BYTE_KATAKANA_JISX0201); Dynarr_add (dst, c); @@ -143,12 +152,12 @@ while (n--) { Intbyte c = *src++; - if (BYTE_ASCII_P (c)) + if (byte_ascii_p (c)) { Dynarr_add (dst, c); ch = 0; } - else if (INTBYTE_LEADING_BYTE_P (c)) + else if (intbyte_leading_byte_p (c)) ch = (c == LEADING_BYTE_KATAKANA_JISX0201 || c == LEADING_BYTE_JAPANESE_JISX0208_1978 || c == LEADING_BYTE_JAPANESE_JISX0208) ? c : 0; @@ -193,11 +202,11 @@ CHECK_INT (XCDR (code)); s1 = XINT (XCAR (code)); s2 = XINT (XCDR (code)); - if (BYTE_SHIFT_JIS_TWO_BYTE_1_P (s1) && - BYTE_SHIFT_JIS_TWO_BYTE_2_P (s2)) + if (byte_shift_jis_two_byte_1_p (s1) && + byte_shift_jis_two_byte_2_p (s2)) { DECODE_SHIFT_JIS (s1, s2, c1, c2); - return make_char (MAKE_CHAR (Vcharset_japanese_jisx0208, + return make_char (make_emchar (Vcharset_japanese_jisx0208, c1 & 0x7F, c2 & 0x7F)); } else @@ -214,7 +223,7 @@ int c1, c2, s1, s2; CHECK_CHAR_COERCE_INT (character); - BREAKUP_CHAR (XCHAR (character), charset, c1, c2); + BREAKUP_EMCHAR (XCHAR (character), charset, c1, c2); if (EQ (charset, Vcharset_japanese_jisx0208)) { ENCODE_SHIFT_JIS (c1 | 0x80, c2 | 0x80, s1, s2); @@ -336,13 +345,19 @@ contains frequently used characters and the latter contains less frequently used characters. */ -#define BYTE_BIG5_TWO_BYTE_1_P(c) \ - ((c) >= 0xA1 && (c) <= 0xFE) +inline static int +byte_big5_two_byte_1_p (int c) +{ + return c >= 0xA1 && c <= 0xFE; +} /* Is this the second byte of a Shift-JIS two-byte char? */ -#define BYTE_BIG5_TWO_BYTE_2_P(c) \ - (((c) >= 0x40 && (c) <= 0x7E) || ((c) >= 0xA1 && (c) <= 0xFE)) +inline static int +byte_big5_two_byte_2_p (int c) +{ + return (c >= 0x40 && c <= 0x7E) || (c >= 0xA1 && c <= 0xFE); +} /* Number of Big5 characters which have the same code in 1st byte. */ @@ -434,7 +449,7 @@ if (ch) { /* Previous character was first byte of Big5 char. */ - if (BYTE_BIG5_TWO_BYTE_2_P (c)) + if (byte_big5_two_byte_2_p (c)) { Intbyte b1, b2, b3; DECODE_BIG5 (ch, c, b1, b2, b3); @@ -451,7 +466,7 @@ } else { - if (BYTE_BIG5_TWO_BYTE_1_P (c)) + if (byte_big5_two_byte_1_p (c)) ch = c; else DECODE_ADD_BINARY_CHAR (c, dst); @@ -466,12 +481,12 @@ while (n--) { Intbyte c = *src++; - if (BYTE_ASCII_P (c)) + if (byte_ascii_p (c)) { /* ASCII. */ Dynarr_add (dst, c); } - else if (INTBYTE_LEADING_BYTE_P (c)) + else if (intbyte_leading_byte_p (c)) { if (c == LEADING_BYTE_CHINESE_BIG5_1 || c == LEADING_BYTE_CHINESE_BIG5_2) @@ -510,16 +525,16 @@ Emchar decode_big5_char (int b1, int b2) { - if (BYTE_BIG5_TWO_BYTE_1_P (b1) && - BYTE_BIG5_TWO_BYTE_2_P (b2)) + if (byte_big5_two_byte_1_p (b1) && + byte_big5_two_byte_2_p (b2)) { int leading_byte; Lisp_Object charset; int c1, c2; DECODE_BIG5 (b1, b2, leading_byte, c1, c2); - charset = CHARSET_BY_LEADING_BYTE (leading_byte); - return MAKE_CHAR (charset, c1 & 0x7F, c2 & 0x7F); + charset = charset_by_leading_byte (leading_byte); + return make_emchar (charset, c1 & 0x7F, c2 & 0x7F); } else return -1; @@ -561,7 +576,7 @@ int c1, c2, b1, b2; CHECK_CHAR_COERCE_INT (character); - BREAKUP_CHAR (XCHAR (character), charset, c1, c2); + BREAKUP_EMCHAR (XCHAR (character), charset, c1, c2); if (EQ (charset, Vcharset_chinese_big5_1) || EQ (charset, Vcharset_chinese_big5_2)) { @@ -1210,7 +1225,7 @@ static Lisp_Object charset_by_attributes_or_create_one (int type, Intbyte final, int dir) { - Lisp_Object charset = CHARSET_BY_ATTRIBUTES (type, final, dir); + Lisp_Object charset = charset_by_attributes (type, final, dir); if (NILP (charset)) { @@ -1801,7 +1816,7 @@ { Intbyte comstr[MAX_EMCHAR_LEN]; Bytecount len; - Emchar emch = MAKE_CHAR (Vcharset_composite, c - '0' + ' ', + Emchar emch = make_emchar (Vcharset_composite, c - '0' + ' ', 0); len = set_charptr_emchar (comstr, emch); Dynarr_add_many (dst, comstr, len); @@ -1845,7 +1860,7 @@ } ch = 0; } - else if (BYTE_C0_P (c) || BYTE_C1_P (c)) + else if (byte_c0_p (c) || byte_c1_p (c)) { /* Control characters */ /***** Error-handling *****/ @@ -1885,7 +1900,7 @@ /* Now determine the charset. */ reg = ((flags & ISO_STATE_SS2) ? 2 : (flags & ISO_STATE_SS3) ? 3 - : !BYTE_ASCII_P (c) ? data->register_right + : !byte_ascii_p (c) ? data->register_right : data->register_left); charset = data->charset[reg]; @@ -2121,7 +2136,7 @@ { c = *src++; - if (BYTE_ASCII_P (c)) + if (byte_ascii_p (c)) { /* Processing ASCII character */ ch = 0; @@ -2169,11 +2184,11 @@ char_boundary = 1; } - else if (INTBYTE_LEADING_BYTE_P (c) || INTBYTE_LEADING_BYTE_P (ch)) + else if (intbyte_leading_byte_p (c) || intbyte_leading_byte_p (ch)) { /* Processing Leading Byte */ ch = 0; - charset = CHARSET_BY_LEADING_BYTE (c); - if (LEADING_BYTE_PREFIX_P (c)) + charset = charset_by_leading_byte (c); + if (leading_byte_prefix_p (c)) ch = c; else if (!EQ (charset, Vcharset_control_1) && !EQ (charset, Vcharset_composite)) @@ -2318,7 +2333,7 @@ } else { - Emchar emch = MAKE_CHAR (Vcharset_composite, + Emchar emch = make_emchar (Vcharset_composite, ch & 0x7F, c & 0x7F); Lisp_Object lstr = composite_char_string (emch); saved_n = n; @@ -2650,16 +2665,16 @@ { int i; - write_c_string ("(", printcharfun); + write_c_string (printcharfun, "("); for (i = 0; i < 4; i++) { Lisp_Object charset = coding_system_charset (cs, i); if (i > 0) - write_c_string (", ", printcharfun); + write_c_string (printcharfun, ", "); write_fmt_string (printcharfun, "g%d=", i); print_internal (CHARSETP (charset) ? XCHARSET_NAME (charset) : charset, printcharfun, 0); if (XCODING_SYSTEM_ISO2022_FORCE_CHARSET_ON_OUTPUT (cs, i)) - write_c_string ("(force)", printcharfun); + write_c_string (printcharfun, "(force)"); } #define FROB(prop) \ @@ -2691,7 +2706,7 @@ { write_fmt_string_lisp (printcharfun, ", output-charset-conversion=%s", 1, val); } - write_c_string (")", printcharfun); + write_c_string (printcharfun, ")"); } } @@ -2785,7 +2800,7 @@ data->saw_single_shift_just_now = 0; } if (!(data->flags & ISO_STATE_ESCAPE) - && (BYTE_C0_P (c) || BYTE_C1_P (c))) + && (byte_c0_p (c) || byte_c1_p (c))) { /* control chars */ switch (c) { @@ -2807,8 +2822,8 @@ } } - if ((data->flags & ISO_STATE_ESCAPE) || BYTE_C0_P (c) - || BYTE_C1_P (c)) + if ((data->flags & ISO_STATE_ESCAPE) || byte_c0_p (c) + || byte_c1_p (c)) { switch (parse_iso2022_esc (Qnil, data->iso, c, &data->flags, 0))
--- a/src/mule-wnnfns.c Thu May 02 14:35:32 2002 +0000 +++ b/src/mule-wnnfns.c Sun May 05 11:33:57 2002 +0000 @@ -1981,7 +1981,7 @@ while ((ch = *mp++) != 0) { - if (INTBYTE_LEADING_BYTE_P (ch)) + if (intbyte_leading_byte_p (ch)) { switch (ch) { @@ -2009,7 +2009,7 @@ mp++; break; default: /* ignore this character */ - mp += REP_BYTES_BY_FIRST_BYTE(ch) - 1; + mp += rep_bytes_by_first_byte(ch) - 1; } } else
--- a/src/nas.c Thu May 02 14:35:32 2002 +0000 +++ b/src/nas.c Sun May 05 11:33:57 2002 +0000 @@ -165,9 +165,7 @@ if (setjmp (AuXtErrorJump)) { EMACS_SIGNAL (SIGPIPE, old_sigpipe); -#ifdef emacs start_interrupts (); -#endif return "error in NAS"; } #endif @@ -177,13 +175,9 @@ AuDefaultErrorHandler = CatchErrorAndJump; #endif -#ifdef emacs stop_interrupts (); -#endif aud = AuOpenServer (server, 0, NULL, 0, NULL, &err_message); -#ifdef emacs start_interrupts (); -#endif if (!aud) { #ifdef ROBUST_PLAY
--- a/src/objects-msw.c Thu May 02 14:35:32 2002 +0000 +++ b/src/objects-msw.c Sun May 05 11:33:57 2002 +0000 @@ -939,7 +939,7 @@ for (i = 1; i < qxestrlen (name); i++) { - if (!BYTE_ASCII_P (name[i]) || !isxdigit ((int) name[i])) + if (!byte_ascii_p (name[i]) || !isxdigit ((int) name[i])) return (COLORREF) -1; } if (qxestrlen (name) == 7) @@ -1910,14 +1910,14 @@ if (dim == 1) { for (i = lowlim; i <= highlim; i++) - if ((cp = char_to_unicode (MAKE_CHAR (charset, i, 0))) >= 0) + if ((cp = emchar_to_unicode (make_emchar (charset, i, 0))) >= 0) break; } else { for (i = lowlim; i <= highlim; i++) for (j = lowlim; j <= highlim; j++) - if ((cp = char_to_unicode (MAKE_CHAR (charset, i, j))) >= 0) + if ((cp = emchar_to_unicode (make_emchar (charset, i, j))) >= 0) break; }
--- a/src/objects-x.c Thu May 02 14:35:32 2002 +0000 +++ b/src/objects-x.c Sun May 05 11:33:57 2002 +0000 @@ -834,17 +834,17 @@ atom == DEVICE_XATOM_SPACING (d) || atom == DEVICE_XATOM_CHARSET_REGISTRY (d) || atom == DEVICE_XATOM_CHARSET_ENCODING (d) || - !intbyte_strcmp (name_str, "CHARSET_COLLECTIONS") || - !intbyte_strcmp (name_str, "FONTNAME_REGISTRY") || - !intbyte_strcmp (name_str, "CLASSIFICATION") || - !intbyte_strcmp (name_str, "COPYRIGHT") || - !intbyte_strcmp (name_str, "DEVICE_FONT_NAME") || - !intbyte_strcmp (name_str, "FULL_NAME") || - !intbyte_strcmp (name_str, "MONOSPACED") || - !intbyte_strcmp (name_str, "QUALITY") || - !intbyte_strcmp (name_str, "RELATIVE_SET") || - !intbyte_strcmp (name_str, "RELATIVE_WEIGHT") || - !intbyte_strcmp (name_str, "STYLE"))) + !qxestrcmp_c (name_str, "CHARSET_COLLECTIONS") || + !qxestrcmp_c (name_str, "FONTNAME_REGISTRY") || + !qxestrcmp_c (name_str, "CLASSIFICATION") || + !qxestrcmp_c (name_str, "COPYRIGHT") || + !qxestrcmp_c (name_str, "DEVICE_FONT_NAME") || + !qxestrcmp_c (name_str, "FULL_NAME") || + !qxestrcmp_c (name_str, "MONOSPACED") || + !qxestrcmp_c (name_str, "QUALITY") || + !qxestrcmp_c (name_str, "RELATIVE_SET") || + !qxestrcmp_c (name_str, "RELATIVE_WEIGHT") || + !qxestrcmp_c (name_str, "STYLE"))) { Extbyte *val_str = XGetAtomName (dpy, props [i].card32);
--- a/src/opaque.c Thu May 02 14:35:32 2002 +0000 +++ b/src/opaque.c Sun May 05 11:33:57 2002 +0000 @@ -55,8 +55,7 @@ inline static Bytecount aligned_sizeof_opaque (Bytecount opaque_size) { - return ALIGN_SIZE (offsetof (Lisp_Opaque, data) + opaque_size, - ALIGNOF (max_align_t)); + return MAX_ALIGN_SIZE (offsetof (Lisp_Opaque, data) + opaque_size); } static Bytecount
--- a/src/postgresql.c Thu May 02 14:35:32 2002 +0000 +++ b/src/postgresql.c Sun May 05 11:33:57 2002 +0000 @@ -220,7 +220,7 @@ if (print_readably) printing_unreadable_object ("%s", buf); else - write_c_string (buf, printcharfun); + write_c_string (printcharfun, buf); } static Lisp_PGconn * @@ -333,7 +333,7 @@ if (print_readably) printing_unreadable_object ("%s", buf); else - write_c_string (buf, printcharfun); + write_c_string (printcharfun, buf); } #undef RESULT_TUPLES_FMT
--- a/src/print.c Thu May 02 14:35:32 2002 +0000 +++ b/src/print.c Sun May 05 11:33:57 2002 +0000 @@ -416,7 +416,7 @@ { for (iii = ccoff; iii < cclen + ccoff; iii++) { - call1 (function, make_char (XSTRING_CHAR (reloc, iii))); + call1 (function, make_char (string_emchar (reloc, iii))); if (STRINGP (reloc)) newnonreloc = XSTRING_DATA (reloc); } @@ -526,10 +526,6 @@ } } -/* Used for printing a single-byte character (*not* any Emchar). */ -#define write_char_internal(string_of_length_1, stream) \ - output_string (stream, (const Intbyte *) (string_of_length_1), \ - Qnil, 0, 1) /* Write internal-format data to STREAM. See output_string() for interpretation of STREAM. @@ -544,7 +540,7 @@ canonicalize_printcharfun() (i.e. Qnil means stdout, not Vstandard_output, etc.) */ void -write_string_1 (const Intbyte *str, Bytecount size, Lisp_Object stream) +write_string_1 (Lisp_Object stream, const Intbyte *str, Bytecount size) { /* This function can GC */ #ifdef ERROR_CHECK_TEXT @@ -554,23 +550,23 @@ } void -write_string (const Intbyte *str, Lisp_Object stream) +write_string (Lisp_Object stream, const Intbyte *str) { /* This function can GC */ - write_string_1 (str, qxestrlen (str), stream); + write_string_1 (stream, str, qxestrlen (str)); } void -write_c_string (const CIntbyte *str, Lisp_Object stream) +write_c_string (Lisp_Object stream, const CIntbyte *str) { /* This function can GC */ - write_string_1 ((const Intbyte *) str, strlen (str), stream); + write_string_1 (stream, (const Intbyte *) str, strlen (str)); } void -write_eistring (const Eistring *ei, Lisp_Object stream) +write_eistring (Lisp_Object stream, const Eistring *ei) { - write_string_1 (eidata (ei), eilen (ei), stream); + write_string_1 (stream, eidata (ei), eilen (ei)); } /* Write a printf-style string to STREAM; see output_string(). */ @@ -587,7 +583,7 @@ str = emacs_vsprintf_malloc (fmt, va, &len); va_end (va); count = record_unwind_protect_freeing (str); - write_string_1 (str, len, stream); + write_string_1 (stream, str, len); unbind_to (count); } @@ -613,7 +609,7 @@ va_end (va); str = emacs_vsprintf_malloc_lisp (fmt, Qnil, nargs, args, &len); count = record_unwind_protect_freeing (str); - write_string_1 (str, len, stream); + write_string_1 (stream, str, len); unbind_to (count); } @@ -633,7 +629,7 @@ va_end (va); str = emacs_vsprintf_malloc_lisp (fmt, Qnil, nargs, args, &len); count = record_unwind_protect_freeing (str); - write_string_1 (str, len, Qexternal_debugging_output); + write_string_1 (Qexternal_debugging_output, str, len); unbind_to (count); } @@ -745,7 +741,7 @@ (stream)) { /* This function can GC */ - write_char_internal ("\n", canonicalize_printcharfun (stream)); + write_c_string (canonicalize_printcharfun (stream), "\n"); return Qt; } @@ -831,9 +827,9 @@ GCPRO2 (object, stream); stream = print_prepare (stream, &frame); - write_char_internal ("\n", stream); + write_c_string (stream, "\n"); print_internal (object, stream, 1); - write_char_internal ("\n", stream); + write_c_string (stream, "\n"); print_finish (stream, frame); UNGCPRO; return object; @@ -909,7 +905,7 @@ } while (!NILP (tail)) { - write_c_string (first ? ": " : ", ", stream); + write_c_string (stream, first ? ": " : ", "); /* Most errors have an explanatory string as their first argument, and it looks better not to put the quotes around it. */ print_internal (Fcar (tail), stream, @@ -929,7 +925,7 @@ error_throw: if (NILP (method)) { - write_c_string (GETTEXT ("Peculiar error "), stream); + write_c_string (stream, GETTEXT ("Peculiar error ")); print_internal (error_object, stream, 1); return; } @@ -1193,17 +1189,17 @@ if (max < len) last = max; } - write_c_string (start, printcharfun); + write_c_string (printcharfun, start); for (i = 0; i < last; i++) { Lisp_Object elt = XVECTOR_DATA (obj)[i]; - if (i != 0) write_char_internal (" ", printcharfun); + if (i != 0) write_c_string (printcharfun, " "); print_internal (elt, printcharfun, escapeflag); } UNGCPRO; if (last != len) - write_c_string (" ...", printcharfun); - write_c_string (end, printcharfun); + write_c_string (printcharfun, " ..."); + write_c_string (printcharfun, end); } void @@ -1224,14 +1220,14 @@ { obj = XCAR (XCDR (obj)); GCPRO2 (obj, printcharfun); - write_char_internal ("\'", printcharfun); + write_c_string (printcharfun, "\'"); UNGCPRO; print_internal (obj, printcharfun, escapeflag); return; } GCPRO2 (obj, printcharfun); - write_char_internal ("(", printcharfun); + write_c_string (printcharfun, "("); { int len; @@ -1244,20 +1240,20 @@ obj = XCDR (obj), len++) { if (len > 0) - write_char_internal (" ", printcharfun); + write_c_string (printcharfun, " "); if (EQ (obj, tortoise) && len > 0) { if (print_readably) printing_unreadable_object ("circular list"); else - write_c_string ("... <circular list>", printcharfun); + write_c_string (printcharfun, "... <circular list>"); break; } if (len & 1) tortoise = XCDR (tortoise); if (len > max) { - write_c_string ("...", printcharfun); + write_c_string (printcharfun, "..."); break; } print_internal (XCAR (obj), printcharfun, escapeflag); @@ -1265,12 +1261,12 @@ } if (!LISTP (obj)) { - write_c_string (" . ", printcharfun); + write_c_string (printcharfun, " . "); print_internal (obj, printcharfun, escapeflag); } UNGCPRO; - write_char_internal (")", printcharfun); + write_c_string (printcharfun, ")"); return; } @@ -1285,7 +1281,7 @@ { /* We distinguish between Bytecounts and Charcounts, to make Vprint_string_length work correctly under Mule. */ - Charcount size = XSTRING_CHAR_LENGTH (obj); + Charcount size = string_char_length (obj); Charcount max = size; Bytecount bcmax = XSTRING_LENGTH (obj); struct gcpro gcpro1, gcpro2; @@ -1308,16 +1304,16 @@ /* This deals with GC-relocation and Mule. */ output_string (printcharfun, 0, obj, 0, bcmax); if (max < size) - write_c_string (" ...", printcharfun); + write_c_string (printcharfun, " ..."); } else { Bytecount i, last = 0; - write_char_internal ("\"", printcharfun); + write_c_string (printcharfun, "\""); for (i = 0; i < bcmax; i++) { - Intbyte ch = XSTRING_BYTE (obj, i); + Intbyte ch = string_byte (obj, i); if (ch == '\"' || ch == '\\' || (ch == '\n' && print_escape_newlines)) { @@ -1328,14 +1324,17 @@ } if (ch == '\n') { - write_c_string ("\\n", printcharfun); + write_c_string (printcharfun, "\\n"); } else { - write_char_internal ("\\", printcharfun); + Intbyte temp[2]; + write_c_string (printcharfun, "\\"); /* This is correct for Mule because the character is either \ or " */ - write_char_internal (XSTRING_DATA (obj) + i, printcharfun); + temp[0] = string_byte (obj, i); + temp[1] = '\0'; + write_string (printcharfun, temp); } last = i + 1; } @@ -1346,8 +1345,8 @@ bcmax - last); } if (max < size) - write_c_string (" ...", printcharfun); - write_char_internal ("\"", printcharfun); + write_c_string (printcharfun, " ..."); + write_c_string (printcharfun, "\""); } UNGCPRO; } @@ -1472,7 +1471,7 @@ char buf[DECIMAL_PRINT_SIZE (long) + 1]; *buf = '#'; long_to_string (buf + 1, i); - write_c_string (buf, printcharfun); + write_c_string (printcharfun, buf); return; } } @@ -1490,7 +1489,7 @@ { char buf[DECIMAL_PRINT_SIZE (EMACS_INT)]; long_to_string (buf, XINT (obj)); - write_c_string (buf, printcharfun); + write_c_string (printcharfun, buf); break; } @@ -1571,7 +1570,7 @@ && print_depth > XINT (Vprint_level)) { GCPRO2 (obj, printcharfun); - write_c_string ("...", printcharfun); + write_c_string (printcharfun, "..."); UNGCPRO; break; } @@ -1596,12 +1595,11 @@ if (print_readably) signal_error (Qinternal_error, "printing illegal data type #o%03o", make_int (XTYPE (obj))); - write_c_string ("#<EMACS BUG: ILLEGAL DATATYPE ", - printcharfun); + write_c_string (printcharfun, "#<EMACS BUG: ILLEGAL DATATYPE "); write_fmt_string (printcharfun, "(#o%3o)", (int) XTYPE (obj)); write_c_string - (" Save your buffers immediately and please report this bug>", - printcharfun); + (printcharfun, + " Save your buffers immediately and please report this bug>"); #endif /* not ERROR_CHECK_TYPES */ break; } @@ -1618,7 +1616,7 @@ char pigbuf[350]; /* see comments in float_to_string */ float_to_string (pigbuf, XFLOAT_DATA (obj)); - write_c_string (pigbuf, printcharfun); + write_c_string (printcharfun, pigbuf); } #endif /* LISP_FLOAT_TYPE */ @@ -1655,9 +1653,9 @@ Lisp_Object tem = Fassq (obj, Vprint_gensym_alist); if (CONSP (tem)) { - write_char_internal ("#", printcharfun); + write_c_string (printcharfun, "#"); print_internal (XCDR (tem), printcharfun, escapeflag); - write_char_internal ("#", printcharfun); + write_c_string (printcharfun, "#"); UNGCPRO; return; } @@ -1675,12 +1673,12 @@ tem = make_int (1); Vprint_gensym_alist = Fcons (Fcons (obj, tem), Vprint_gensym_alist); - write_char_internal ("#", printcharfun); + write_c_string (printcharfun, "#"); print_internal (tem, printcharfun, escapeflag); - write_char_internal ("=", printcharfun); + write_c_string (printcharfun, "="); } } - write_c_string ("#:", printcharfun); + write_c_string (printcharfun, "#:"); } /* Does it look like an integer or a float? */ @@ -1717,7 +1715,7 @@ confusing = isfloat_string ((char *) data); #endif if (confusing) - write_char_internal ("\\", printcharfun); + write_c_string (printcharfun, "\\"); } { @@ -1726,7 +1724,7 @@ for (i = 0; i < size; i++) { - switch (XSTRING_BYTE (name, i)) + switch (string_byte (name, i)) { case 0: case 1: case 2: case 3: case 4: case 5: case 6: case 7: @@ -1742,7 +1740,7 @@ case '[': case ']' : case '?' : if (i > last) output_string (printcharfun, 0, name, last, i - last); - write_char_internal ("\\", printcharfun); + write_c_string (printcharfun, "\\"); last = i; } }
--- a/src/process-nt.c Thu May 02 14:35:32 2002 +0000 +++ b/src/process-nt.c Sun May 05 11:33:57 2002 +0000 @@ -768,7 +768,7 @@ HANDLE htmp; SECURITY_ATTRIBUTES sa; - sa.nLength = sizeof(sa); + sa.nLength = sizeof (sa); sa.bInheritHandle = TRUE; sa.lpSecurityDescriptor = NULL;
--- a/src/process-unix.c Thu May 02 14:35:32 2002 +0000 +++ b/src/process-unix.c Sun May 05 11:33:57 2002 +0000 @@ -129,7 +129,7 @@ close_process_descs_mapfun (const void* key, void* contents, void* arg) { Lisp_Object proc; - CVOID_TO_LISP (proc, contents); + proc = VOID_TO_LISP (contents); event_stream_delete_stream_pair (XPROCESS(proc)->pipe_instream, XPROCESS(proc)->pipe_outstream); return 0;
--- a/src/process.c Thu May 02 14:35:32 2002 +0000 +++ b/src/process.c Sun May 05 11:33:57 2002 +0000 @@ -167,14 +167,15 @@ else { int netp = network_connection_p (object); - write_c_string ((netp ? GETTEXT ("#<network connection ") : - GETTEXT ("#<process ")), printcharfun); + write_c_string (printcharfun, + netp ? GETTEXT ("#<network connection ") : + GETTEXT ("#<process ")); print_internal (process->name, printcharfun, 1); - write_c_string ((netp ? " " : " pid "), printcharfun); + write_c_string (printcharfun, (netp ? " " : " pid ")); print_internal (process->pid, printcharfun, 1); write_fmt_string_lisp (printcharfun, " state:%S", 1, process->status_symbol); MAYBE_PROCMETH (print_process_data, (process, printcharfun)); - write_c_string (">", printcharfun); + write_c_string (printcharfun, ">"); } } @@ -233,7 +234,7 @@ if (gethash ((const void*)usid, usid_to_process, &vval)) { Lisp_Object process; - CVOID_TO_LISP (process, vval); + process = VOID_TO_LISP (vval); return XPROCESS (process); } else @@ -640,9 +641,9 @@ #endif /* 0 */ /* If program file name is not absolute, search our path for it */ - if (!IS_DIRECTORY_SEP (XSTRING_BYTE (program, 0)) + if (!IS_DIRECTORY_SEP (string_byte (program, 0)) && !(XSTRING_LENGTH (program) > 1 - && IS_DEVICE_SEP (XSTRING_BYTE (program, 1)))) + && IS_DEVICE_SEP (string_byte (program, 1)))) { struct gcpro ngcpro1; @@ -1390,7 +1391,7 @@ else string2 = build_string ("\n"); set_string_char (string, 0, - DOWNCASE (0, XSTRING_CHAR (string, 0))); + DOWNCASE (0, string_emchar (string, 0))); return concat2 (string, string2); } else if (EQ (symbol, Qexit)) @@ -1521,8 +1522,8 @@ else BUF_SET_PT (current_buffer, BUF_ZV (current_buffer)); if (BUF_PT (current_buffer) <= opoint) - opoint += (XSTRING_CHAR_LENGTH (msg) - + XSTRING_CHAR_LENGTH (p->name) + opoint += (string_char_length (msg) + + string_char_length (p->name) + 10); old_read_only = current_buffer->read_only; @@ -2062,7 +2063,7 @@ #if 0 -xxDEFUN ("process-connection", Fprocess_connection, 0, 1, 0, /* +DEFUN ("process-connection", Fprocess_connection, 0, 1, 0, /* Return the connection type of `PROCESS'. This can be nil (pipe), t or pty (pty) or stream (socket connection). */ @@ -2090,7 +2091,7 @@ if (STRINGP (entry) && XSTRING_LENGTH (entry) > varlen - && XSTRING_BYTE (entry, varlen) == '=' + && string_byte (entry, varlen) == '=' #ifdef WIN32_NATIVE /* NT environment variables are case insensitive. */ && ! memicmp (XSTRING_DATA (entry), var, varlen) @@ -2124,7 +2125,7 @@ if (STRINGP (entry) && XSTRING_LENGTH (entry) > varlen - && XSTRING_BYTE (entry, varlen) == '=' + && string_byte (entry, varlen) == '=' #ifdef WIN32_NATIVE /* NT environment variables are case insensitive. */ && ! memicmp (XSTRING_DATA (entry), var, varlen)
--- a/src/process.h Thu May 02 14:35:32 2002 +0000 +++ b/src/process.h Sun May 05 11:33:57 2002 +0000 @@ -53,8 +53,6 @@ dead_wrong_type_argument (Qprocess_live_p, (x)); \ } while (0) -#ifdef emacs - EXFUN (Fprocess_kill_without_query, 2); EXFUN (Fprocess_id, 1); @@ -111,9 +109,8 @@ void deactivate_process (Lisp_Object proc); -void -child_setup (int in, int out, int err, - Intbyte **new_argv, Lisp_Object current_dir); +void child_setup (int in, int out, int err, + Intbyte **new_argv, Lisp_Object current_dir); Charcount read_process_output (Lisp_Object proc); @@ -135,6 +132,4 @@ #define EXEC_SUFFIXES "" #endif -#endif /* emacs */ - #endif /* INCLUDED_process_h_ */
--- a/src/profile.c Thu May 02 14:35:32 2002 +0000 +++ b/src/profile.c Sun May 05 11:33:57 2002 +0000 @@ -240,7 +240,7 @@ = (struct get_profiling_info_closure *) void_closure; EMACS_INT val; - CVOID_TO_LISP (key, void_key); + key = VOID_TO_LISP (void_key); val = (EMACS_INT) void_val; closure->accum = Fcons (Fcons (key, make_int (val)), closure->accum); @@ -274,7 +274,7 @@ { Lisp_Object key; - CVOID_TO_LISP (key, void_key); + key = VOID_TO_LISP (void_key); mark_object (key); return 0; }
--- a/src/rangetab.c Thu May 02 14:35:32 2002 +0000 +++ b/src/rangetab.c Sun May 05 11:33:57 2002 +0000 @@ -57,12 +57,12 @@ Lisp_Range_Table *rt = XRANGE_TABLE (obj); int i; - write_c_string ("#s(range-table data (", printcharfun); + write_c_string (printcharfun, "#s(range-table data ("); for (i = 0; i < Dynarr_length (rt->entries); i++) { struct range_table_entry *rte = Dynarr_atp (rt->entries, i); if (i > 0) - write_c_string (" ", printcharfun); + write_c_string (printcharfun, " "); if (rte->first == rte->last) write_fmt_string (printcharfun, "%ld ", (long) (rte->first)); else @@ -70,7 +70,7 @@ (long) (rte->last)); print_internal (rte->val, printcharfun, 1); } - write_c_string ("))", printcharfun); + write_c_string (printcharfun, "))"); } static int @@ -632,7 +632,7 @@ struct unified_range_table *un; range_table_entry_dynarr *rted = XRANGE_TABLE (rangetab)->entries; int total_needed = unified_range_table_bytes_needed (rangetab); - void *new_dest = ALIGN_PTR ((char *) dest + 4, ALIGNOF (EMACS_INT)); + void *new_dest = ALIGN_PTR ((char *) dest + 4, EMACS_INT); * (char *) dest = (char) ((char *) new_dest - (char *) dest); * ((unsigned char *) dest + 1) = total_needed & 0xFF; @@ -661,17 +661,12 @@ align_the_damn_table (void *unrangetab) { void *cur_dest = (char *) unrangetab + * (char *) unrangetab; -#if LONGBITS == 64 - if ((((long) cur_dest) & 7) != 0) -#else - if ((((int) cur_dest) & 3) != 0) -#endif + if (cur_dest != ALIGN_PTR (cur_dest, EMACS_INT)) { int count = (unified_range_table_bytes_used (unrangetab) - 4 - ALIGNOF (EMACS_INT)); /* Find the proper location, just like above. */ - void *new_dest = ALIGN_PTR ((char *) unrangetab + 4, - ALIGNOF (EMACS_INT)); + void *new_dest = ALIGN_PTR ((char *) unrangetab + 4, EMACS_INT); /* memmove() works in the presence of overlapping data. */ memmove (new_dest, cur_dest, count); * (char *) unrangetab = (char) ((char *) new_dest - (char *) unrangetab);
--- a/src/redisplay-gtk.c Thu May 02 14:35:32 2002 +0000 +++ b/src/redisplay-gtk.c Sun May 05 11:33:57 2002 +0000 @@ -2,6 +2,7 @@ Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. Copyright (C) 1994 Lucid, Inc. Copyright (C) 1995 Sun Microsystems, Inc. + Copyright (C) 2002 Ben Wing. This file is part of XEmacs. @@ -133,7 +134,7 @@ int dimension; int graphic; - BREAKUP_CHAR (ch, charset, byte1, byte2); + BREAKUP_EMCHAR (ch, charset, byte1, byte2); dimension = XCHARSET_DIMENSION (charset); graphic = XCHARSET_GRAPHIC (charset); @@ -322,7 +323,7 @@ xpos = rb->xpos; width = 0; if (rb->type == RUNE_CHAR) - charset = CHAR_CHARSET (rb->object.chr.ch); + charset = emchar_charset (rb->object.chr.ch); } if (end < 0) @@ -335,7 +336,7 @@ if (rb->findex == findex && rb->type == RUNE_CHAR && rb->object.chr.ch != '\n' && rb->cursor_type != CURSOR_ON - && EQ (charset, CHAR_CHARSET (rb->object.chr.ch))) + && EQ (charset, emchar_charset (rb->object.chr.ch))) { Dynarr_add (buf, rb->object.chr.ch); width += rb->width; @@ -358,7 +359,7 @@ { findex = rb->findex; xpos = rb->xpos; - charset = CHAR_CHARSET (rb->object.chr.ch); + charset = emchar_charset (rb->object.chr.ch); if (rb->cursor_type == CURSOR_ON) {
--- a/src/redisplay-msw.c Thu May 02 14:35:32 2002 +0000 +++ b/src/redisplay-msw.c Sun May 05 11:33:57 2002 +0000 @@ -99,11 +99,11 @@ if (len == 0) return 0; - prev_charset = CHAR_CHARSET (str[0]); + prev_charset = emchar_charset (str[0]); for (i = 1; i <= len; i++) { - if (i == len || !EQ (CHAR_CHARSET (str[i]), prev_charset)) + if (i == len || !EQ (emchar_charset (str[i]), prev_charset)) { int j; Intbyte *int_storage = @@ -134,7 +134,7 @@ runs_so_far++; runbegin = i; if (i < len) - prev_charset = CHAR_CHARSET (str[i]); + prev_charset = emchar_charset (str[i]); } } @@ -1047,7 +1047,7 @@ xpos = rb->xpos; width = 0; if (rb->type == RUNE_CHAR) - charset = CHAR_CHARSET (rb->object.chr.ch); + charset = emchar_charset (rb->object.chr.ch); if (end < 0) end = Dynarr_length (rba); @@ -1059,7 +1059,7 @@ if (rb->findex == findex && rb->type == RUNE_CHAR && rb->object.chr.ch != '\n' && rb->cursor_type != CURSOR_ON - && EQ (charset, CHAR_CHARSET (rb->object.chr.ch))) + && EQ (charset, emchar_charset (rb->object.chr.ch))) { Dynarr_add (buf, rb->object.chr.ch); width += rb->width; @@ -1081,7 +1081,7 @@ { findex = rb->findex; xpos = rb->xpos; - charset = CHAR_CHARSET (rb->object.chr.ch); + charset = emchar_charset (rb->object.chr.ch); if (rb->cursor_type == CURSOR_ON) {
--- a/src/redisplay-output.c Thu May 02 14:35:32 2002 +0000 +++ b/src/redisplay-output.c Sun May 05 11:33:57 2002 +0000 @@ -848,7 +848,7 @@ boolean indicating success or failure. ****************************************************************************/ -#define ADJ_CHARBPOS (rb->charbpos + dl->offset) +#define ADJ_CHARPOS (rb->charpos + dl->offset) #define ADJ_ENDPOS (rb->endpos + dl->offset) int @@ -888,13 +888,13 @@ if (rb->cursor_type == CURSOR_OFF) return 0; - else if (ADJ_CHARBPOS == new_point - || (ADJ_ENDPOS && (new_point >= ADJ_CHARBPOS) + else if (ADJ_CHARPOS == new_point + || (ADJ_ENDPOS && (new_point >= ADJ_CHARPOS) && (new_point <= ADJ_ENDPOS))) { w->last_point_x[CURRENT_DISP] = x; w->last_point_y[CURRENT_DISP] = y; - Fset_marker (w->last_point[CURRENT_DISP], make_int (ADJ_CHARBPOS), + Fset_marker (w->last_point[CURRENT_DISP], make_int (ADJ_CHARPOS), w->buffer); dl->cursor_elt = x; return 1; @@ -953,7 +953,7 @@ int first = 0; int cur_dl, up; - if (ADJ_CHARBPOS < new_point) + if (ADJ_CHARPOS < new_point) { up = 1; cur_rb = x + 1; @@ -991,9 +991,9 @@ if (rb->cursor_type != IGNORE_CURSOR && rb->cursor_type != NO_CURSOR && - (ADJ_CHARBPOS == new_point - || (ADJ_ENDPOS && (new_point >= ADJ_CHARBPOS) - && (new_point <= ADJ_CHARBPOS)))) + (ADJ_CHARPOS == new_point + || (ADJ_ENDPOS && (new_point >= ADJ_CHARPOS) + && (new_point <= ADJ_CHARPOS)))) { rb->cursor_type = CURSOR_ON; dl->cursor_elt = cur_rb; @@ -1005,7 +1005,7 @@ w->last_point_x[CURRENT_DISP] = cur_rb; w->last_point_y[CURRENT_DISP] = cur_dl; Fset_marker (w->last_point[CURRENT_DISP], - make_int (ADJ_CHARBPOS), w->buffer); + make_int (ADJ_CHARPOS), w->buffer); if (!no_output_end) { @@ -1030,7 +1030,7 @@ } return 0; } -#undef ADJ_CHARBPOS +#undef ADJ_CHARPOS #undef ADJ_ENDPOS /***************************************************************************** @@ -2141,10 +2141,10 @@ while (first_line <= last_line) { - Charcount old_len = (Dynarr_atp (cdla, first_line)->end_charbpos - - Dynarr_atp (cdla, first_line)->charbpos); - Charcount new_len = (Dynarr_atp (ddla, first_line)->end_charbpos - - Dynarr_atp (ddla, first_line)->charbpos); + Charcount old_len = (Dynarr_atp (cdla, first_line)->end_charpos - + Dynarr_atp (cdla, first_line)->charpos); + Charcount new_len = (Dynarr_atp (ddla, first_line)->end_charpos - + Dynarr_atp (ddla, first_line)->charpos); assert (Dynarr_length (cdla) == Dynarr_length (ddla));
--- a/src/redisplay-x.c Thu May 02 14:35:32 2002 +0000 +++ b/src/redisplay-x.c Sun May 05 11:33:57 2002 +0000 @@ -147,7 +147,7 @@ int dimension; int graphic; - BREAKUP_CHAR (ch, charset, byte1, byte2); + BREAKUP_EMCHAR (ch, charset, byte1, byte2); dimension = XCHARSET_DIMENSION (charset); graphic = XCHARSET_GRAPHIC (charset); @@ -345,7 +345,7 @@ findex = rb->findex; xpos = rb->xpos; if (rb->type == RUNE_CHAR) - charset = CHAR_CHARSET (rb->object.chr.ch); + charset = emchar_charset (rb->object.chr.ch); if (end < 0) end = Dynarr_length (rba); @@ -357,7 +357,7 @@ if (rb->findex == findex && rb->type == RUNE_CHAR && rb->object.chr.ch != '\n' && rb->cursor_type != CURSOR_ON - && EQ (charset, CHAR_CHARSET (rb->object.chr.ch))) + && EQ (charset, emchar_charset (rb->object.chr.ch))) { Dynarr_add (buf, rb->object.chr.ch); width += rb->width; @@ -380,7 +380,7 @@ { findex = rb->findex; xpos = rb->xpos; - charset = CHAR_CHARSET (rb->object.chr.ch); + charset = emchar_charset (rb->object.chr.ch); if (rb->cursor_type == CURSOR_ON) {
--- a/src/redisplay.c Thu May 02 14:35:32 2002 +0000 +++ b/src/redisplay.c Sun May 05 11:33:57 2002 +0000 @@ -91,7 +91,7 @@ /* The following structures are completely private to redisplay.c so we put them here instead of in a header file, for modularity. */ -/* NOTE: Bytebpos's not Charbpos's in this structure. */ +/* NOTE: Bytexpos's not Charxpos's in this structure. */ typedef struct position_redisplay_data_type { @@ -119,8 +119,13 @@ int font_is_bogus; /* If true, it means we couldn't instantiate the font for this charset, so we substitute ~'s from the ASCII charset. */ - Bytebpos bi_charbpos; - Bytebpos bi_endpos; + Bytexpos byte_charpos; /* Position of character we are processing. This + is a Bytexpos, meaning it refers to bytes (not + chars) and can refer to either buffers (1-based) + or strings (0-based). We need to be careful + when doing anything that references the text in + the buffer or string. */ + Bytexpos byte_endpos; /* ????? Unknown, under-used. */ int pixpos; int max_pixpos; int blank_width; /* Width of the blank that is to be added. @@ -134,7 +139,8 @@ the non-printing char '\n', which is stuck in the output routines with its width being BLANK_WIDTH. */ - Bytebpos bi_cursor_charbpos;/* This stores the buffer position of the cursor. */ + Bytexpos byte_cursor_charpos; /* This stores the buffer position of the + cursor. */ unsigned int cursor_type :3; int cursor_x; /* rune block cursor is at */ int start_col; /* Number of character columns (each column has @@ -143,7 +149,7 @@ scrolling, where a certain number of columns (those off the left side of the screen) need to be skipped before anything is displayed. */ - Bytebpos bi_start_col_enabled; + Bytexpos byte_start_col_enabled; int start_col_xoffset; /* Number of pixels that still need to be skipped. This is used for horizontal scrolling of glyphs, where we want @@ -229,7 +235,7 @@ struct { Emchar ch; - Bytebpos bi_cursor_charbpos; /* NOTE: is in Bytebposs */ + Bytebpos byte_cursor_charpos; /* NOTE: is in Bytebpos's */ unsigned int cursor_type :3; } p_char; @@ -267,8 +273,9 @@ int pos_type, int allow_cursor, struct glyph_cachel *cachel); static Bytebpos create_text_block (struct window *w, struct display_line *dl, - Bytebpos bi_start_pos, prop_block_dynarr **prop, - int type); + Bytebpos byte_start_pos, + prop_block_dynarr **prop, + int type); static int create_overlay_glyph_block (struct window *w, struct display_line *dl); static void create_left_glyph_block (struct window *w, @@ -279,8 +286,9 @@ static void redisplay_windows (Lisp_Object window, int skip_selected); static void decode_mode_spec (struct window *w, Emchar spec, int type); static void free_display_line (struct display_line *dl); -static void update_line_start_cache (struct window *w, Charbpos from, Charbpos to, - Charbpos point, int no_regen); +static void update_line_start_cache (struct window *w, Charbpos from, + Charbpos to, Charbpos point, + int no_regen); static int point_visible (struct window *w, Charbpos point, int type); static void calculate_yoffset (struct display_line *dl, struct display_block *fixup); @@ -816,7 +824,7 @@ Charbpos start_pos, prop_block_dynarr **prop, int type) { - Charbpos ret_charbpos; + Charbpos ret_charpos; int overlay_width; struct buffer *b = XBUFFER (WINDOW_BUFFER (w)); @@ -847,14 +855,14 @@ Bytebpos hacked_up_bytebpos = create_text_block (w, dl, charbpos_to_bytebpos (b, start_pos), prop, type); - if (hacked_up_bytebpos > BI_BUF_ZV (b)) - ret_charbpos = BUF_ZV (b) + 1; + if (hacked_up_bytebpos > BYTE_BUF_ZV (b)) + ret_charpos = BUF_ZV (b) + 1; else - ret_charbpos = bytebpos_to_charbpos (b, hacked_up_bytebpos); + ret_charpos = bytebpos_to_charbpos (b, hacked_up_bytebpos); } - dl->charbpos = start_pos; - if (dl->end_charbpos < dl->charbpos) - dl->end_charbpos = dl->charbpos; + dl->charpos = start_pos; + if (dl->end_charpos < dl->charpos) + dl->end_charpos = dl->charpos; if (MARKERP (Voverlay_arrow_position) && EQ (w->buffer, Fmarker_buffer (Voverlay_arrow_position)) @@ -880,9 +888,9 @@ /* In the future additional types of display blocks may be generated here. */ - w->last_redisplay_pos = ret_charbpos; - - return ret_charbpos; + w->last_redisplay_pos = ret_charpos; + + return ret_charpos; } /* Adds an hscroll glyph to a display block. If this is called, then @@ -890,7 +898,7 @@ Yes, there are multiple places where this function is called but that is the way it has to be. Each calling function has to deal - with bi_start_col_enabled a little differently depending on the + with byte_start_col_enabled a little differently depending on the object being worked with. */ static prop_block_dynarr * @@ -898,23 +906,23 @@ { struct glyph_block gb; prop_block_dynarr *retval; - Bytebpos bi_old_cursor_charbpos = data->bi_cursor_charbpos; + Bytebpos byte_old_cursor_charpos = data->byte_cursor_charpos; int old_cursor_type = data->cursor_type; - Bytebpos bi_old_charbpos = data->bi_charbpos; + Bytebpos byte_old_charpos = data->byte_charpos; if (data->cursor_type == CURSOR_ON - && data->bi_cursor_charbpos >= data->bi_start_col_enabled - && data->bi_cursor_charbpos <= data->bi_charbpos) - { - data->bi_cursor_charbpos = data->bi_start_col_enabled; + && data->byte_cursor_charpos >= data->byte_start_col_enabled + && data->byte_cursor_charpos <= data->byte_charpos) + { + data->byte_cursor_charpos = data->byte_start_col_enabled; } else { data->cursor_type = NO_CURSOR; } - data->bi_endpos = data->bi_charbpos; - data->bi_charbpos = data->bi_start_col_enabled; + data->byte_endpos = data->byte_charpos; + data->byte_charpos = data->byte_start_col_enabled; gb.extent = Qnil; gb.glyph = Vhscroll_glyph; @@ -926,12 +934,12 @@ data->hscroll_glyph_width_adjust = data->pixpos - oldpixpos - space_width (XWINDOW (data->window)); } - data->bi_endpos = 0; - data->bi_cursor_charbpos = bi_old_cursor_charbpos; + data->byte_endpos = 0; + data->byte_cursor_charpos = byte_old_cursor_charpos; data->cursor_type = old_cursor_type; - data->bi_charbpos = bi_old_charbpos; - - data->bi_start_col_enabled = 0; + data->byte_charpos = byte_old_charpos; + + data->byte_start_col_enabled = 0; return retval; } @@ -955,7 +963,7 @@ return NULL; } - if (data->bi_start_col_enabled) + if (data->byte_start_col_enabled) { return add_hscroll_rune (data); } @@ -968,7 +976,7 @@ } else { - Lisp_Object charset = CHAR_CHARSET (data->ch); + Lisp_Object charset = emchar_charset (data->ch); if (!EQ (charset, data->last_charset) || data->findex != data->last_findex) { @@ -1036,29 +1044,29 @@ crb->findex = data->findex; crb->xpos = data->pixpos; crb->width = width; - if (data->bi_charbpos) + if (data->byte_charpos) { if (NILP (data->string)) - crb->charbpos = + crb->charpos = bytebpos_to_charbpos (XBUFFER (WINDOW_BUFFER (XWINDOW (data->window))), - data->bi_charbpos); + data->byte_charpos); else - crb->charbpos = - string_index_byte_to_char (data->string, data->bi_charbpos); + crb->charpos = + string_index_byte_to_char (data->string, data->byte_charpos); } else if (data->is_modeline) - crb->charbpos = data->modeline_charpos; + crb->charpos = data->modeline_charpos; else /* Text but not in buffer */ - crb->charbpos = 0; + crb->charpos = 0; crb->type = RUNE_CHAR; crb->object.chr.ch = data->font_is_bogus ? '~' : data->ch; crb->endpos = 0; if (data->cursor_type == CURSOR_ON) { - if (data->bi_charbpos == data->bi_cursor_charbpos) + if (data->byte_charpos == data->byte_cursor_charpos) { crb->cursor_type = CURSOR_ON; data->cursor_x = Dynarr_length (data->db->runes); @@ -1201,19 +1209,19 @@ rb.findex = data->findex; rb.xpos = data->pixpos; rb.width = data->blank_width; - if (data->bi_charbpos) - rb.charbpos = + if (data->byte_charpos) + rb.charpos = bytebpos_to_charbpos (XBUFFER (WINDOW_BUFFER (XWINDOW (data->window))), - data->bi_charbpos); + data->byte_charpos); else /* #### and this is really correct too? */ - rb.charbpos = 0; + rb.charpos = 0; rb.endpos = 0; rb.type = RUNE_BLANK; if (data->cursor_type == CURSOR_ON) { - if (data->bi_charbpos == data->bi_cursor_charbpos) + if (data->byte_charpos == data->byte_cursor_charpos) { rb.cursor_type = CURSOR_ON; data->cursor_x = Dynarr_length (data->db->runes); @@ -1268,7 +1276,7 @@ if (!data->start_col) { - if (data->bi_start_col_enabled) + if (data->byte_start_col_enabled) { add_failed = add_hscroll_rune (data); } @@ -1344,7 +1352,7 @@ if (!data->start_col) { - if (data->bi_start_col_enabled) + if (data->byte_start_col_enabled) { prop_block_dynarr *retval; @@ -1412,7 +1420,7 @@ if (data->start_col) data->start_col--; - if (!data->start_col && data->bi_start_col_enabled) + if (!data->start_col && data->byte_start_col_enabled) { prop = add_hscroll_rune (data); } @@ -1525,7 +1533,7 @@ record? */ int elt; prop_block_dynarr *add_failed; - Bytebpos bi_old_cursor_charbpos = data->bi_cursor_charbpos; + Bytebpos byte_old_cursor_charpos = data->byte_cursor_charpos; int old_cursor_type = data->cursor_type; for (elt = 0; elt < Dynarr_length (*prop); elt++) @@ -1536,7 +1544,7 @@ { case PROP_CHAR: data->ch = pb->data.p_char.ch; - data->bi_cursor_charbpos = pb->data.p_char.bi_cursor_charbpos; + data->byte_cursor_charpos = pb->data.p_char.byte_cursor_charpos; data->cursor_type = pb->data.p_char.cursor_type; add_failed = add_emchar_rune (data); @@ -1553,10 +1561,10 @@ case PROP_MINIBUF_PROMPT: { face_index old_findex = data->findex; - Bytebpos bi_old_charbpos = data->bi_charbpos; + Bytebpos byte_old_charpos = data->byte_charpos; data->findex = DEFAULT_INDEX; - data->bi_charbpos = 0; + data->byte_charpos = 0; data->cursor_type = NO_CURSOR; while (pb->data.p_string.len > 0) @@ -1567,7 +1575,7 @@ if (add_failed) { data->findex = old_findex; - data->bi_charbpos = bi_old_charbpos; + data->byte_charpos = byte_old_charpos; goto oops_no_more_space; } else @@ -1581,19 +1589,19 @@ data->findex = old_findex; /* ##### FIXME FIXME FIXME -- Upon successful return from - this function, data->bi_charbpos is automatically incremented. + this function, data->byte_charpos is automatically incremented. However, we don't want that to happen if we were adding the minibuffer prompt. */ { struct buffer *buf = XBUFFER (WINDOW_BUFFER (XWINDOW (data->window))); /* #### Chuck fix this shit or I'm gonna scream! */ - if (bi_old_charbpos > BI_BUF_BEGV (buf)) - data->bi_charbpos = prev_bytebpos (buf, bi_old_charbpos); + if (byte_old_charpos > BYTE_BUF_BEGV (buf)) + data->byte_charpos = prev_bytebpos (buf, byte_old_charpos); else /* #### is this correct? Does anyone know? Does anyone care? Is this a cheesy hack or what? */ - data->bi_charbpos = BI_BUF_BEGV (buf) - 1; + data->byte_charpos = BYTE_BUF_BEGV (buf) - 1; } } break; @@ -1607,7 +1615,7 @@ data->findex = pb->data.p_blank.findex; data->blank_width = pb->data.p_blank.width; - data->bi_cursor_charbpos = 0; + data->byte_cursor_charpos = 0; data->cursor_type = IGNORE_CURSOR; if (data->pixpos + data->blank_width > data->max_pixpos) @@ -1640,7 +1648,7 @@ oops_no_more_space: - data->bi_cursor_charbpos = bi_old_cursor_charbpos; + data->byte_cursor_charpos = byte_old_cursor_charpos; data->cursor_type = old_cursor_type; if (elt < Dynarr_length (*prop)) { @@ -1844,29 +1852,29 @@ { Lisp_Object string = XIMAGE_INSTANCE_TEXT_STRING (instance); face_index orig_findex = data->findex; - Bytebpos orig_charbpos = data->bi_charbpos; - Bytebpos orig_start_col_enabled = data->bi_start_col_enabled; + Bytebpos orig_charpos = data->byte_charpos; + Bytebpos orig_start_col_enabled = data->byte_start_col_enabled; data->findex = findex; - data->bi_start_col_enabled = 0; + data->byte_start_col_enabled = 0; if (!allow_cursor) - data->bi_charbpos = 0; + data->byte_charpos = 0; add_intbyte_string_runes (data, XSTRING_DATA (string), XSTRING_LENGTH (string), 0, 1); data->findex = orig_findex; - data->bi_charbpos = orig_charbpos; - data->bi_start_col_enabled = orig_start_col_enabled; + data->byte_charpos = orig_charpos; + data->byte_start_col_enabled = orig_start_col_enabled; return retval; } rb.findex = findex; rb.xpos = data->pixpos; rb.width = width; - rb.charbpos = 0; /* glyphs are never "at" anywhere */ - if (data->bi_endpos) + rb.charpos = 0; /* glyphs are never "at" anywhere */ + if (data->byte_endpos) /* #### is this necessary at all? */ rb.endpos = bytebpos_to_charbpos (XBUFFER (WINDOW_BUFFER (w)), - data->bi_endpos); + data->byte_endpos); else rb.endpos = 0; rb.type = RUNE_DGLYPH; @@ -1879,12 +1887,12 @@ if (allow_cursor) { - rb.charbpos = bytebpos_to_charbpos (XBUFFER (WINDOW_BUFFER (w)), - data->bi_charbpos); + rb.charpos = bytebpos_to_charbpos (XBUFFER (WINDOW_BUFFER (w)), + data->byte_charpos); if (data->cursor_type == CURSOR_ON) { - if (data->bi_charbpos == data->bi_cursor_charbpos) + if (data->byte_charpos == data->byte_cursor_charpos) { rb.cursor_type = CURSOR_ON; data->cursor_x = Dynarr_length (data->db->runes); @@ -1978,12 +1986,12 @@ display line DL accurately represents the text on a line starting at the given position. - NOTE NOTE NOTE NOTE: This function works with and returns Bytebposs. + NOTE NOTE NOTE NOTE: This function works with and returns Bytebpos's. You must do appropriate conversion. */ static Bytebpos create_text_block (struct window *w, struct display_line *dl, - Bytebpos bi_start_pos, prop_block_dynarr **prop, + Bytebpos byte_start_pos, prop_block_dynarr **prop, int type) { struct frame *f = XFRAME (w->frame); @@ -2087,7 +2095,7 @@ data.db = db; data.dl = dl; - data.bi_charbpos = bi_start_pos; + data.byte_charpos = byte_start_pos; data.pixpos = dl->bounds.left_in; data.last_charset = Qunbound; data.last_findex = DEFAULT_INDEX; @@ -2104,7 +2112,7 @@ if (cursor_in_echo_area && MINI_WINDOW_P (w) && echo_area_active (f)) { - data.bi_cursor_charbpos = BI_BUF_ZV (b); + data.byte_cursor_charpos = BYTE_BUF_ZV (b); data.cursor_type = CURSOR_ON; } else if (MINI_WINDOW_P (w) && !active_minibuffer) @@ -2114,12 +2122,12 @@ d == XDEVICE(CONSOLE_SELECTED_DEVICE(XCONSOLE(DEVICE_CONSOLE(d))))&& f == XFRAME(DEVICE_SELECTED_FRAME(d))) { - data.bi_cursor_charbpos = BI_BUF_PT (b); + data.byte_cursor_charpos = BYTE_BUF_PT (b); data.cursor_type = CURSOR_ON; } else if (w == XWINDOW (FRAME_SELECTED_WINDOW (f))) { - data.bi_cursor_charbpos = bi_marker_position (w->pointm[type]); + data.byte_cursor_charpos = byte_marker_position (w->pointm[type]); data.cursor_type = CURSOR_ON; } else @@ -2128,7 +2136,7 @@ data.start_col = w->hscroll; data.start_col_xoffset = w->left_xoffset; - data.bi_start_col_enabled = (w->hscroll ? bi_start_pos : 0); + data.byte_start_col_enabled = (w->hscroll ? byte_start_pos : 0); data.hscroll_glyph_width_adjust = 0; /* We regenerate the line from the very beginning. */ @@ -2164,10 +2172,10 @@ && (active_minibuffer || !NILP (synch_minibuffers_value))) { /* #### This check probably should not be necessary. */ - if (data.bi_charbpos > BI_BUF_ZV (b)) + if (data.byte_charpos > BYTE_BUF_ZV (b)) { /* #### urk! More of this lossage! */ - data.bi_charbpos--; + data.byte_charpos--; goto done; } @@ -2175,23 +2183,23 @@ a continuation line then find the next line we are actually supposed to display. */ if (selective > 0 - && (data.bi_charbpos == BI_BUF_BEGV (b) - || BUF_FETCH_CHAR (b, prev_bytebpos (b, data.bi_charbpos)) == '\n')) - { - while (bi_spaces_at_point (b, data.bi_charbpos) >= selective) + && (data.byte_charpos == BYTE_BUF_BEGV (b) + || BUF_FETCH_CHAR (b, prev_bytebpos (b, data.byte_charpos)) == '\n')) + { + while (byte_spaces_at_point (b, data.byte_charpos) >= selective) { - data.bi_charbpos = - bi_find_next_newline_no_quit (b, data.bi_charbpos, 1); - if (data.bi_charbpos >= BI_BUF_ZV (b)) + data.byte_charpos = + byte_find_next_newline_no_quit (b, data.byte_charpos, 1); + if (data.byte_charpos >= BYTE_BUF_ZV (b)) { - data.bi_charbpos = BI_BUF_ZV (b); + data.byte_charpos = BYTE_BUF_ZV (b); goto done; } } } /* Check for face changes. */ - if (initial || (!no_more_frags && data.bi_charbpos == data.ef->end)) + if (initial || (!no_more_frags && data.byte_charpos == data.ef->end)) { Lisp_Object last_glyph = Qnil; @@ -2211,11 +2219,11 @@ /* Now compute the face and begin/end-glyph information. */ data.findex = /* Remember that the extent-fragment routines deal in Bytebpos's. */ - extent_fragment_update (w, data.ef, data.bi_charbpos, last_glyph); + extent_fragment_update (w, data.ef, data.byte_charpos, last_glyph); get_display_tables (w, data.findex, &face_dt, &window_dt); - if (data.bi_charbpos == data.ef->end) + if (data.byte_charpos == data.ef->end) no_more_frags = 1; } initial = 0; @@ -2265,7 +2273,7 @@ /* If point is in an invisible region we place it on the next visible character. */ if (data.cursor_type == CURSOR_ON - && data.bi_charbpos == data.bi_cursor_charbpos) + && data.byte_charpos == data.byte_cursor_charpos) { data.cursor_type = NEXT_CURSOR; } @@ -2274,10 +2282,10 @@ if (data.start_col) data.start_col--; - if (data.bi_charbpos == BI_BUF_ZV (b)) + if (data.byte_charpos == BYTE_BUF_ZV (b)) goto done; else - INC_BYTEBPOS (b, data.bi_charbpos); + INC_BYTEBPOS (b, data.byte_charpos); } /* If there is propagation data, then it represents the current @@ -2291,13 +2299,13 @@ if (*prop) goto done; /* gee, a really narrow window */ - else if (data.bi_charbpos == BI_BUF_ZV (b)) + else if (data.byte_charpos == BYTE_BUF_ZV (b)) goto done; - else if (data.bi_charbpos < BI_BUF_BEGV (b)) + else if (data.byte_charpos < BYTE_BUF_BEGV (b)) /* #### urk urk urk! Aborts are not very fun! Fix this please! */ - data.bi_charbpos = BI_BUF_BEGV (b); + data.byte_charpos = BYTE_BUF_BEGV (b); else - INC_BYTEBPOS (b, data.bi_charbpos); + INC_BYTEBPOS (b, data.byte_charpos); } /* If there are end glyphs, add them to the line. These are @@ -2310,7 +2318,7 @@ { glyph_block_dynarr* tmpglyphs = 0; /* #### I think this is safe, but could be wrong. */ - data.ch = BI_BUF_FETCH_CHAR (b, data.bi_charbpos); + data.ch = BYTE_BUF_FETCH_CHAR (b, data.byte_charpos); if (Dynarr_length (data.ef->end_glyphs) > 0) { @@ -2363,14 +2371,14 @@ /* If at end-of-buffer, we've already processed begin and end-glyphs at this point and there's no text to process, so we're done. */ - else if (data.bi_charbpos == BI_BUF_ZV (b)) + else if (data.byte_charpos == BYTE_BUF_ZV (b)) goto done; else { Lisp_Object entry = Qnil; /* Get the character at the current buffer position. */ - data.ch = BI_BUF_FETCH_CHAR (b, data.bi_charbpos); + data.ch = BYTE_BUF_FETCH_CHAR (b, data.byte_charpos); if (!NILP (face_dt) || !NILP (window_dt)) entry = display_table_entry (data.ch, face_dt, window_dt); @@ -2394,8 +2402,8 @@ data.max_pixpos += data.end_glyph_width; if (selective > 0 - && (bi_spaces_at_point - (b, next_bytebpos (b, data.bi_charbpos)) + && (byte_spaces_at_point + (b, next_bytebpos (b, data.byte_charpos)) >= selective)) { if (!NILP (b->selective_display_ellipses)) @@ -2417,25 +2425,25 @@ *prop = add_emchar_rune (&data); } - /* We need to set data.bi_charbpos to the start of the + /* We need to set data.byte_charpos to the start of the next visible region in order to make this line appear to contain all of the invisible area. Otherwise, the line cache won't work correctly. */ - INC_BYTEBPOS (b, data.bi_charbpos); - while (bi_spaces_at_point (b, data.bi_charbpos) >= selective) + INC_BYTEBPOS (b, data.byte_charpos); + while (byte_spaces_at_point (b, data.byte_charpos) >= selective) { - data.bi_charbpos = - bi_find_next_newline_no_quit (b, data.bi_charbpos, 1); - if (data.bi_charbpos >= BI_BUF_ZV (b)) + data.byte_charpos = + byte_find_next_newline_no_quit (b, data.byte_charpos, 1); + if (data.byte_charpos >= BYTE_BUF_ZV (b)) { - data.bi_charbpos = BI_BUF_ZV (b); + data.byte_charpos = BYTE_BUF_ZV (b); break; } } - if (BI_BUF_FETCH_CHAR - (b, prev_bytebpos (b, data.bi_charbpos)) == '\n') - DEC_BYTEBPOS (b, data.bi_charbpos); + if (BYTE_BUF_FETCH_CHAR + (b, prev_bytebpos (b, data.byte_charpos)) == '\n') + DEC_BYTEBPOS (b, data.byte_charpos); } else { @@ -2452,20 +2460,20 @@ line is done. */ else if (data.ch == (('M' & 037)) && selective == -1) { - Bytebpos bi_next_charbpos; + Bytebpos byte_next_charpos; /* Find the buffer position at the end of the line. */ - bi_next_charbpos = - bi_find_next_newline_no_quit (b, data.bi_charbpos, 1); - if (BI_BUF_FETCH_CHAR (b, prev_bytebpos (b, bi_next_charbpos)) + byte_next_charpos = + byte_find_next_newline_no_quit (b, data.byte_charpos, 1); + if (BYTE_BUF_FETCH_CHAR (b, prev_bytebpos (b, byte_next_charpos)) == '\n') - DEC_BYTEBPOS (b, bi_next_charbpos); + DEC_BYTEBPOS (b, byte_next_charpos); /* If the cursor is somewhere in the elided text make sure that the cursor gets drawn appropriately. */ if (data.cursor_type == CURSOR_ON - && (data.bi_cursor_charbpos >= data.bi_charbpos && - data.bi_cursor_charbpos < bi_next_charbpos)) + && (data.byte_cursor_charpos >= data.byte_charpos && + data.byte_cursor_charpos < byte_next_charpos)) { data.cursor_type = NEXT_CURSOR; } @@ -2491,10 +2499,10 @@ need to do this before potentially adding a newline so that the cursor flag will get set correctly (if needed). */ - data.bi_charbpos = bi_next_charbpos; + data.byte_charpos = byte_next_charpos; if (NILP (b->selective_display_ellipses) - || data.bi_cursor_charbpos == bi_next_charbpos) + || data.byte_cursor_charpos == byte_next_charpos) { /* We have to at least add a newline character so that the cursor shows up properly. */ @@ -2503,7 +2511,7 @@ data.findex = DEFAULT_INDEX; data.start_col = 0; data.start_col_xoffset = 0; - data.bi_start_col_enabled = 0; + data.byte_start_col_enabled = 0; add_emchar_rune (&data); } @@ -2511,7 +2519,7 @@ /* This had better be a newline but doing it this way we'll see obvious incorrect results if it isn't. No need to abort here. */ - data.ch = BI_BUF_FETCH_CHAR (b, data.bi_charbpos); + data.ch = BYTE_BUF_FETCH_CHAR (b, data.byte_charpos); goto done; } @@ -2607,7 +2615,7 @@ goto done; } - INC_BYTEBPOS (b, data.bi_charbpos); + INC_BYTEBPOS (b, data.byte_charpos); } } @@ -2615,15 +2623,15 @@ /* Determine the starting point of the next line if we did not hit the end of the buffer. */ - if (data.bi_charbpos < BI_BUF_ZV (b) + if (data.byte_charpos < BYTE_BUF_ZV (b) && (active_minibuffer || !NILP (synch_minibuffers_value))) { /* #### This check is not correct. If the line terminated due to a begin-glyph or end-glyph hitting window-end, then - data.ch will not point to the character at data.bi_charbpos. If + data.ch will not point to the character at data.byte_charpos. If you make the two changes mentioned at the top of this loop, you should be able to say '(if (*prop))'. That should also - make it possible to eliminate the data.bi_charbpos < BI_BUF_ZV (b) + make it possible to eliminate the data.byte_charpos < BYTE_BUF_ZV (b) check. */ /* The common case is that the line ended because we hit a newline. @@ -2635,19 +2643,19 @@ scrolled far enough so that nothing on this line is visible. We need to stick a truncation glyph at the beginning of the line in that case unless the line is completely blank. */ - if (data.bi_start_col_enabled) + if (data.byte_start_col_enabled) { if (data.cursor_type == CURSOR_ON) { - if (data.bi_cursor_charbpos >= bi_start_pos - && data.bi_cursor_charbpos <= data.bi_charbpos) - data.bi_cursor_charbpos = data.bi_charbpos; + if (data.byte_cursor_charpos >= byte_start_pos + && data.byte_cursor_charpos <= data.byte_charpos) + data.byte_cursor_charpos = data.byte_charpos; } data.findex = DEFAULT_INDEX; data.start_col = 0; - data.bi_start_col_enabled = 0; - - if (data.bi_charbpos != bi_start_pos) + data.byte_start_col_enabled = 0; + + if (data.byte_charpos != byte_start_pos) { struct glyph_block gb; @@ -2667,7 +2675,7 @@ } } - INC_BYTEBPOS (b, data.bi_charbpos); + INC_BYTEBPOS (b, data.byte_charpos); } /* Otherwise we have a buffer line which cannot fit on one display @@ -2687,10 +2695,10 @@ if (truncate_win) { - Bytebpos bi_pos; + Bytebpos byte_pos; /* Now find the start of the next line. */ - bi_pos = bi_find_next_newline_no_quit (b, data.bi_charbpos, 1); + byte_pos = byte_find_next_newline_no_quit (b, data.byte_charpos, 1); /* If the cursor is past the truncation line then we make it appear on the truncation glyph. If we've hit @@ -2699,17 +2707,17 @@ newline. In that case the cursor should actually appear on the next line. */ if (data.cursor_type == CURSOR_ON - && data.bi_cursor_charbpos >= data.bi_charbpos - && (data.bi_cursor_charbpos < bi_pos || - (bi_pos == BI_BUF_ZV (b) - && (bi_pos == BI_BUF_BEGV (b) - || (BI_BUF_FETCH_CHAR (b, prev_bytebpos (b, bi_pos)) + && data.byte_cursor_charpos >= data.byte_charpos + && (data.byte_cursor_charpos < byte_pos || + (byte_pos == BYTE_BUF_ZV (b) + && (byte_pos == BYTE_BUF_BEGV (b) + || (BYTE_BUF_FETCH_CHAR (b, prev_bytebpos (b, byte_pos)) != '\n'))))) - data.bi_cursor_charbpos = bi_pos; + data.byte_cursor_charpos = byte_pos; else data.cursor_type = NO_CURSOR; - data.bi_charbpos = bi_pos; + data.byte_charpos = byte_pos; gb.glyph = Vtruncation_glyph; cachel = GLYPH_CACHEL (w, TRUN_GLYPH_INDEX); } @@ -2718,7 +2726,7 @@ /* The cursor can never be on the continuation glyph. */ data.cursor_type = NO_CURSOR; - /* data.bi_charbpos is already at the start of the next line. */ + /* data.byte_charpos is already at the start of the next line. */ dl->line_continuation = 1; gb.glyph = Vcontinuation_glyph; @@ -2727,14 +2735,14 @@ add_glyph_rune (&data, &gb, BEGIN_GLYPHS, 0, cachel); - if (truncate_win && data.bi_charbpos == BI_BUF_ZV (b) - && BI_BUF_FETCH_CHAR (b, prev_bytebpos (b, BI_BUF_ZV (b))) != '\n') + if (truncate_win && data.byte_charpos == BYTE_BUF_ZV (b) + && BYTE_BUF_FETCH_CHAR (b, prev_bytebpos (b, BYTE_BUF_ZV (b))) != '\n') /* #### Damn this losing shit. */ - data.bi_charbpos++; + data.byte_charpos++; } } else if ((active_minibuffer || !NILP (synch_minibuffers_value)) - && (!echo_area_active (f) || data.bi_charbpos == BI_BUF_ZV (b))) + && (!echo_area_active (f) || data.byte_charpos == BYTE_BUF_ZV (b))) { /* We need to add a marker to the end of the line since there is no newline character in order for the cursor to get drawn. We label @@ -2746,7 +2754,7 @@ data.findex = DEFAULT_INDEX; data.start_col = 0; data.start_col_xoffset = 0; - data.bi_start_col_enabled = 0; + data.byte_start_col_enabled = 0; data.max_pixpos += data.blank_width; add_emchar_rune (&data); @@ -2755,7 +2763,7 @@ /* #### urk! Chuck, this shit is bad news. Going around manipulating invalid positions is guaranteed to result in trouble sooner or later. */ - data.bi_charbpos = BI_BUF_ZV (b) + 1; + data.byte_charpos = BYTE_BUF_ZV (b) + 1; } /* Calculate left whitespace boundary. */ @@ -2838,17 +2846,17 @@ dl->cursor_elt = data.cursor_x; /* #### lossage lossage lossage! Fix this shit! */ - if (data.bi_charbpos > BI_BUF_ZV (b)) - dl->end_charbpos = BUF_ZV (b); + if (data.byte_charpos > BYTE_BUF_ZV (b)) + dl->end_charpos = BUF_ZV (b); else - dl->end_charbpos = bytebpos_to_charbpos (b, data.bi_charbpos) - 1; + dl->end_charpos = bytebpos_to_charbpos (b, data.byte_charpos) - 1; if (truncate_win) - data.dl->num_chars = column_at_point (b, dl->end_charbpos, 0); + data.dl->num_chars = column_at_point (b, dl->end_charpos, 0); else /* This doesn't correctly take into account tabs and control characters but if the window isn't being truncated then this value isn't going to end up being used anyhow. */ - data.dl->num_chars = dl->end_charbpos - dl->charbpos; + data.dl->num_chars = dl->end_charpos - dl->charpos; /* #### handle horizontally scrolled line with text none of which was actually laid out. */ @@ -2871,10 +2879,10 @@ The main loop should get fixed so that it isn't necessary to call this function if we are already at EOB. */ - if (data.bi_charbpos == BI_BUF_ZV (b) && bi_start_pos == BI_BUF_ZV (b)) - return data.bi_charbpos + 1; /* Yuck! */ + if (data.byte_charpos == BYTE_BUF_ZV (b) && byte_start_pos == BYTE_BUF_ZV (b)) + return data.byte_charpos + 1; /* Yuck! */ else - return data.bi_charbpos; + return data.byte_charpos; } /* Display the overlay arrow at the beginning of the given line. */ @@ -3040,7 +3048,7 @@ : get_builtin_face_cache_index (w, Vright_margin_face)); rb.xpos = xpos; rb.width = width; - rb.charbpos = -1; + rb.charpos = -1; rb.endpos = 0; rb.type = RUNE_BLANK; rb.cursor_type = CURSOR_OFF; @@ -3843,7 +3851,7 @@ rb.findex = MODELINE_INDEX; rb.xpos = dl->bounds.left_out; rb.width = dl->bounds.right_out - dl->bounds.left_out; - rb.charbpos = 0; + rb.charpos = 0; rb.endpos = 0; rb.type = RUNE_HLINE; rb.object.hline.thickness = 1; @@ -4144,7 +4152,7 @@ if (STRINGP (tem)) { Intbyte *str = XSTRING_DATA (tem); - Charcount size = XSTRING_CHAR_LENGTH (tem); + Charcount size = string_char_length (tem); if (size <= *offset) *offset -= size; @@ -4461,7 +4469,7 @@ /***************************************************************************/ /* */ -/* displayable string routines */ +/* displayable string routines */ /* */ /***************************************************************************/ @@ -4482,7 +4490,7 @@ static Charbpos create_string_text_block (struct window *w, Lisp_Object disp_string, struct display_line *dl, - Charbpos start_pos, + Charcount start_pos, prop_block_dynarr **prop, face_index default_face) { @@ -4497,8 +4505,8 @@ /* we're working with these a lot so precalculate them */ Bytecount slen = XSTRING_LENGTH (disp_string); - Bytecount bi_string_zv = slen; - Bytebpos bi_start_pos = string_index_char_to_byte (disp_string, start_pos); + Bytecount byte_string_zv = slen; + Bytecount byte_start_pos = string_index_char_to_byte (disp_string, start_pos); pos_data data; @@ -4600,7 +4608,7 @@ data.db = db; data.dl = dl; - data.bi_charbpos = bi_start_pos; + data.byte_charpos = byte_start_pos; data.pixpos = dl->bounds.left_in; data.last_charset = Qunbound; data.last_findex = default_face; @@ -4619,9 +4627,9 @@ /* I don't think we want this, string areas should not scroll with the window data.start_col = w->hscroll; - data.bi_start_col_enabled = (w->hscroll ? bi_start_pos : 0); + data.byte_start_col_enabled = (w->hscroll ? byte_start_pos : 0); */ - data.bi_start_col_enabled = 0; + data.byte_start_col_enabled = 0; data.hscroll_glyph_width_adjust = 0; /* We regenerate the line from the very beginning. */ @@ -4656,15 +4664,15 @@ while (data.pixpos <= data.max_pixpos) { /* #### This check probably should not be necessary. */ - if (data.bi_charbpos > bi_string_zv) + if (data.byte_charpos > byte_string_zv) { /* #### urk! More of this lossage! */ - data.bi_charbpos--; + data.byte_charpos--; goto done; } /* Check for face changes. */ - if (initial || (!no_more_frags && data.bi_charbpos == data.ef->end)) + if (initial || (!no_more_frags && data.byte_charpos == data.ef->end)) { Lisp_Object last_glyph = Qnil; /* Deal with clipped glyphs that we have already displayed. */ @@ -4677,8 +4685,8 @@ /* Now compute the face and begin/end-glyph information. */ data.findex = /* Remember that the extent-fragment routines deal in - Bytebpos's. */ - extent_fragment_update (w, data.ef, data.bi_charbpos, last_glyph); + Bytexpos's. */ + extent_fragment_update (w, data.ef, data.byte_charpos, last_glyph); /* This is somewhat cheesy but the alternative is to propagate default_face into extent_fragment_update. */ if (data.findex == DEFAULT_INDEX) @@ -4686,7 +4694,7 @@ get_display_tables (w, data.findex, &face_dt, &window_dt); - if (data.bi_charbpos == data.ef->end) + if (data.byte_charpos == data.ef->end) no_more_frags = 1; } initial = 0; @@ -4737,10 +4745,10 @@ if (data.start_col) data.start_col--; - if (data.bi_charbpos == bi_string_zv) + if (data.byte_charpos == byte_string_zv) goto done; else - INC_CHARBYTEBPOS (XSTRING_DATA (disp_string), data.bi_charbpos); + INC_BYTECOUNT (XSTRING_DATA (disp_string), data.byte_charpos); } /* If there is propagation data, then it represents the current @@ -4754,13 +4762,13 @@ if (*prop) goto done; /* gee, a really narrow window */ - else if (data.bi_charbpos == bi_string_zv) + else if (data.byte_charpos == byte_string_zv) goto done; - else if (data.bi_charbpos < 0) + else if (data.byte_charpos < 0) /* #### urk urk urk! Aborts are not very fun! Fix this please! */ - data.bi_charbpos = 0; + data.byte_charpos = 0; else - INC_CHARBYTEBPOS (XSTRING_DATA (disp_string), data.bi_charbpos); + INC_BYTECOUNT (XSTRING_DATA (disp_string), data.byte_charpos); } /* If there are end glyphs, add them to the line. These are @@ -4770,7 +4778,7 @@ a line are handled correctly. */ else if (Dynarr_length (data.ef->end_glyphs) > 0) { - data.ch = XSTRING_CHAR (disp_string, data.bi_charbpos); + data.ch = string_emchar (disp_string, data.byte_charpos); *prop = add_glyph_runes (&data, END_GLYPHS); if (*prop) { @@ -4781,7 +4789,7 @@ /* If there are begin glyphs, add them to the line. */ else if (Dynarr_length (data.ef->begin_glyphs) > 0) { - data.ch = XSTRING_CHAR (disp_string, data.bi_charbpos); + data.ch = string_emchar (disp_string, data.byte_charpos); *prop = add_glyph_runes (&data, BEGIN_GLYPHS); if (*prop) { @@ -4792,14 +4800,14 @@ /* If at end-of-buffer, we've already processed begin and end-glyphs at this point and there's no text to process, so we're done. */ - else if (data.bi_charbpos == bi_string_zv) + else if (data.byte_charpos == byte_string_zv) goto done; else { Lisp_Object entry = Qnil; /* Get the character at the current buffer position. */ - data.ch = XSTRING_CHAR (disp_string, data.bi_charbpos); + data.ch = string_emchar (disp_string, data.byte_charpos); if (!NILP (face_dt) || !NILP (window_dt)) entry = display_table_entry (data.ch, face_dt, window_dt); @@ -4914,7 +4922,7 @@ goto done; } - INC_CHARBYTEBPOS (XSTRING_DATA (disp_string), data.bi_charbpos); + INC_BYTECOUNT (XSTRING_DATA (disp_string), data.byte_charpos); } } @@ -4922,14 +4930,14 @@ /* Determine the starting point of the next line if we did not hit the end of the buffer. */ - if (data.bi_charbpos < bi_string_zv) + if (data.byte_charpos < byte_string_zv) { /* #### This check is not correct. If the line terminated due to a begin-glyph or end-glyph hitting window-end, then - data.ch will not point to the character at data.bi_charbpos. If + data.ch will not point to the character at data.byte_charpos. If you make the two changes mentioned at the top of this loop, you should be able to say '(if (*prop))'. That should also - make it possible to eliminate the data.bi_charbpos < BI_BUF_ZV (b) + make it possible to eliminate the data.byte_charpos < BYTE_BUF_ZV (b) check. */ /* The common case is that the line ended because we hit a newline. @@ -4937,7 +4945,7 @@ position. */ if (data.ch == '\n') { - INC_CHARBYTEBPOS (XSTRING_DATA (disp_string), data.bi_charbpos); + INC_BYTECOUNT (XSTRING_DATA (disp_string), data.byte_charpos); } /* Otherwise we have a buffer line which cannot fit on one display @@ -4957,14 +4965,14 @@ if (truncate_win) { - Bytebpos bi_pos; + Bytecount byte_pos; /* Now find the start of the next line. */ - bi_pos = bi_find_next_emchar_in_string (disp_string, '\n', - data.bi_charbpos, 1); + byte_pos = byte_find_next_emchar_in_string (disp_string, '\n', + data.byte_charpos, 1); data.cursor_type = NO_CURSOR; - data.bi_charbpos = bi_pos; + data.byte_charpos = byte_pos; gb.glyph = Vtruncation_glyph; cachel = GLYPH_CACHEL (w, TRUN_GLYPH_INDEX); } @@ -4973,7 +4981,7 @@ /* The cursor can never be on the continuation glyph. */ data.cursor_type = NO_CURSOR; - /* data.bi_charbpos is already at the start of the next line. */ + /* data.byte_charpos is already at the start of the next line. */ dl->line_continuation = 1; gb.glyph = Vcontinuation_glyph; @@ -4983,20 +4991,20 @@ if (data.end_glyph_width) add_glyph_rune (&data, &gb, BEGIN_GLYPHS, 0, cachel); - if (truncate_win && data.bi_charbpos == bi_string_zv) + if (truncate_win && data.byte_charpos == byte_string_zv) { const Intbyte *endb = charptr_n_addr (XSTRING_DATA (disp_string), - bi_string_zv); + byte_string_zv); DEC_CHARPTR (endb); if (charptr_emchar (endb) != '\n') { /* #### Damn this losing shit. */ - data.bi_charbpos++; + data.byte_charpos++; } } } } - else if (data.bi_charbpos == bi_string_zv) + else if (data.byte_charpos == byte_string_zv) { /* create_text_block () adds a bogus \n marker here which screws up subwindow display. Since we never have a cursor in the @@ -5082,22 +5090,22 @@ dl->cursor_elt = data.cursor_x; /* #### lossage lossage lossage! Fix this shit! */ - if (data.bi_charbpos > bi_string_zv) - dl->end_charbpos = buffer_or_string_bytebpos_to_charbpos (disp_string, - bi_string_zv); + if (data.byte_charpos > byte_string_zv) + dl->end_charpos = buffer_or_string_bytexpos_to_charxpos (disp_string, + byte_string_zv); else - dl->end_charbpos = - buffer_or_string_bytebpos_to_charbpos (disp_string, - data.bi_charbpos) - 1; + dl->end_charpos = + buffer_or_string_bytexpos_to_charxpos (disp_string, + data.byte_charpos) - 1; if (truncate_win) data.dl->num_chars = - string_column_at_point (disp_string, dl->end_charbpos, + string_column_at_point (disp_string, dl->end_charpos, b ? XINT (b->tab_width) : 8); else /* This doesn't correctly take into account tabs and control characters but if the window isn't being truncated then this value isn't going to end up being used anyhow. */ - data.dl->num_chars = dl->end_charbpos - dl->charbpos; + data.dl->num_chars = dl->end_charpos - dl->charpos; /* #### handle horizontally scrolled line with text none of which was actually laid out. */ @@ -5120,11 +5128,11 @@ The main loop should get fixed so that it isn't necessary to call this function if we are already at EOB. */ - if (data.bi_charbpos == bi_string_zv && bi_start_pos == bi_string_zv) + if (data.byte_charpos == byte_string_zv && byte_start_pos == byte_string_zv) return string_index_byte_to_char (disp_string, - data.bi_charbpos) + 1; /* Yuck! */ + data.byte_charpos) + 1; /* Yuck! */ else - return string_index_byte_to_char (disp_string, data.bi_charbpos); + return string_index_byte_to_char (disp_string, data.byte_charpos); } /* Given a display line and a starting position, ensure that the @@ -5141,11 +5149,11 @@ static Charbpos generate_string_display_line (struct window *w, Lisp_Object disp_string, struct display_line *dl, - Charbpos start_pos, + Charcount start_pos, prop_block_dynarr **prop, face_index default_face) { - Charbpos ret_charbpos; + Charcount ret_charcount; /* you must set bounds before calling this. */ @@ -5167,11 +5175,11 @@ dl->modeline = 0; /* Create a display block for the text region of the line. */ - ret_charbpos = create_string_text_block (w, disp_string, dl, start_pos, - prop, default_face); - dl->charbpos = start_pos; - if (dl->end_charbpos < dl->charbpos) - dl->end_charbpos = dl->charbpos; + ret_charcount = create_string_text_block (w, disp_string, dl, start_pos, + prop, default_face); + dl->charpos = start_pos; + if (dl->end_charpos < dl->charpos) + dl->end_charpos = dl->charpos; /* If there are left glyphs associated with any character in the text block, then create a display block to handle them. */ @@ -5183,7 +5191,7 @@ if (dl->right_glyphs != NULL && Dynarr_length (dl->right_glyphs)) create_right_glyph_block (w, dl); - return ret_charbpos; + return ret_charcount; } /* This is ripped off from regenerate_window. All we want to do is @@ -5193,7 +5201,7 @@ generate_displayable_area (struct window *w, Lisp_Object disp_string, int xpos, int ypos, int width, int height, display_line_dynarr* dla, - Charbpos start_pos, + Charcount start_pos, face_index default_face) { int yend = ypos + height; @@ -5209,7 +5217,7 @@ if (NILP (disp_string)) return; - s_zv = XSTRING_CHAR_LENGTH (disp_string); + s_zv = string_char_length (disp_string); bounds.left_out = xpos; bounds.right_out = xpos + width; @@ -5225,7 +5233,7 @@ { struct display_line dl; struct display_line *dlp; - Charbpos next_pos; + Charcount next_pos; int local; if (Dynarr_length (dla) < Dynarr_largest (dla)) @@ -5490,39 +5498,39 @@ } } -#define REGEN_INC_FIND_START_END \ - do { \ - /* Determine start and end of lines. */ \ - if (!Dynarr_length (cdla)) \ - return 0; \ - else \ - { \ +#define REGEN_INC_FIND_START_END \ + do { \ + /* Determine start and end of lines. */ \ + if (!Dynarr_length (cdla)) \ + return 0; \ + else \ + { \ if (Dynarr_atp (cdla, 0)->modeline && Dynarr_atp (ddla, 0)->modeline) \ - { \ - dla_start = 1; \ - } \ - else if (!Dynarr_atp (cdla, 0)->modeline \ - && !Dynarr_atp (ddla, 0)->modeline) \ - { \ - dla_start = 0; \ - } \ - else \ - abort (); /* structs differ */ \ - \ - dla_end = Dynarr_length (cdla) - 1; \ - } \ - \ - start_pos = (Dynarr_atp (cdla, dla_start)->charbpos \ - + Dynarr_atp (cdla, dla_start)->offset); \ - /* If this isn't true, then startp has changed and we need to do a \ - full regen. */ \ - if (startp != start_pos) \ - return 0; \ - \ - /* Point is outside the visible region so give up. */ \ - if (pointm < start_pos) \ - return 0; \ - \ + { \ + dla_start = 1; \ + } \ + else if (!Dynarr_atp (cdla, 0)->modeline \ + && !Dynarr_atp (ddla, 0)->modeline) \ + { \ + dla_start = 0; \ + } \ + else \ + abort (); /* structs differ */ \ + \ + dla_end = Dynarr_length (cdla) - 1; \ + } \ + \ + start_pos = (Dynarr_atp (cdla, dla_start)->charpos \ + + Dynarr_atp (cdla, dla_start)->offset); \ + /* If this isn't true, then startp has changed and we need to do a \ + full regen. */ \ + if (startp != start_pos) \ + return 0; \ + \ + /* Point is outside the visible region so give up. */ \ + if (pointm < start_pos) \ + return 0; \ + \ } while (0) /* This attempts to incrementally update the display structures. It @@ -5610,8 +5618,8 @@ while (line <= dla_end) { struct display_line *dl = Dynarr_atp (cdla, line); - Charbpos lstart = dl->charbpos + dl->offset; - Charbpos lend = dl->end_charbpos + dl->offset; + Charbpos lstart = dl->charpos + dl->offset; + Charbpos lend = dl->end_charpos + dl->offset; if (beg_unchanged >= lstart && beg_unchanged <= lend) break; @@ -5651,14 +5659,14 @@ struct display_block *db; int initial_size; - assert (cdl->charbpos == ddl->charbpos); - assert (cdl->end_charbpos == ddl->end_charbpos); + assert (cdl->charpos == ddl->charpos); + assert (cdl->end_charpos == ddl->end_charpos); assert (cdl->offset == ddl->offset); db = get_display_block_from_line (ddl, TEXT); initial_size = Dynarr_length (db->runes); - old_start = ddl->charbpos + ddl->offset; - old_end = ddl->end_charbpos + ddl->offset; + old_start = ddl->charpos + ddl->offset; + old_end = ddl->end_charpos + ddl->offset; /* If this is the first line being updated and it used propagation data, fail. Otherwise we'll be okay because @@ -5666,7 +5674,7 @@ if (line == first_line && ddl->used_prop_data) return 0; - new_start = generate_display_line (w, ddl, 0, ddl->charbpos + ddl->offset, + new_start = generate_display_line (w, ddl, 0, ddl->charpos + ddl->offset, &prop, DESIRED_DISP); ddl->offset = 0; @@ -5689,8 +5697,8 @@ || cdl->top_clip != ddl->top_clip || (cdl->cursor_elt != -1 && ddl->cursor_elt == -1) || (cdl->cursor_elt == -1 && ddl->cursor_elt != -1) - || old_start != ddl->charbpos - || old_end != ddl->end_charbpos + || old_start != ddl->charpos + || old_end != ddl->end_charpos || initial_size != Dynarr_length (db->runes)) { return 0; @@ -5706,7 +5714,7 @@ /* If the extent changes end on the line we just updated then we're done. Otherwise go on to the next line. */ - if (end_unchanged <= ddl->end_charbpos) + if (end_unchanged <= ddl->end_charpos) break; else line++; @@ -5777,8 +5785,8 @@ while (line <= dla_end) { struct display_line *dl = Dynarr_atp (cdla, line); - Charbpos lstart = dl->charbpos + dl->offset; - Charbpos lend = dl->end_charbpos + dl->offset; + Charbpos lstart = dl->charpos + dl->offset; + Charbpos lend = dl->end_charpos + dl->offset; if (beg_unchanged >= lstart && beg_unchanged <= lend) break; @@ -5806,8 +5814,8 @@ struct display_line *cdl = Dynarr_atp (cdla, line); struct display_line *ddl = Dynarr_atp (ddla, line); - assert (cdl->charbpos == ddl->charbpos); - assert (cdl->end_charbpos == ddl->end_charbpos); + assert (cdl->charpos == ddl->charpos); + assert (cdl->end_charpos == ddl->end_charpos); assert (cdl->offset == ddl->offset); /* If the line continues to next display line, fail. */ @@ -5818,7 +5826,7 @@ if (ddl->used_prop_data) return 0; - new_start = generate_display_line (w, ddl, 0, ddl->charbpos + ddl->offset, + new_start = generate_display_line (w, ddl, 0, ddl->charpos + ddl->offset, &prop, DESIRED_DISP); ddl->offset = 0; @@ -5848,7 +5856,7 @@ /* If the changed area also ends on this line, then we may be in business. Update everything and return success. */ - if (end_unchanged >= ddl->charbpos && end_unchanged <= ddl->end_charbpos) + if (end_unchanged >= ddl->charpos && end_unchanged <= ddl->end_charpos) { w->last_modified[DESIRED_DISP] = make_int (BUF_MODIFF (b)); w->last_facechange[DESIRED_DISP] = make_int (BUF_FACECHANGE (b)); @@ -5893,8 +5901,8 @@ the line because we checked before entering the loop. */ if (extent_beg_unchanged != -1 && extent_end_unchanged != -1 - && ((extent_beg_unchanged < ddl->charbpos) - || (extent_end_unchanged > ddl->end_charbpos))) + && ((extent_beg_unchanged < ddl->charpos) + || (extent_end_unchanged > ddl->end_charpos))) return regenerate_window_extents_only_changed (w, startp, pointm, extent_beg_unchanged, extent_end_unchanged); @@ -5947,7 +5955,7 @@ Charbpos start, end; struct display_line *dl = Dynarr_atp (dla, first_line); - start = dl->charbpos; + start = dl->charpos; end = BUF_Z (b) - w->window_end_pos[type] - 1; if (point >= start && point <= end) @@ -5956,8 +5964,8 @@ { dl = Dynarr_atp (dla, Dynarr_length (dla) - 1); - if (point >= (dl->charbpos + dl->offset) - && point <= (dl->end_charbpos + dl->offset)) + if (point >= (dl->charpos + dl->offset) + && point <= (dl->end_charpos + dl->offset)) return !dl->clip; else return 1; @@ -6028,7 +6036,7 @@ display_line_dynarr *dla = window_display_lines (w, type); struct display_line *dl = Dynarr_atp (dla, line); - return dl->charbpos; + return dl->charpos; } } @@ -7377,8 +7385,8 @@ { struct line_start_cache lsc; - lsc.start = dl->charbpos; - lsc.end = dl->end_charbpos; + lsc.start = dl->charpos; + lsc.end = dl->end_charpos; lsc.height = dl->ascent + dl->descent; Dynarr_add (internal_cache, lsc); @@ -8433,7 +8441,7 @@ d->pixel_to_glyph_cache.obj_x = *obj_x; \ d->pixel_to_glyph_cache.obj_y = *obj_y; \ d->pixel_to_glyph_cache.w = *w; \ - d->pixel_to_glyph_cache.charbpos = *charbpos; \ + d->pixel_to_glyph_cache.charpos = *charpos; \ d->pixel_to_glyph_cache.closest = *closest; \ d->pixel_to_glyph_cache.modeline_closest = *modeline_closest; \ d->pixel_to_glyph_cache.obj1 = *obj1; \ @@ -8477,7 +8485,7 @@ int pixel_to_glyph_translation (struct frame *f, int x_coord, int y_coord, int *col, int *row, int *obj_x, int *obj_y, - struct window **w, Charbpos *charbpos, + struct window **w, Charbpos *charpos, Charbpos *closest, Charcount *modeline_closest, Lisp_Object *obj1, Lisp_Object *obj2) { @@ -8516,7 +8524,7 @@ *obj_x = cache->obj_x; *obj_y = cache->obj_y; *w = cache->w; - *charbpos = cache->charbpos; + *charpos = cache->charpos; *closest = cache->closest; *modeline_closest = cache->modeline_closest; *obj1 = cache->obj1; @@ -8531,7 +8539,7 @@ *obj_x = 0; *obj_y = 0; *w = 0; - *charbpos = 0; + *charpos = 0; *closest = 0; *modeline_closest = -1; *obj1 = Qnil; @@ -8758,20 +8766,20 @@ if (x_check <= left_bound) { if (dl->modeline) - *modeline_closest = Dynarr_atp (db->runes, 0)->charbpos; + *modeline_closest = Dynarr_atp (db->runes, 0)->charpos; else - *closest = Dynarr_atp (db->runes, 0)->charbpos; + *closest = Dynarr_atp (db->runes, 0)->charpos; } else { if (dl->modeline) *modeline_closest = Dynarr_atp (db->runes, - Dynarr_length (db->runes) - 1)->charbpos; + Dynarr_length (db->runes) - 1)->charpos; else *closest = Dynarr_atp (db->runes, - Dynarr_length (db->runes) - 1)->charbpos; + Dynarr_length (db->runes) - 1)->charpos; } if (dl->modeline) @@ -8826,7 +8834,7 @@ rb = Dynarr_atp (db->runes, *col); } - *charbpos = rb->charbpos + dl->offset; + *charpos = rb->charpos + dl->offset; low_x_coord = rb->xpos; high_x_coord = rb->xpos + rb->width; @@ -8841,11 +8849,11 @@ { if (dl->modeline) *modeline_closest = - (Dynarr_atp (db->runes, elt)->charbpos + + (Dynarr_atp (db->runes, elt)->charpos + dl->offset); else *closest = - (Dynarr_atp (db->runes, elt)->charbpos + + (Dynarr_atp (db->runes, elt)->charpos + dl->offset); break; } @@ -8859,18 +8867,18 @@ if (elt == Dynarr_length (db->runes)) { if (dl->modeline) - *modeline_closest = dl->end_charbpos + dl->offset; + *modeline_closest = dl->end_charpos + dl->offset; else - *closest = dl->end_charbpos + dl->offset; + *closest = dl->end_charpos + dl->offset; really_over_nothing = 1; } } else { if (dl->modeline) - *modeline_closest = rb->charbpos + dl->offset; + *modeline_closest = rb->charpos + dl->offset; else - *closest = rb->charbpos + dl->offset; + *closest = rb->charpos + dl->offset; } if (dl->modeline)
--- a/src/redisplay.h Thu May 02 14:35:32 2002 +0000 +++ b/src/redisplay.h Sun May 05 11:33:57 2002 +0000 @@ -1,7 +1,7 @@ /* Redisplay data structures. Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. Copyright (C) 1996 Chuck Thompson. - Copyright (C) 1995, 1996 Ben Wing. + Copyright (C) 1995, 1996, 2002 Ben Wing. This file is part of XEmacs. @@ -112,15 +112,14 @@ each of the face properties in this particular window. */ - Charbpos charbpos; /* buffer position this rune is displaying; + Charxpos charpos; /* buffer position this rune is displaying; for the modeline, the value here is a Charcount, but who's looking? */ - Charbpos endpos; /* if set this rune covers a range of pos */ + Charxpos endpos; /* if set this rune covers a range of pos; + used in redisplay_move_cursor(). */ /* #### Chuck, what does it mean for a rune to cover a range of pos? I don't get this. */ - /* #### This isn't used as an rvalue anywhere! - remove! */ short xpos; /* horizontal starting position in pixels */ @@ -258,9 +257,9 @@ /* display lines */ /*************************************************************************/ -/* Modeline commentary: IMO the modeline is handled very badly, we +/* Modeline commentary: IMO the modeline is handled very badly, we special case virtually *everything* in the redisplay routines for - the modeline. The fact that dl->charbpos can be either a buffer + the modeline. The fact that dl->charpos can be either a buffer position or a char count highlights this. There is no abstraction at all that I can find and it means that the code is made very ugly as a result. Either we should treat the modeline *entirely* separately, @@ -296,9 +295,9 @@ in pixels.*/ unsigned short top_clip; /* amount of top of line to clip in pixels.*/ - Charbpos charbpos; /* first buffer position on line */ - Charbpos end_charbpos; /* last buffer position on line */ - Charcount offset; /* adjustment to charbpos vals */ + Charxpos charpos; /* first buffer position on line */ + Charxpos end_charpos; /* last buffer position on line */ + Charcount offset; /* adjustment to charpos vals */ Charcount num_chars; /* # of chars on line including expansion of tabs and control chars */ @@ -386,13 +385,13 @@ }; /* NOTE NOTE NOTE: Currently the positions in an extent fragment - structure are Bytebpos's, not Charbpos's. This could change. */ + structure are Bytexpos's, not Charxpos's. This could change. */ struct extent_fragment { Lisp_Object object; /* buffer or string */ struct frame *frm; - Bytebpos pos, end; + Bytexpos pos, end; EXTENT_dynarr *extents; glyph_block_dynarr *begin_glyphs, *end_glyphs; unsigned int invisible:1; @@ -698,8 +697,9 @@ layout_bounds calculate_display_line_boundaries (struct window *w, int modeline); Charbpos point_at_center (struct window *w, int type, Charbpos start, - Charbpos point); -int line_at_center (struct window *w, int type, Charbpos start, Charbpos point); + Charbpos point); +int line_at_center (struct window *w, int type, Charbpos start, + Charbpos point); int window_half_pixpos (struct window *w); void redisplay_echo_area (void); void free_display_structs (struct window_mirror *mir); @@ -729,13 +729,13 @@ int point_in_line_start_cache (struct window *w, Charbpos point, int min_past); int point_would_be_visible (struct window *w, Charbpos startp, - Charbpos point); + Charbpos point); Charbpos start_of_last_line (struct window *w, Charbpos startp); Charbpos end_of_last_line (struct window *w, Charbpos startp); Charbpos start_with_line_at_pixpos (struct window *w, Charbpos point, - int pixpos); + int pixpos); Charbpos start_with_point_on_display_line (struct window *w, Charbpos point, - int line); + int line); int redisplay_variable_changed (Lisp_Object sym, Lisp_Object *val, Lisp_Object in_object, int flags); void redisplay_glyph_changed (Lisp_Object glyph, Lisp_Object property,
--- a/src/regex.c Thu May 02 14:35:32 2002 +0000 +++ b/src/regex.c Sun May 05 11:33:57 2002 +0000 @@ -24,17 +24,6 @@ /* Synched up with: FSF 19.29. */ -/* Changes made for XEmacs: - - (1) the REGEX_BEGLINE_CHECK code from the XEmacs v18 regex routines - was added. This causes a huge speedup in font-locking. - (2) Rel-alloc is disabled when the MMAP version of rel-alloc is - being used, because it's too slow -- all those calls to mmap() - add humongous overhead. - (3) Lots and lots of changes for Mule. They are bracketed by - `#ifdef MULE' or with comments that have `XEmacs' in them. - */ - #ifdef HAVE_CONFIG_H #include <config.h> #endif @@ -47,14 +36,6 @@ #define _GNU_SOURCE 1 #endif -#ifdef emacs -/* Converts the pointer to the char to BEG-based offset from the start. */ -#define PTR_TO_OFFSET(d) (MATCHING_IN_FIRST_STRING \ - ? (d) - string1 : (d) - (string2 - size1)) -#else -#define PTR_TO_OFFSET(d) 0 -#endif - /* We assume non-Mule if emacs isn't defined. */ #ifndef emacs #undef MULE @@ -120,9 +101,31 @@ #endif /* MULE */ -#define RE_TRANSLATE(ch) TRT_TABLE_OF (translate, (Emchar) ch) +#define RE_TRANSLATE_1(ch) TRT_TABLE_OF (translate, (Emchar) ch) #define TRANSLATE_P(tr) (!NILP (tr)) +/* Converts the pointer to the char to BEG-based offset from the start. */ +#define PTR_TO_OFFSET(d) (MATCHING_IN_FIRST_STRING \ + ? (d) - string1 : (d) - (string2 - size1)) + +/* Convert an offset from the start of the logical text string formed by + concatenating the two strings together into a character position in the + Lisp buffer or string that the text represents. Knows that + when handling buffer text, the "string" we're passed in is always + BEGV - ZV. */ + +static Charxpos +offset_to_charxpos (Lisp_Object lispobj, int off) +{ + if (STRINGP (lispobj)) + return string_index_byte_to_char (lispobj, off); + else if (BUFFERP (lispobj)) + return bytebpos_to_charbpos (XBUFFER (lispobj), + off + BYTE_BUF_BEGV (XBUFFER (lispobj))); + else + return 0; +} + #else /* not emacs */ /* If we are not linking with Emacs proper, @@ -139,7 +142,9 @@ #include <stdlib.h> -#define charptr_emchar(str) ((Emchar) (str)[0]) +#define charptr_emchar(str) ((Emchar) (str)[0]) +#define charptr_emchar_fmt(str, fmt, object) ((Emchar) (str)[0]) +#define charptr_emchar_ascii_fmt(str, fmt, object) ((Emchar) (str)[0]) #if (LONGBITS > INTBITS) # define EMACS_INT long @@ -150,7 +155,11 @@ typedef int Emchar; #define INC_CHARPTR(p) ((p)++) +#define INC_CHARPTR_FMT(p, fmt) ((p)++) #define DEC_CHARPTR(p) ((p)--) +#define DEC_CHARPTR_FMT(p, fmt) ((p)--) +#define charptr_emchar_len(ptr) 1 +#define charptr_emchar_len_fmt(ptr, fmt) 1 #include <string.h> @@ -194,11 +203,11 @@ #endif /* SYNTAX_TABLE */ -#define SYNTAX_UNSAFE(ignored, c) re_syntax_table[c] +#define SYNTAX(ignored, c) re_syntax_table[c] #undef SYNTAX_FROM_CACHE -#define SYNTAX_FROM_CACHE SYNTAX_UNSAFE - -#define RE_TRANSLATE(c) translate[(unsigned char) (c)] +#define SYNTAX_FROM_CACHE SYNTAX + +#define RE_TRANSLATE_1(c) translate[(unsigned char) (c)] #define TRANSLATE_P(tr) tr #endif /* emacs */ @@ -1140,19 +1149,19 @@ matching calls, which it leaves unprotected, in the faith that they will not malloc.]] This previous paragraph is irrelevant. - XEmacs: We *do not* do anything so stupid as process input from - within a signal handler. However, the regexp routines may get - called reentrantly as a result of QUIT processing (e.g. under - Windows: re_match -> QUIT -> quit_p -> drain events -> process - WM_INITMENU -> call filter -> re_match), so we cannot have any - global variables (unless we do lots of trickiness including some + XEmacs: We *do not* do anything so stupid as process input from within a + signal handler. However, the regexp routines may get called reentrantly + as a result of QUIT processing (e.g. under Windows: re_match -> QUIT -> + quit_p -> drain events -> process WM_INITMENU -> call filter -> + re_match; see stack trace in signal.c), so we cannot have any global + variables (unless we do lots of trickiness including some unwind-protects, which isn't worth it at this point). The first paragraph appears utterly garbled to me -- shouldn't *ANY* use of - rel-alloc to different potentially cause buffer data to be - relocated? I must be missing something, though -- perhaps the - writer above is assuming that the failure stack(s) will always be - allocated after the buffer data, and thus reallocating them with - rel-alloc won't move buffer data. --ben */ + rel-alloc to different potentially cause buffer data to be relocated? I + must be missing something, though -- perhaps the writer above is + assuming that the failure stack(s) will always be allocated after the + buffer data, and thus reallocating them with rel-alloc won't move buffer + data. --ben */ /* Normally, this is fine. */ #define MATCH_MAY_ALLOCATE @@ -1574,13 +1583,11 @@ /* Subroutine declarations and macros for regex_compile. */ /* Fetch the next character in the uncompiled pattern---translating it - if necessary. Also cast from a signed character in the constant - string passed to us by the user to an unsigned char that we can use - as an array index (in, e.g., `translate'). */ + if necessary. */ #define PATFETCH(c) \ do { \ PATFETCH_RAW (c); \ - c = TRANSLATE (c); \ + c = RE_TRANSLATE (c); \ } while (0) /* Fetch the next character in the uncompiled pattern, with no @@ -1595,70 +1602,12 @@ /* Go backwards one character in the pattern. */ #define PATUNFETCH DEC_CHARPTR (p) -#ifdef MULE - -#define PATFETCH_EXTENDED(emch) \ - do {if (p == pend) return REG_EEND; \ - assert (p < pend); \ - emch = charptr_emchar ((const Intbyte *) p); \ - INC_CHARPTR (p); \ - if (TRANSLATE_P (translate) && emch < 0x80) \ - emch = (Emchar) (unsigned char) RE_TRANSLATE (emch); \ - } while (0) - -#define PATFETCH_RAW_EXTENDED(emch) \ - do {if (p == pend) return REG_EEND; \ - assert (p < pend); \ - emch = charptr_emchar ((const Intbyte *) p); \ - INC_CHARPTR (p); \ - } while (0) - -#define PATUNFETCH_EXTENDED DEC_CHARPTR (p) - -#define PATFETCH_EITHER(emch) \ - do { \ - if (has_extended_chars) \ - PATFETCH_EXTENDED (emch); \ - else \ - PATFETCH (emch); \ - } while (0) - -#define PATFETCH_RAW_EITHER(emch) \ - do { \ - if (has_extended_chars) \ - PATFETCH_RAW_EXTENDED (emch); \ - else \ - PATFETCH_RAW (emch); \ - } while (0) - -#define PATUNFETCH_EITHER \ - do { \ - if (has_extended_chars) \ - PATUNFETCH_EXTENDED (emch); \ - else \ - PATUNFETCH (emch); \ - } while (0) - -#else /* not MULE */ - -#define PATFETCH_EITHER(emch) PATFETCH (emch) -#define PATFETCH_RAW_EITHER(emch) PATFETCH_RAW (emch) -#define PATUNFETCH_EITHER PATUNFETCH - -#endif /* MULE */ - /* If `translate' is non-null, return translate[D], else just D. We cast the subscript to translate because some data is declared as `char *', to avoid warnings when a string constant is passed. But when we use a character as a subscript we must make it unsigned. */ -#define TRANSLATE(d) (TRANSLATE_P (translate) ? RE_TRANSLATE (d) : (d)) - -#ifdef MULE - -#define TRANSLATE_EXTENDED_UNSAFE(emch) \ - (TRANSLATE_P (translate) && emch < 0x80 ? RE_TRANSLATE (emch) : (emch)) - -#endif +#define RE_TRANSLATE(d) \ + (TRANSLATE_P (translate) ? RE_TRANSLATE_1 (d) : (d)) /* Macros for outputting the compiled pattern into `buffer'. */ @@ -1729,7 +1678,7 @@ being larger than MAX_BUF_SIZE, then flag memory exhausted. */ #define EXTEND_BUFFER() \ do { \ - re_char *old_buffer = bufp->buffer; \ + re_char *old_buffer = bufp->buffer; \ if (bufp->allocated == MAX_BUF_SIZE) \ return REG_ESIZE; \ bufp->allocated <<= 1; \ @@ -1883,12 +1832,17 @@ static re_bool common_op_match_null_string_p (unsigned char **p, unsigned char *end, register_info_type *reg_info); -static int bcmp_translate (const unsigned char *s1, const unsigned char *s2, - REGISTER int len, RE_TRANSLATE_TYPE translate); +static int bcmp_translate (re_char *s1, re_char *s2, + REGISTER int len, RE_TRANSLATE_TYPE translate +#ifdef emacs + , Internal_Format fmt, Lisp_Object lispobj +#endif + ); static int re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, int size1, re_char *string2, int size2, int pos, - struct re_registers *regs, int stop); + struct re_registers *regs, int stop + RE_LISP_CONTEXT_ARGS_DECL); #ifndef MATCH_MAY_ALLOCATE @@ -3182,7 +3136,7 @@ /* You might think it would be useful for \ to mean not to translate; but if we don't translate it, it will never match anything. */ - c = TRANSLATE (c); + c = RE_TRANSLATE (c); goto normal_char; } break; @@ -3439,7 +3393,10 @@ Return an error code. We use these short variable names so we can use the same macros as - `regex_compile' itself. */ + `regex_compile' itself. + + Under Mule, this is only called when both chars of the range are + ASCII. */ static reg_errcode_t compile_range (re_char **p_ptr, re_char *pend, RE_TRANSLATE_TYPE translate, @@ -3478,7 +3435,7 @@ loop, since all characters <= 0xff. */ for (this_char = range_start; this_char <= range_end; this_char++) { - SET_LIST_BIT (TRANSLATE (this_char)); + SET_LIST_BIT (RE_TRANSLATE (this_char)); } return REG_NOERROR; @@ -3514,15 +3471,13 @@ ranges entirely within the first 256 chars. */ if ((range_start >= 0x100 || range_end >= 0x100) - && CHAR_LEADING_BYTE (range_start) != - CHAR_LEADING_BYTE (range_end)) + && emchar_leading_byte (range_start) != + emchar_leading_byte (range_end)) return REG_ERANGESPAN; - /* As advertised, translations only work over the 0 - 0x7F range. - Making this kind of stuff work generally is much harder. - Iterating over the whole range like this would be way efficient - if the range encompasses 10,000 chars or something. You'd have - to do something like this: + /* #### This might be way inefficient if the range encompasses 10,000 + chars or something. To be efficient, you'd have to do something like + this: range_table a; range_table b; @@ -3533,10 +3488,9 @@ compute the union of a, b union the result into rtab */ - for (this_char = range_start; - this_char <= range_end && this_char < 0x80; this_char++) + for (this_char = range_start; this_char <= range_end; this_char++) { - SET_RANGETAB_BIT (TRANSLATE (this_char)); + SET_RANGETAB_BIT (RE_TRANSLATE (this_char)); } if (this_char <= range_end) @@ -3561,7 +3515,8 @@ Returns 0 if we succeed, -2 if an internal error. */ int -re_compile_fastmap (struct re_pattern_buffer *bufp) +re_compile_fastmap (struct re_pattern_buffer *bufp + RE_LISP_SHORT_CONTEXT_ARGS_DECL) { int j, k; #ifdef MATCH_MAY_ALLOCATE @@ -3570,6 +3525,9 @@ DECLARE_DESTINATION; /* We don't push any register information onto the failure stack. */ + /* &&#### this should be changed for 8-bit-fixed, for efficiency. see + comment marked with &&#### in re_search_2. */ + REGISTER char *fastmap = bufp->fastmap; unsigned char *pattern = bufp->buffer; long size = bufp->used; @@ -3732,34 +3690,6 @@ #endif /* MULE */ - case wordchar: -#ifdef emacs - k = (int) Sword; - goto matchsyntax; -#else - for (j = 0; j < (1 << BYTEWIDTH); j++) - if (SYNTAX_UNSAFE - (XCHAR_TABLE - (regex_emacs_buffer->mirror_syntax_table), j) == Sword) - fastmap[j] = 1; - break; -#endif - - - case notwordchar: -#ifdef emacs - k = (int) Sword; - goto matchnotsyntax; -#else - for (j = 0; j < (1 << BYTEWIDTH); j++) - if (SYNTAX_UNSAFE - (XCHAR_TABLE - (regex_emacs_buffer->mirror_syntax_table), j) != Sword) - fastmap[j] = 1; - break; -#endif - - case anychar: { int fastmap_newline = fastmap['\n']; @@ -3788,7 +3718,21 @@ break; } -#ifdef emacs +#ifndef emacs + case wordchar: + for (j = 0; j < (1 << BYTEWIDTH); j++) + if (SYNTAX (ignored, j) == Sword) + fastmap[j] = 1; + break; + + case notwordchar: + for (j = 0; j < (1 << BYTEWIDTH); j++) + if (SYNTAX (ignored, j) != Sword) + fastmap[j] = 1; + break; +#else /* emacs */ + case wordchar: + case notwordchar: case wordbound: case notwordbound: case wordbeg: @@ -3799,23 +3743,30 @@ aborting optimizations. */ bufp->can_be_null = 1; goto done; - -#ifdef emacs -#if 0 /* Removed during syntax-table properties patch -- 2000/12/07 mct */ +#if 0 /* all of the following code is unused now that the `syntax-table' + property exists -- it's trickier to do this than just look in + the buffer. &&#### but we could just use the syntax-cache stuff + instead; why don't we? --ben */ + case wordchar: + k = (int) Sword; + goto matchsyntax; + + case notwordchar: + k = (int) Sword; + goto matchnotsyntax; + case syntaxspec: k = *p++; -#endif - matchsyntax: + matchsyntax: #ifdef MULE for (j = 0; j < 0x80; j++) - if (SYNTAX_UNSAFE - (XCHAR_TABLE - (regex_emacs_buffer->mirror_syntax_table), j) == + if (SYNTAX + (XCHAR_TABLE (BUFFER_MIRROR_SYNTAX_TABLE (lispbuf)), j) == (enum syntaxcode) k) fastmap[j] = 1; for (j = 0x80; j < 0xA0; j++) { - if (LEADING_BYTE_PREFIX_P((unsigned char) j)) + if (leading_byte_prefix_p ((unsigned char) j)) /* too complicated to calculate this right */ fastmap[j] = 1; else @@ -3823,11 +3774,10 @@ int multi_p; Lisp_Object cset; - cset = CHARSET_BY_LEADING_BYTE (j); + cset = charset_by_leading_byte (j); if (CHARSETP (cset)) { - if (charset_syntax (regex_emacs_buffer, cset, - &multi_p) + if (charset_syntax (lispbuf, cset, &multi_p) == Sword || multi_p) fastmap[j] = 1; } @@ -3835,30 +3785,27 @@ } #else /* not MULE */ for (j = 0; j < (1 << BYTEWIDTH); j++) - if (SYNTAX_UNSAFE - (XCHAR_TABLE - (regex_emacs_buffer->mirror_syntax_table), j) == + if (SYNTAX + (XCHAR_TABLE (BUFFER_MIRROR_SYNTAX_TABLE (lispbuf)), j) == (enum syntaxcode) k) fastmap[j] = 1; #endif /* MULE */ break; -#if 0 /* Removed during syntax-table properties patch -- 2000/12/07 mct */ case notsyntaxspec: k = *p++; -#endif - matchnotsyntax: + matchnotsyntax: #ifdef MULE for (j = 0; j < 0x80; j++) - if (SYNTAX_UNSAFE + if (SYNTAX (XCHAR_TABLE - (regex_emacs_buffer->mirror_syntax_table), j) != + (BUFFER_MIRROR_SYNTAX_TABLE (lispbuf)), j) != (enum syntaxcode) k) fastmap[j] = 1; for (j = 0x80; j < 0xA0; j++) { - if (LEADING_BYTE_PREFIX_P((unsigned char) j)) + if (leading_byte_prefix_p ((unsigned char) j)) /* too complicated to calculate this right */ fastmap[j] = 1; else @@ -3866,11 +3813,10 @@ int multi_p; Lisp_Object cset; - cset = CHARSET_BY_LEADING_BYTE (j); + cset = charset_by_leading_byte (j); if (CHARSETP (cset)) { - if (charset_syntax (regex_emacs_buffer, cset, - &multi_p) + if (charset_syntax (lispbuf, cset, &multi_p) != Sword || multi_p) fastmap[j] = 1; } @@ -3878,14 +3824,14 @@ } #else /* not MULE */ for (j = 0; j < (1 << BYTEWIDTH); j++) - if (SYNTAX_UNSAFE + if (SYNTAX (XCHAR_TABLE - (regex_emacs_buffer->mirror_syntax_table), j) != + (BUFFER_MIRROR_SYNTAX_TABLE (lispbuf)), j) != (enum syntaxcode) k) fastmap[j] = 1; #endif /* MULE */ break; -#endif /* emacs */ +#endif /* 0 */ #ifdef MULE /* 97/2/17 jhod category patch */ @@ -3898,13 +3844,11 @@ /* All cases after this match the empty string. These end with `continue'. */ - - case before_dot: case at_dot: case after_dot: continue; -#endif /* not emacs */ +#endif /* emacs */ case no_op: @@ -4074,33 +4018,27 @@ int re_search (struct re_pattern_buffer *bufp, const char *string, int size, - int startpos, int range, struct re_registers *regs) + int startpos, int range, struct re_registers *regs + RE_LISP_CONTEXT_ARGS_DECL) { return re_search_2 (bufp, NULL, 0, string, size, startpos, range, - regs, size); + regs, size RE_LISP_CONTEXT_ARGS); } -#ifndef emacs -/* Snarfed from src/lisp.h, needed for compiling [ce]tags. */ -# define bytecount_to_charcount(ptr, len) (len) -# define charcount_to_bytecount(ptr, len) (len) -typedef int Charcount; -#endif - /* Using the compiled pattern in BUFP->buffer, first tries to match the virtual concatenation of STRING1 and STRING2, starting first at index STARTPOS, then at STARTPOS + 1, and so on. - With MULE, STARTPOS is a byte position, not a char position. And the - search will increment STARTPOS by the width of the current leading - character. - STRING1 and STRING2 have length SIZE1 and SIZE2, respectively. RANGE is how far to scan while trying to match. RANGE = 0 means try only at STARTPOS; in general, the last start tried is STARTPOS + RANGE. + All sizes and positions refer to bytes (not chars); under Mule, the code + knows about the format of the text and will only check at positions + where a character starts. + With MULE, RANGE is a byte position, not a char position. The last start tried is the character starting <= STARTPOS + RANGE. @@ -4118,7 +4056,8 @@ int re_search_2 (struct re_pattern_buffer *bufp, const char *str1, int size1, const char *str2, int size2, int startpos, - int range, struct re_registers *regs, int stop) + int range, struct re_registers *regs, int stop + RE_LISP_CONTEXT_ARGS_DECL) { int val; re_char *string1 = (re_char *) str1; @@ -4131,7 +4070,12 @@ int anchored_at_begline = 0; #endif re_char *d; - Charcount d_size; +#ifdef emacs + Internal_Format fmt = buffer_or_other_internal_format (lispobj); +#endif /* emacs */ +#if 1 + int forward_search_p; +#endif /* Check for out-of-range STARTPOS. */ if (startpos < 0 || startpos > total_size) @@ -4144,6 +4088,10 @@ else if (endpos > total_size) range = total_size - startpos; +#if 1 + forward_search_p = range > 0; +#endif + /* If the search isn't to be a backwards one, don't waste time in a search for a pattern that must be anchored. */ if (bufp->used > 0 && (re_opcode_t) bufp->buffer[0] == begbuf && range > 0) @@ -4154,7 +4102,7 @@ { d = ((const unsigned char *) (startpos >= size1 ? string2 - size1 : string1) + startpos); - range = charcount_to_bytecount (d, 1); + range = charptr_emchar_len_fmt (d, fmt); } } @@ -4163,8 +4111,10 @@ don't keep searching past point. */ if (bufp->used > 0 && (re_opcode_t) bufp->buffer[0] == at_dot && range > 0) { - range = BUF_PT (regex_emacs_buffer) - BUF_BEGV (regex_emacs_buffer) - - startpos; + if (!BUFFERP (lispobj)) + return -1; + range = (BUF_PT (XBUFFER (lispobj)) - BUF_BEGV (XBUFFER (lispobj)) + - startpos); if (range < 0) return -1; } @@ -4172,7 +4122,7 @@ /* Update the fastmap now if not correct already. */ if (fastmap && !bufp->fastmap_accurate) - if (re_compile_fastmap (bufp) == -2) + if (re_compile_fastmap (bufp RE_LISP_SHORT_CONTEXT_ARGS) == -2) return -2; #ifdef REGEX_BEGLINE_CHECK @@ -4192,53 +4142,83 @@ #endif #ifdef emacs - SETUP_SYNTAX_CACHE_FOR_OBJECT (regex_match_object, - regex_emacs_buffer, - SYNTAX_CACHE_OBJECT_BYTE_TO_CHAR (regex_match_object, - regex_emacs_buffer, - startpos), - 1); + scache = setup_syntax_cache (scache, lispobj, lispbuf, + offset_to_charxpos (lispobj, startpos), + 1); #endif /* Loop through the string, looking for a place to start matching. */ for (;;) { #ifdef REGEX_BEGLINE_CHECK - /* If the regex is anchored at the beginning of a line (i.e. with a ^), - then we can speed things up by skipping to the next beginning-of- - line. */ - if (anchored_at_begline && startpos > 0 && startpos != size1 && - range > 0) + /* If the regex is anchored at the beginning of a line (i.e. with a + ^), then we can speed things up by skipping to the next + beginning-of-line. However, to determine "beginning of line" we + need to look at the previous char, so can't do this check if at + beginning of either string. (Well, we could if at the beginning of + the second string, but it would require additional code, and this + is just an optimization.) */ + if (anchored_at_begline && startpos > 0 && startpos != size1) { - /* whose stupid idea was it anyway to make this - function take two strings to match?? */ - int lim = 0; - int irange = range; - - if (startpos < size1 && startpos + range >= size1) - lim = range - (size1 - startpos); - - d = ((const unsigned char *) - (startpos >= size1 ? string2 - size1 : string1) + startpos); - DEC_CHARPTR(d); /* Ok, since startpos != size1. */ - d_size = charcount_to_bytecount (d, 1); - - if (TRANSLATE_P (translate)) - while (range > lim && *d != '\n') - { - d += d_size; /* Speedier INC_CHARPTR(d) */ - d_size = charcount_to_bytecount (d, 1); - range -= d_size; - } - else - while (range > lim && *d != '\n') - { - d += d_size; /* Speedier INC_CHARPTR(d) */ - d_size = charcount_to_bytecount (d, 1); - range -= d_size; - } - - startpos += irange - range; + if (range > 0) + { + /* whose stupid idea was it anyway to make this + function take two strings to match?? */ + int lim = 0; + re_char *orig_d; + re_char *stop_d; + + /* Compute limit as below in fastmap code, so we are guaranteed + to remain within a single string. */ + if (startpos < size1 && startpos + range >= size1) + lim = range - (size1 - startpos); + + d = ((const unsigned char *) + (startpos >= size1 ? string2 - size1 : string1) + startpos); + orig_d = d; + stop_d = d + range - lim; + + /* We want to find the next location (including the current + one) where the previous char is a newline, so back up one + and search forward for a newline. */ + DEC_CHARPTR_FMT (d, fmt); /* Ok, since startpos != size1. */ + + /* Written out as an if-else to avoid testing `translate' + inside the loop. */ + if (TRANSLATE_P (translate)) + while (d < stop_d && + RE_TRANSLATE_1 (charptr_emchar_fmt (d, fmt, lispobj)) + != '\n') + INC_CHARPTR_FMT (d, fmt); + else + while (d < stop_d && + charptr_emchar_ascii_fmt (d, fmt, lispobj) != '\n') + INC_CHARPTR_FMT (d, fmt); + + /* If we were stopped by a newline, skip forward over it. + Otherwise we will get in an infloop when our start position + was at begline. */ + if (d < stop_d) + INC_CHARPTR_FMT (d, fmt); + range -= d - orig_d; + startpos += d - orig_d; +#if 1 + assert (!forward_search_p || range >= 0); +#endif + } + else if (range < 0) + { + /* We're lazy, like in the fastmap code below */ + Emchar c; + + d = ((const unsigned char *) + (startpos >= size1 ? string2 - size1 : string1) + startpos); + DEC_CHARPTR_FMT (d, fmt); + c = charptr_emchar_fmt (d, fmt, lispobj); + c = RE_TRANSLATE (c); + if (c != '\n') + goto advance; + } } #endif /* REGEX_BEGLINE_CHECK */ @@ -4248,6 +4228,20 @@ the first null string. */ if (fastmap && startpos < total_size && !bufp->can_be_null) { + /* For the moment, fastmap always works as if buffer + is in default format, so convert chars in the search strings + into default format as we go along, if necessary. + + &&#### fastmap needs rethinking for 8-bit-fixed so + it's faster. We need it to reflect the raw + 8-bit-fixed values. That isn't so hard if we assume + that the top 96 bytes represent a single 1-byte + charset. For 16-bit/32-bit stuff it's probably not + worth it to make the fastmap represent the raw, due to + its nature -- we'd have to use the LSB for the + fastmap, and that causes lots of problems with Mule + chars, where it essentially wipes out the usefulness + of the fastmap entirely. */ if (range > 0) /* Searching forwards. */ { int lim = 0; @@ -4262,46 +4256,82 @@ /* Written out as an if-else to avoid testing `translate' inside the loop. */ if (TRANSLATE_P (translate)) - while (range > lim) - { + { + while (range > lim) + { + re_char *old_d = d; #ifdef MULE - Emchar buf_ch; - - buf_ch = charptr_emchar (d); - buf_ch = RE_TRANSLATE (buf_ch); - if (buf_ch >= 0200 || fastmap[(unsigned char) buf_ch]) - break; + Intbyte tempch[MAX_EMCHAR_LEN]; + Emchar buf_ch = + RE_TRANSLATE_1 (charptr_emchar_fmt (d, fmt, lispobj)); + set_charptr_emchar (tempch, buf_ch); + if (fastmap[*tempch]) + break; #else - if (fastmap[(unsigned char)RE_TRANSLATE (*d)]) - break; + if (fastmap[(unsigned char) RE_TRANSLATE_1 (*d)]) + break; #endif /* MULE */ - d_size = charcount_to_bytecount (d, 1); - range -= d_size; - d += d_size; /* Speedier INC_CHARPTR(d) */ - } + INC_CHARPTR_FMT (d, fmt); + range -= (d - old_d); +#if 1 + assert (!forward_search_p || range >= 0); +#endif + } + } +#ifdef MULE + else if (fmt != FORMAT_DEFAULT) + { + while (range > lim) + { + re_char *old_d = d; + Intbyte tempch[MAX_EMCHAR_LEN]; + Emchar buf_ch = charptr_emchar_fmt (d, fmt, lispobj); + set_charptr_emchar (tempch, buf_ch); + if (fastmap[*tempch]) + break; + INC_CHARPTR_FMT (d, fmt); + range -= (d - old_d); +#if 1 + assert (!forward_search_p || range >= 0); +#endif + } + } +#endif /* MULE */ else - while (range > lim && !fastmap[*d]) - { - d_size = charcount_to_bytecount (d, 1); - range -= d_size; - d += d_size; /* Speedier INC_CHARPTR(d) */ - } + { + while (range > lim && !fastmap[*d]) + { + re_char *old_d = d; + INC_CHARPTR (d); + range -= (d - old_d); +#if 1 + assert (!forward_search_p || range >= 0); +#endif + } + } startpos += irange - range; } else /* Searching backwards. */ { - Emchar c = (size1 == 0 || startpos >= size1 - ? charptr_emchar (string2 + startpos - size1) - : charptr_emchar (string1 + startpos)); - c = TRANSLATE (c); + /* #### It's not clear why we don't just write a loop, like + for the moving-forward case. Perhaps the writer got lazy, + since backward searches aren't so common. */ + d = ((const unsigned char *) + (startpos >= size1 ? string2 - size1 : string1) + startpos); #ifdef MULE - if (!(c >= 0200 || fastmap[(unsigned char) c])) - goto advance; + { + Intbyte tempch[MAX_EMCHAR_LEN]; + Emchar buf_ch = + RE_TRANSLATE (charptr_emchar_fmt (d, fmt, lispobj)); + set_charptr_emchar (tempch, buf_ch); + if (!fastmap[*tempch]) + goto advance; + } #else - if (!fastmap[(unsigned char) c]) + if (!fastmap[(unsigned char) RE_TRANSLATE (*d)]) goto advance; -#endif +#endif /* MULE */ } } @@ -4315,7 +4345,8 @@ QUIT; #endif val = re_match_2_internal (bufp, string1, size1, string2, size2, - startpos, regs, stop); + startpos, regs, stop + RE_LISP_CONTEXT_ARGS); #ifndef REGEX_MALLOC #ifdef C_ALLOCA alloca (0); @@ -4333,26 +4364,35 @@ break; else if (range > 0) { + Bytecount d_size; d = ((const unsigned char *) (startpos >= size1 ? string2 - size1 : string1) + startpos); - d_size = charcount_to_bytecount (d, 1); + d_size = charptr_emchar_len_fmt (d, fmt); range -= d_size; +#if 1 + assert (!forward_search_p || range >= 0); +#endif startpos += d_size; } else { + Bytecount d_size; /* Note startpos > size1 not >=. If we are on the string1/string2 boundary, we want to backup into string1. */ d = ((const unsigned char *) (startpos > size1 ? string2 - size1 : string1) + startpos); - DEC_CHARPTR(d); - d_size = charcount_to_bytecount (d, 1); + DEC_CHARPTR_FMT (d, fmt); + d_size = charptr_emchar_len_fmt (d, fmt); range += d_size; +#if 1 + assert (!forward_search_p || range >= 0); +#endif startpos -= d_size; } } return -1; } /* re_search_2 */ + /* Declarations and macros for re_match_2. */ @@ -4369,7 +4409,7 @@ /* Call before fetching a character with *d. This switches over to string2 if necessary. */ -#define REGEX_PREFETCH() \ +#define REGEX_PREFETCH() \ while (d == dend) \ { \ /* End of string2 => fail. */ \ @@ -4394,9 +4434,8 @@ #define POS_AFTER_GAP_UNSAFE(d) ((d) == end1 ? string2 : (d)) /* Test if CH is a word-constituent character. (XEmacs change) */ -#define WORDCHAR_P_UNSAFE(ch) \ - (SYNTAX_UNSAFE (XCHAR_TABLE (regex_emacs_buffer->mirror_syntax_table), \ - ch) == Sword) +#define WORDCHAR_P(ch) \ + (SYNTAX (BUFFER_MIRROR_SYNTAX_TABLE (lispbuf), ch) == Sword) /* Free everything we malloc. */ #ifdef MATCH_MAY_ALLOCATE @@ -4430,21 +4469,22 @@ /* Matching routines. */ -#ifndef emacs /* Emacs never uses this. */ +#ifndef emacs /* XEmacs never uses this. */ /* re_match is like re_match_2 except it takes only a single string. */ int re_match (struct re_pattern_buffer *bufp, const char *string, int size, - int pos, struct re_registers *regs) + int pos, struct re_registers *regs + RE_LISP_CONTEXT_ARGS_DECL) { int result = re_match_2_internal (bufp, NULL, 0, (re_char *) string, size, - pos, regs, size); + pos, regs, size + RE_LISP_CONTEXT_ARGS); alloca (0); return result; } #endif /* not emacs */ - /* re_match_2 matches the compiled pattern in BUFP against the (virtual) concatenation of STRING1 and STRING2 (of length SIZE1 and SIZE2, respectively). We start matching at POS, and stop matching @@ -4461,55 +4501,33 @@ int re_match_2 (struct re_pattern_buffer *bufp, const char *string1, int size1, const char *string2, int size2, int pos, - struct re_registers *regs, int stop) + struct re_registers *regs, int stop + RE_LISP_CONTEXT_ARGS_DECL) { int result; #ifdef emacs - SETUP_SYNTAX_CACHE_FOR_OBJECT (regex_match_object, - regex_emacs_buffer, - SYNTAX_CACHE_OBJECT_BYTE_TO_CHAR (regex_match_object, - regex_emacs_buffer, - pos), - 1); + scache = setup_syntax_cache (scache, lispobj, lispbuf, + offset_to_charxpos (lispobj, pos), + 1); #endif result = re_match_2_internal (bufp, (re_char *) string1, size1, (re_char *) string2, size2, - pos, regs, stop); + pos, regs, stop + RE_LISP_CONTEXT_ARGS); alloca (0); return result; } -#if defined (ERROR_CHECK_TEXT) && defined (emacs) -int in_re_match_2_internal; - -/* #### I am seeing an error (once) where regex_match_object gets set - to a string while matching on a buffer. The only way this seems - possible is recursive invocation of re_match_2_internal(). */ -static Lisp_Object -restore_in_re_match_2_internal (Lisp_Object val) -{ - in_re_match_2_internal = 0; - return Qnil; -} - -#define RESTORE_IN_MATCH_FLAG unbind_to (speccount) - -#else - -#define RESTORE_IN_MATCH_FLAG do {} while (0) - -#endif /* defined (ERROR_CHECK_TEXT) && defined (emacs) */ - - /* This is a separate function so that we can force an alloca cleanup afterwards. */ static int re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, int size1, re_char *string2, int size2, int pos, - struct re_registers *regs, int stop) + struct re_registers *regs, int stop + RE_LISP_CONTEXT_ARGS_DECL) { /* General temporaries. */ int mcnt; @@ -4639,16 +4657,9 @@ /* 1 if this match is the best seen so far. */ re_bool best_match_p; -#if defined (ERROR_CHECK_TEXT) && defined (emacs) - int speccount = specpdl_depth (); - -#if 0 - /* we've hopefully fixed the reentrancy problem. */ - assert (!in_re_match_2_internal); -#endif - in_re_match_2_internal = 1; - record_unwind_protect (restore_in_re_match_2_internal, Qnil); -#endif /* defined (ERROR_CHECK_TEXT) && defined (emacs) */ +#ifdef emacs + Internal_Format fmt = buffer_or_other_internal_format (lispobj); +#endif /* emacs */ DEBUG_PRINT1 ("\n\nEntering re_match_2.\n"); @@ -4676,7 +4687,6 @@ && best_regstart && best_regend && reg_dummy && reg_info_dummy)) { FREE_VARIABLES (); - RESTORE_IN_MATCH_FLAG; return -2; } } @@ -4694,7 +4704,6 @@ if (pos < 0 || pos > size1 + size2) { FREE_VARIABLES (); - RESTORE_IN_MATCH_FLAG; return -1; } @@ -4852,7 +4861,6 @@ if (regs->start == NULL || regs->end == NULL) { FREE_VARIABLES (); - RESTORE_IN_MATCH_FLAG; return -2; } bufp->regs_allocated = REGS_REALLOCATE; @@ -4869,7 +4877,6 @@ if (regs->start == NULL || regs->end == NULL) { FREE_VARIABLES (); - RESTORE_IN_MATCH_FLAG; return -2; } } @@ -4931,7 +4938,6 @@ DEBUG_PRINT2 ("Returning %d from re_match_2.\n", mcnt); FREE_VARIABLES (); - RESTORE_IN_MATCH_FLAG; return mcnt; } @@ -4948,9 +4954,10 @@ DEBUG_PRINT1 ("EXECUTING succeed.\n"); goto succeed_label; - /* Match the next n pattern characters exactly. The following - byte in the pattern defines n, and the n bytes after that - are the characters to match. */ + /* Match exactly a string of length n in the pattern. The + following byte in the pattern defines n, and the n bytes after + that make up the string to match. (Under Mule, this will be in + the default internal format.) */ case exactn: mcnt = *p++; DEBUG_PRINT2 ("EXECUTING exactn %d.\n", mcnt); @@ -4962,23 +4969,21 @@ do { #ifdef MULE - Emchar pat_ch, buf_ch; Bytecount pat_len; REGEX_PREFETCH (); - pat_ch = charptr_emchar (p); - buf_ch = charptr_emchar (d); - if (RE_TRANSLATE (buf_ch) != pat_ch) + if (RE_TRANSLATE_1 (charptr_emchar_fmt (d, fmt, lispobj)) + != charptr_emchar (p)) goto fail; - pat_len = charcount_to_bytecount (p, 1); + pat_len = charptr_emchar_len (p); p += pat_len; - INC_CHARPTR (d); + INC_CHARPTR_FMT (d, fmt); mcnt -= pat_len; #else /* not MULE */ REGEX_PREFETCH (); - if ((unsigned char) RE_TRANSLATE (*d++) != *p++) + if ((unsigned char) RE_TRANSLATE_1 (*d++) != *p++) goto fail; mcnt--; #endif @@ -4987,12 +4992,40 @@ } else { - do +#ifdef MULE + /* If buffer format is default, then we can shortcut and just + compare the text directly, byte by byte. Otherwise, we + need to go character by character. */ + if (fmt != FORMAT_DEFAULT) { - REGEX_PREFETCH (); - if (*d++ != *p++) goto fail; + do + { + Bytecount pat_len; + + REGEX_PREFETCH (); + if (charptr_emchar_fmt (d, fmt, lispobj) != + charptr_emchar (p)) + goto fail; + + pat_len = charptr_emchar_len (p); + p += pat_len; + INC_CHARPTR_FMT (d, fmt); + + mcnt -= pat_len; + } + while (mcnt > 0); } - while (--mcnt); + else +#endif + { + do + { + REGEX_PREFETCH (); + if (*d++ != *p++) goto fail; + mcnt--; + } + while (mcnt > 0); + } } SET_REGS_MATCHED (); break; @@ -5004,13 +5037,16 @@ REGEX_PREFETCH (); - if ((!(bufp->syntax & RE_DOT_NEWLINE) && TRANSLATE (*d) == '\n') - || (bufp->syntax & RE_DOT_NOT_NULL && TRANSLATE (*d) == '\000')) + if ((!(bufp->syntax & RE_DOT_NEWLINE) && + RE_TRANSLATE (charptr_emchar_fmt (d, fmt, lispobj)) == '\n') + || (bufp->syntax & RE_DOT_NOT_NULL && + RE_TRANSLATE (charptr_emchar_fmt (d, fmt, lispobj)) == + '\000')) goto fail; SET_REGS_MATCHED (); DEBUG_PRINT2 (" Matched `%d'.\n", *d); - INC_CHARPTR (d); /* XEmacs change */ + INC_CHARPTR_FMT (d, fmt); /* XEmacs change */ break; @@ -5023,7 +5059,8 @@ DEBUG_PRINT2 ("EXECUTING charset%s.\n", not_p ? "_not" : ""); REGEX_PREFETCH (); - c = TRANSLATE (*d); /* The character to match. */ + c = charptr_emchar_fmt (d, fmt, lispobj); + c = RE_TRANSLATE (c); /* The character to match. */ /* Cast to `unsigned int' instead of `unsigned char' in case the bit list is a full 32 bytes long. */ @@ -5036,7 +5073,7 @@ if (!not_p) goto fail; SET_REGS_MATCHED (); - INC_CHARPTR (d); /* XEmacs change */ + INC_CHARPTR_FMT (d, fmt); /* XEmacs change */ break; } @@ -5050,8 +5087,8 @@ DEBUG_PRINT2 ("EXECUTING charset_mule%s.\n", not_p ? "_not" : ""); REGEX_PREFETCH (); - c = charptr_emchar ((const Intbyte *) d); - c = TRANSLATE_EXTENDED_UNSAFE (c); /* The character to match. */ + c = charptr_emchar_fmt (d, fmt, lispobj); + c = RE_TRANSLATE (c); /* The character to match. */ if (EQ (Qt, unified_range_table_lookup (p, c, Qnil))) not_p = !not_p; @@ -5061,7 +5098,7 @@ if (!not_p) goto fail; SET_REGS_MATCHED (); - INC_CHARPTR (d); + INC_CHARPTR_FMT (d, fmt); break; } #endif /* MULE */ @@ -5318,8 +5355,11 @@ /* Compare that many; failure if mismatch, else move past them. */ if (TRANSLATE_P (translate) - ? bcmp_translate ((unsigned char *) d, - (unsigned char *) d2, mcnt, translate) + ? bcmp_translate (d, d2, mcnt, translate +#ifdef emacs + , fmt, lispobj +#endif + ) : memcmp (d, d2, mcnt)) goto fail; d += mcnt, d2 += mcnt; @@ -5341,10 +5381,14 @@ { if (!bufp->not_bol) break; } - else if (d[-1] == '\n' && bufp->newline_anchor) - { - break; - } + else + { + re_char *d2 = d; + DEC_CHARPTR (d2); + if (charptr_emchar_ascii_fmt (d2, fmt, lispobj) == '\n' && + bufp->newline_anchor) + break; + } /* In all other cases, we fail. */ goto fail; @@ -5359,7 +5403,9 @@ } /* We have to ``prefetch'' the next character. */ - else if ((d == end1 ? *string2 : *d) == '\n' + else if ((d == end1 ? + charptr_emchar_ascii_fmt (string2, fmt, lispobj) : + charptr_emchar_ascii_fmt (d, fmt, lispobj)) == '\n' && bufp->newline_anchor) { break; @@ -5744,29 +5790,29 @@ re_char *d_before = POS_BEFORE_GAP_UNSAFE (d); re_char *d_after = POS_AFTER_GAP_UNSAFE (d); - /* emch1 is the character before d, syn1 is the syntax of emch1, - emch2 is the character at d, and syn2 is the syntax of emch2. */ + /* emch1 is the character before d, syn1 is the syntax of + emch1, emch2 is the character at d, and syn2 is the + syntax of emch2. */ Emchar emch1, emch2; int syn1, syn2; #ifdef emacs - int pos_before; + Charxpos pos_before; #endif - DEC_CHARPTR (d_before); - emch1 = charptr_emchar (d_before); - emch2 = charptr_emchar (d_after); + DEC_CHARPTR_FMT (d_before, fmt); + emch1 = charptr_emchar_fmt (d_before, fmt, lispobj); + emch2 = charptr_emchar_fmt (d_after, fmt, lispobj); #ifdef emacs - pos_before = SYNTAX_CACHE_BYTE_TO_CHAR (PTR_TO_OFFSET (d)) - 1; - UPDATE_SYNTAX_CACHE (pos_before); + pos_before = + offset_to_charxpos (lispobj, PTR_TO_OFFSET (d)) - 1; + UPDATE_SYNTAX_CACHE (scache, pos_before); #endif - syn1 = SYNTAX_FROM_CACHE (XCHAR_TABLE (regex_emacs_buffer->mirror_syntax_table), - emch1); + syn1 = SYNTAX_FROM_CACHE (scache, emch1); #ifdef emacs - UPDATE_SYNTAX_CACHE_FORWARD (pos_before + 1); + UPDATE_SYNTAX_CACHE_FORWARD (scache, pos_before + 1); #endif - syn2 = SYNTAX_FROM_CACHE (XCHAR_TABLE (regex_emacs_buffer->mirror_syntax_table), - emch2); + syn2 = SYNTAX_FROM_CACHE (scache, emch2); result = ((syn1 == Sword) != (syn2 == Sword)); } @@ -5792,24 +5838,22 @@ */ re_char *dtmp = POS_AFTER_GAP_UNSAFE (d); - Emchar emch = charptr_emchar (dtmp); + Emchar emch = charptr_emchar_fmt (dtmp, fmt, lispobj); #ifdef emacs - int charpos = SYNTAX_CACHE_BYTE_TO_CHAR (PTR_TO_OFFSET (d)); - UPDATE_SYNTAX_CACHE (charpos); + Charxpos charpos = offset_to_charxpos (lispobj, PTR_TO_OFFSET (d)); + UPDATE_SYNTAX_CACHE (scache, charpos); #endif - if (SYNTAX_FROM_CACHE (XCHAR_TABLE (regex_emacs_buffer->mirror_syntax_table), - emch) != Sword) + if (SYNTAX_FROM_CACHE (scache, emch) != Sword) goto fail; if (AT_STRINGS_BEG (d)) break; dtmp = POS_BEFORE_GAP_UNSAFE (d); - DEC_CHARPTR (dtmp); - emch = charptr_emchar (dtmp); + DEC_CHARPTR_FMT (dtmp, fmt); + emch = charptr_emchar_fmt (dtmp, fmt, lispobj); #ifdef emacs - UPDATE_SYNTAX_CACHE_BACKWARD (charpos - 1); + UPDATE_SYNTAX_CACHE_BACKWARD (scache, charpos - 1); #endif - if (SYNTAX_FROM_CACHE (XCHAR_TABLE (regex_emacs_buffer->mirror_syntax_table), - emch) != Sword) + if (SYNTAX_FROM_CACHE (scache, emch) != Sword) break; goto fail; } @@ -5830,24 +5874,22 @@ re_char *dtmp; Emchar emch; #ifdef emacs - int charpos = SYNTAX_CACHE_BYTE_TO_CHAR (PTR_TO_OFFSET (d)) - 1; - UPDATE_SYNTAX_CACHE (charpos); + Charxpos charpos = offset_to_charxpos (lispobj, PTR_TO_OFFSET (d)); + UPDATE_SYNTAX_CACHE (scache, charpos); #endif dtmp = POS_BEFORE_GAP_UNSAFE (d); - DEC_CHARPTR (dtmp); - emch = charptr_emchar (dtmp); - if (SYNTAX_FROM_CACHE (XCHAR_TABLE (regex_emacs_buffer->mirror_syntax_table), - emch) != Sword) + DEC_CHARPTR_FMT (dtmp, fmt); + emch = charptr_emchar_fmt (dtmp, fmt, lispobj); + if (SYNTAX_FROM_CACHE (scache, emch) != Sword) goto fail; if (AT_STRINGS_END (d)) break; dtmp = POS_AFTER_GAP_UNSAFE (d); - emch = charptr_emchar (dtmp); + emch = charptr_emchar_fmt (dtmp, fmt, lispobj); #ifdef emacs - UPDATE_SYNTAX_CACHE_FORWARD (charpos + 1); + UPDATE_SYNTAX_CACHE_FORWARD (scache, charpos + 1); #endif - if (SYNTAX_FROM_CACHE (XCHAR_TABLE (regex_emacs_buffer->mirror_syntax_table), - emch) != Sword) + if (SYNTAX_FROM_CACHE (scache, emch) != Sword) break; goto fail; } @@ -5855,35 +5897,27 @@ #ifdef emacs case before_dot: DEBUG_PRINT1 ("EXECUTING before_dot.\n"); - if (! (NILP (regex_match_object) || BUFFERP (regex_match_object)) - || (BUF_PTR_BYTE_POS (regex_emacs_buffer, (unsigned char *) d) - >= BUF_PT (regex_emacs_buffer))) + if (!BUFFERP (lispobj) + || (BUF_PTR_BYTE_POS (XBUFFER (lispobj), (unsigned char *) d) + >= BUF_PT (XBUFFER (lispobj)))) goto fail; break; case at_dot: DEBUG_PRINT1 ("EXECUTING at_dot.\n"); - if (! (NILP (regex_match_object) || BUFFERP (regex_match_object)) - || (BUF_PTR_BYTE_POS (regex_emacs_buffer, (unsigned char *) d) - != BUF_PT (regex_emacs_buffer))) + if (!BUFFERP (lispobj) + || (BUF_PTR_BYTE_POS (XBUFFER (lispobj), (unsigned char *) d) + != BUF_PT (XBUFFER (lispobj)))) goto fail; break; case after_dot: DEBUG_PRINT1 ("EXECUTING after_dot.\n"); - if (! (NILP (regex_match_object) || BUFFERP (regex_match_object)) - || (BUF_PTR_BYTE_POS (regex_emacs_buffer, (unsigned char *) d) - <= BUF_PT (regex_emacs_buffer))) + if (!BUFFERP (lispobj) + || (BUF_PTR_BYTE_POS (XBUFFER (lispobj), (unsigned char *) d) + <= BUF_PT (XBUFFER (lispobj)))) goto fail; break; -#if 0 /* not emacs19 */ - case at_dot: - DEBUG_PRINT1 ("EXECUTING at_dot.\n"); - if (BUF_PTR_BYTE_POS (regex_emacs_buffer, (unsigned char *) d) + 1 - != BUF_PT (regex_emacs_buffer)) - goto fail; - break; -#endif /* not emacs19 */ case syntaxspec: DEBUG_PRINT2 ("EXECUTING syntaxspec %d.\n", mcnt); @@ -5901,17 +5935,13 @@ Emchar emch; REGEX_PREFETCH (); -#ifdef emacs - { - int charpos = SYNTAX_CACHE_BYTE_TO_CHAR (PTR_TO_OFFSET (d)); - UPDATE_SYNTAX_CACHE (charpos); - } -#endif - - emch = charptr_emchar ((const Intbyte *) d); - matches = (SYNTAX_FROM_CACHE (regex_emacs_buffer->mirror_syntax_table, - emch) == (enum syntaxcode) mcnt); - INC_CHARPTR (d); + UPDATE_SYNTAX_CACHE + (scache, offset_to_charxpos (lispobj, PTR_TO_OFFSET (d))); + + emch = charptr_emchar_fmt (d, fmt, lispobj); + matches = (SYNTAX_FROM_CACHE (scache, emch) == + (enum syntaxcode) mcnt); + INC_CHARPTR_FMT (d, fmt); if (matches != should_succeed) goto fail; SET_REGS_MATCHED (); @@ -5940,10 +5970,10 @@ mcnt = *p++; REGEX_PREFETCH (); - emch = charptr_emchar ((const Intbyte *) d); - INC_CHARPTR (d); - if (check_category_char(emch, regex_emacs_buffer->category_table, - mcnt, should_succeed)) + emch = charptr_emchar_fmt (d, fmt, lispobj); + INC_CHARPTR_FMT (d, fmt); + if (check_category_char (emch, BUFFER_CATEGORY_TABLE (lispbuf), + mcnt, should_succeed)) goto fail; SET_REGS_MATCHED (); } @@ -5958,7 +5988,7 @@ case wordchar: DEBUG_PRINT1 ("EXECUTING non-Emacs wordchar.\n"); REGEX_PREFETCH (); - if (!WORDCHAR_P_UNSAFE ((int) (*d))) + if (!WORDCHAR_P ((int) (*d))) goto fail; SET_REGS_MATCHED (); d++; @@ -5967,7 +5997,7 @@ case notwordchar: DEBUG_PRINT1 ("EXECUTING non-Emacs notwordchar.\n"); REGEX_PREFETCH (); - if (!WORDCHAR_P_UNSAFE ((int) (*d))) + if (!WORDCHAR_P ((int) (*d))) goto fail; SET_REGS_MATCHED (); d++; @@ -6034,7 +6064,6 @@ FREE_VARIABLES (); - RESTORE_IN_MATCH_FLAG; return -1; /* Failure to match. */ } /* re_match_2 */ @@ -6284,30 +6313,34 @@ static int bcmp_translate (re_char *s1, re_char *s2, - REGISTER int len, RE_TRANSLATE_TYPE translate) + REGISTER int len, RE_TRANSLATE_TYPE translate +#ifdef emacs + , Internal_Format fmt, Lisp_Object lispobj +#endif + ) { - REGISTER const unsigned char *p1 = s1, *p2 = s2; + REGISTER re_char *p1 = s1, *p2 = s2; #ifdef MULE - const unsigned char *p1_end = s1 + len; - const unsigned char *p2_end = s2 + len; + re_char *p1_end = s1 + len; + re_char *p2_end = s2 + len; while (p1 != p1_end && p2 != p2_end) { Emchar p1_ch, p2_ch; - p1_ch = charptr_emchar (p1); - p2_ch = charptr_emchar (p2); - - if (RE_TRANSLATE (p1_ch) - != RE_TRANSLATE (p2_ch)) + p1_ch = charptr_emchar_fmt (p1, fmt, lispobj); + p2_ch = charptr_emchar_fmt (p2, fmt, lispobj); + + if (RE_TRANSLATE_1 (p1_ch) + != RE_TRANSLATE_1 (p2_ch)) return 1; - INC_CHARPTR (p1); - INC_CHARPTR (p2); + INC_CHARPTR_FMT (p1, fmt); + INC_CHARPTR_FMT (p2, fmt); } #else /* not MULE */ while (len) { - if (RE_TRANSLATE (*p1++) != RE_TRANSLATE (*p2++)) return 1; + if (RE_TRANSLATE_1 (*p1++) != RE_TRANSLATE_1 (*p2++)) return 1; len--; } #endif /* MULE */ @@ -6343,7 +6376,8 @@ /* Match anchors at newline. */ bufp->newline_anchor = 1; - ret = regex_compile ((unsigned char *) pattern, length, re_syntax_options, bufp); + ret = regex_compile ((unsigned char *) pattern, length, re_syntax_options, + bufp); if (!ret) return NULL; @@ -6388,7 +6422,8 @@ /* Match anchors at newlines. */ re_comp_buf.newline_anchor = 1; - ret = regex_compile ((unsigned char *)s, strlen (s), re_syntax_options, &re_comp_buf); + ret = regex_compile ((unsigned char *)s, strlen (s), re_syntax_options, + &re_comp_buf); if (!ret) return NULL; @@ -6640,10 +6675,3 @@ #endif /* not emacs */ -/* -Local variables: -make-backup-files: t -version-control: t -trim-versions-without-asking: nil -End: -*/
--- a/src/regex.h Thu May 02 14:35:32 2002 +0000 +++ b/src/regex.h Sun May 05 11:33:57 2002 +0000 @@ -2,6 +2,7 @@ expression library, version 0.12. Copyright (C) 1985, 89, 90, 91, 92, 93, 95 Free Software Foundation, Inc. + Copyright (C) 2002 Ben Wing. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -25,8 +26,16 @@ #ifdef emacs #define RE_TRANSLATE_TYPE Lisp_Object +#define RE_LISP_SHORT_CONTEXT_ARGS_DECL , Lisp_Object lispobj, struct buffer *lispbuf +#define RE_LISP_SHORT_CONTEXT_ARGS , lispobj, lispbuf +#define RE_LISP_CONTEXT_ARGS_DECL , Lisp_Object lispobj, struct buffer *lispbuf, struct syntax_cache *scache +#define RE_LISP_CONTEXT_ARGS , lispobj, lispbuf, scache #else #define RE_TRANSLATE_TYPE char * +#define RE_LISP_SHORT_CONTEXT_ARGS_DECL +#define RE_LISP_SHORT_CONTEXT_ARGS +#define RE_LISP_CONTEXT_ARGS_DECL +#define RE_LISP_CONTEXT_ARGS #define Elemcount ssize_t #define Bytecount ssize_t #endif /* emacs */ @@ -448,7 +457,8 @@ /* Compile a fastmap for the compiled pattern in BUFFER; used to accelerate searches. Return 0 if successful and -2 if was an internal error. */ -int re_compile_fastmap (struct re_pattern_buffer *buffer); +int re_compile_fastmap (struct re_pattern_buffer *buffer + RE_LISP_SHORT_CONTEXT_ARGS_DECL); /* Search in the string STRING (with length LENGTH) for the pattern @@ -458,27 +468,31 @@ information in REGS (if REGS and BUFFER->no_sub are nonzero). */ int re_search (struct re_pattern_buffer *buffer, const char *string, int length, int start, int range, - struct re_registers *regs); + struct re_registers *regs RE_LISP_CONTEXT_ARGS_DECL); /* Like `re_search', but search in the concatenation of STRING1 and STRING2. Also, stop searching at index START + STOP. */ int re_search_2 (struct re_pattern_buffer *buffer, const char *string1, int length1, const char *string2, int length2, int start, - int range, struct re_registers *regs, int stop); + int range, struct re_registers *regs, int stop + RE_LISP_CONTEXT_ARGS_DECL); +#ifndef emacs /* never used by XEmacs */ /* Like `re_search', but return how many characters in STRING the regexp in BUFFER matched, starting at position START. */ int re_match (struct re_pattern_buffer *buffer, const char *string, - int length, int start, struct re_registers *regs); + int length, int start, struct re_registers *regs + RE_LISP_CONTEXT_ARGS_DECL); +#endif /* not emacs */ /* Relates to `re_match' as `re_search_2' relates to `re_search'. */ int re_match_2 (struct re_pattern_buffer *buffer, const char *string1, int length1, const char *string2, int length2, - int start, struct re_registers *regs, int stop); - + int start, struct re_registers *regs, int stop + RE_LISP_CONTEXT_ARGS_DECL); /* Set REGS to hold NUM_REGS registers, storing them in STARTS and ENDS. Subsequent matches using BUFFER and REGS will use this memory
--- a/src/scrollbar-msw.c Thu May 02 14:35:32 2002 +0000 +++ b/src/scrollbar-msw.c Sun May 05 11:33:57 2002 +0000 @@ -94,7 +94,7 @@ (void *) qxeGetWindowLong (SCROLLBAR_MSW_HANDLE (sb), GWL_USERDATA); Lisp_Object ptr; - VOID_TO_LISP (ptr, opaque); + ptr = VOID_TO_LISP (opaque); assert (OPAQUE_PTRP (ptr)); ptr = Fremhash (ptr, Vmswindows_scrollbar_instance_table); assert (!NILP (ptr)); @@ -221,7 +221,7 @@ else { Lisp_Object ptr; - VOID_TO_LISP (ptr, v); + ptr = VOID_TO_LISP (v); assert (OPAQUE_PTRP (ptr)); ptr = Fgethash (ptr, Vmswindows_scrollbar_instance_table, Qnil); sb = XSCROLLBAR_INSTANCE (ptr); @@ -335,7 +335,7 @@ { int hasVertBar, hasHorzBar; /* Indicates presence of scroll bars */ unsigned wheelScrollLines = 0; /* Number of lines per wheel notch */ - Lisp_Object win, corpore, sano; + Lisp_Object win = Qnil, corpore, sano; struct window_mirror *mirror; int mene, _mene, tekel, upharsin; Charbpos mens, sana;
--- a/src/search.c Thu May 02 14:35:32 2002 +0000 +++ b/src/search.c Sun May 05 11:33:57 2002 +0000 @@ -24,7 +24,7 @@ /* Hacked on for Mule by Ben Wing, December 1994 and August 1995. */ -/* This file has been Mule-ized except for the TRT stuff. */ +/* This file has been Mule-ized. */ #include <config.h> #include "lisp.h" @@ -85,7 +85,7 @@ able to free or re-allocate it properly. */ /* Note: things get trickier under Mule because the values returned from - the regexp routines are in Bytebposs but we need them to be in Charbpos's. + the regexp routines are in Bytebpos's but we need them to be in Charbpos's. We take the easy way out for the moment and just convert them immediately. We could be more clever by not converting them until necessary, but that gets real ugly real fast since the buffer might have changed and @@ -113,57 +113,16 @@ static void set_search_regs (struct buffer *buf, Charbpos beg, Charcount len); static void save_search_regs (void); static Charbpos simple_search (struct buffer *buf, Intbyte *base_pat, - Bytecount len, Bytebpos pos, Bytebpos lim, - EMACS_INT n, Lisp_Object trt); + Bytecount len, Bytebpos pos, Bytebpos lim, + EMACS_INT n, Lisp_Object trt); static Charbpos boyer_moore (struct buffer *buf, Intbyte *base_pat, - Bytecount len, Bytebpos pos, Bytebpos lim, - EMACS_INT n, Lisp_Object trt, - Lisp_Object inverse_trt, int charset_base); + Bytecount len, Bytebpos pos, Bytebpos lim, + EMACS_INT n, Lisp_Object trt, + Lisp_Object inverse_trt, int charset_base); static Charbpos search_buffer (struct buffer *buf, Lisp_Object str, - Charbpos charbpos, Charbpos buflim, EMACS_INT n, int RE, - Lisp_Object trt, Lisp_Object inverse_trt, - int posix); - -struct regex_reentrancy -{ - struct syntax_cache cache; - struct buffer *regex_emacs_buffer; - Lisp_Object regex_match_object; -}; - -typedef struct -{ - Dynarr_declare (struct regex_reentrancy); -} regex_reentrancy_dynarr; - -static regex_reentrancy_dynarr *the_regex_reentrancy_dynarr; - -static Lisp_Object -restore_regex_reentrancy (Lisp_Object dummy) -{ - struct regex_reentrancy rr = Dynarr_pop (the_regex_reentrancy_dynarr); - syntax_cache = rr.cache; - regex_emacs_buffer = rr.regex_emacs_buffer; - regex_match_object = rr.regex_match_object; - return Qnil; -} - -static int -begin_regex_reentrancy (void) -{ - /* #### there is still a potential problem with the regex cache -- - the compiled regex could be overwritten. we'd need 20-fold - reentrancy, though. */ - struct regex_reentrancy rr; - rr.cache = syntax_cache; - rr.regex_emacs_buffer = regex_emacs_buffer; - rr.regex_match_object = regex_match_object; - if (!the_regex_reentrancy_dynarr) - the_regex_reentrancy_dynarr = Dynarr_new2 (regex_reentrancy_dynarr, - struct regex_reentrancy); - Dynarr_add (the_regex_reentrancy_dynarr, rr); - return record_unwind_protect (restore_regex_reentrancy, Qnil); -} + Charbpos charbpos, Charbpos buflim, EMACS_INT n, + int RE, Lisp_Object trt, + Lisp_Object inverse_trt, int posix); static void matcher_overflow (void) @@ -174,7 +133,7 @@ /* Compile a regexp and signal a Lisp error if anything goes wrong. PATTERN is the pattern to compile. CP is the place to put the result. - TRANSLATE is a translation table for ignoring case, or NULL for none. + TRANSLATE is a translation table for ignoring case, or Qnil for none. REGP is the structure that says where to store the "register" values that will result from matching this pattern. If it is 0, we should compile the pattern not to record any @@ -184,8 +143,8 @@ static int compile_pattern_1 (struct regexp_cache *cp, Lisp_Object pattern, - Lisp_Object translate, struct re_registers *regp, int posix, - Error_Behavior errb) + struct re_registers *regp, Lisp_Object translate, + int posix, Error_Behavior errb) { const char *val; reg_syntax_t old; @@ -213,7 +172,7 @@ /* Compile a regexp if necessary, but first check to see if there's one in the cache. PATTERN is the pattern to compile. - TRANSLATE is a translation table for ignoring case, or NULL for none. + TRANSLATE is a translation table for ignoring case, or Qnil for none. REGP is the structure that says where to store the "register" values that will result from matching this pattern. If it is 0, we should compile the pattern not to record any @@ -223,13 +182,21 @@ struct re_pattern_buffer * compile_pattern (Lisp_Object pattern, struct re_registers *regp, - Lisp_Object translate, int posix, Error_Behavior errb) + Lisp_Object translate, Lisp_Object searchobj, + struct buffer *searchbuf, int posix, Error_Behavior errb) { struct regexp_cache *cp, **cpp; for (cpp = &searchbuf_head; ; cpp = &cp->next) { cp = *cpp; + /* &&#### once we fix up the fastmap code in regex.c for 8-bit-fixed, + we need to record and compare the buffer and format, since the + fastmap will reflect the state of the buffer -- and things get + more complicated if the buffer has changed formats or (esp.) has + kept the format but changed its interpretation! may need to have + the code that changes the interpretation go through and invalidate + cache entries for that buffer. */ if (!NILP (Fstring_equal (cp->regexp, pattern)) && EQ (cp->buf.translate, translate) && cp->posix == posix) @@ -238,8 +205,8 @@ /* If we're at the end of the cache, compile into the last cell. */ if (cp->next == 0) { - if (!compile_pattern_1 (cp, pattern, translate, regp, posix, - errb)) + if (!compile_pattern_1 (cp, pattern, regp, translate, + posix, errb)) return 0; break; } @@ -271,13 +238,13 @@ return Qnil; /* Not reached. */ } -/* Convert the search registers from Bytebposs to Charbpos's. Needs to be +/* Convert the search registers from Bytebpos's to Charbpos's. Needs to be done after each regexp match that uses the search regs. We could get a potential speedup by not converting the search registers until it's really necessary, e.g. when match-data or replace-match is called. However, this complexifies the code a lot (e.g. the buffer - could have changed and the Bytebposs stored might be invalid) and is + could have changed and the Bytebpos's stored might be invalid) and is probably not a great time-saver. */ static void @@ -289,7 +256,8 @@ for (i = 0; i < num_regs; i++) { if (search_regs.start[i] >= 0) - search_regs.start[i] = bytebpos_to_charbpos (buf, search_regs.start[i]); + search_regs.start[i] = bytebpos_to_charbpos (buf, + search_regs.start[i]); if (search_regs.end[i] >= 0) search_regs.end[i] = bytebpos_to_charbpos (buf, search_regs.end[i]); } @@ -328,14 +296,14 @@ static Lisp_Object looking_at_1 (Lisp_Object string, struct buffer *buf, int posix) { - /* This function has been Mule-ized, except for the trt table handling. */ Lisp_Object val; Bytebpos p1, p2; Bytecount s1, s2; REGISTER int i; struct re_pattern_buffer *bufp; - int count = begin_regex_reentrancy (); - + struct syntax_cache scache_struct; + struct syntax_cache *scache = &scache_struct; + if (running_asynch_code) save_search_regs (); @@ -343,43 +311,51 @@ bufp = compile_pattern (string, &search_regs, (!NILP (buf->case_fold_search) ? XCASE_TABLE_DOWNCASE (buf->case_table) : Qnil), - posix, ERROR_ME); + wrap_buffer (buf), buf, posix, ERROR_ME); QUIT; /* Get pointers and sizes of the two strings that make up the visible portion of the buffer. */ - p1 = BI_BUF_BEGV (buf); - p2 = BI_BUF_CEILING_OF (buf, p1); + p1 = BYTE_BUF_BEGV (buf); + p2 = BYTE_BUF_CEILING_OF (buf, p1); s1 = p2 - p1; - s2 = BI_BUF_ZV (buf) - p2; - - regex_match_object = Qnil; - regex_emacs_buffer = buf; - i = re_match_2 (bufp, (char *) BI_BUF_BYTE_ADDRESS (buf, p1), - s1, (char *) BI_BUF_BYTE_ADDRESS (buf, p2), s2, - BI_BUF_PT (buf) - BI_BUF_BEGV (buf), &search_regs, - BI_BUF_ZV (buf) - BI_BUF_BEGV (buf)); + s2 = BYTE_BUF_ZV (buf) - p2; + + /* By making the regex object, regex buffer, and syntax cache arguments + to re_{search,match}{,_2}, we've removed the need to do nasty things + to deal with regex reentrancy. (See stack trace in signal.c for proof + that this can happen.) + + #### there is still a potential problem with the regex cache -- + the compiled regex could be overwritten. we'd need 20-fold + reentrancy, though. Fix this. */ + + i = re_match_2 (bufp, (char *) BYTE_BUF_BYTE_ADDRESS (buf, p1), + s1, (char *) BYTE_BUF_BYTE_ADDRESS (buf, p2), s2, + BYTE_BUF_PT (buf) - BYTE_BUF_BEGV (buf), &search_regs, + BYTE_BUF_ZV (buf) - BYTE_BUF_BEGV (buf), wrap_buffer (buf), + buf, scache); if (i == -2) matcher_overflow (); val = (0 <= i ? Qt : Qnil); if (NILP (val)) - return unbind_to (count); + return Qnil; { int num_regs = search_regs.num_regs; for (i = 0; i < num_regs; i++) if (search_regs.start[i] >= 0) { - search_regs.start[i] += BI_BUF_BEGV (buf); - search_regs.end[i] += BI_BUF_BEGV (buf); + search_regs.start[i] += BYTE_BUF_BEGV (buf); + search_regs.end[i] += BYTE_BUF_BEGV (buf); } } last_thing_searched = wrap_buffer (buf); fixup_search_regs_for_buffer (buf); - return unbind_to_1 (count, val); + return val; } DEFUN ("looking-at", Flooking_at, 1, 2, 0, /* @@ -406,18 +382,16 @@ */ (regexp, buffer)) { - return looking_at_1 (regexp, decode_buffer (buffer, 0), 1); + return looking_at_1 (regexp, decode_buffer (buffer, 0), 1); } static Lisp_Object string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, struct buffer *buf, int posix) { - /* This function has been Mule-ized, except for the trt table handling. */ Bytecount val; Charcount s; struct re_pattern_buffer *bufp; - int count = begin_regex_reentrancy (); if (running_asynch_code) save_search_regs (); @@ -429,7 +403,7 @@ s = 0; else { - Charcount len = XSTRING_CHAR_LENGTH (string); + Charcount len = string_char_length (string); CHECK_INT (start); s = XINT (start); @@ -443,25 +417,33 @@ bufp = compile_pattern (regexp, &search_regs, (!NILP (buf->case_fold_search) ? XCASE_TABLE_DOWNCASE (buf->case_table) : Qnil), - 0, ERROR_ME); + string, buf, 0, ERROR_ME); QUIT; { Bytecount bis = string_index_char_to_byte (string, s); - regex_match_object = string; - regex_emacs_buffer = buf; + struct syntax_cache scache_struct; + struct syntax_cache *scache = &scache_struct; + + /* By making the regex object, regex buffer, and syntax cache arguments + to re_{search,match}{,_2}, we've removed the need to do nasty things + to deal with regex reentrancy. (See stack trace in signal.c for proof + that this can happen.) + + #### there is still a potential problem with the regex cache -- + the compiled regex could be overwritten. we'd need 20-fold + reentrancy, though. Fix this. */ + val = re_search (bufp, (char *) XSTRING_DATA (string), XSTRING_LENGTH (string), bis, XSTRING_LENGTH (string) - bis, - &search_regs); + &search_regs, string, buf, scache); } if (val == -2) matcher_overflow (); - if (val < 0) return unbind_to (count); + if (val < 0) return Qnil; last_thing_searched = Qt; fixup_search_regs_for_string (string); - return - unbind_to_1 (count, - make_int (string_index_byte_to_char (string, val))); + return make_int (string_index_byte_to_char (string, val)); } DEFUN ("string-match", Fstring_match, 2, 4, 0, /* @@ -471,12 +453,26 @@ `match-end' and `match-beginning' also give indices of substrings matched by parenthesis constructs in the pattern. -Optional arg BUFFER controls how case folding is done (according to -the value of `case-fold-search' in that buffer and that buffer's case -tables) and defaults to the current buffer. +Optional arg BUFFER controls how case folding and syntax and category +lookup is done (according to the value of `case-fold-search' in that buffer +and that buffer's case tables, syntax tables, and category table). If nil +or unspecified, it defaults *NOT* to the current buffer but instead: + +-- the value of `case-fold-search' in the current buffer is still respected + because of idioms like + + (let ((case-fold-search nil)) + (string-match "^foo.*bar" string)) + + but the case, syntax, and category tables come from the standard tables, + which are accessed through functions `default-{case,syntax,category}-table' and serve as the parents of the + tables in particular buffer + */ (regexp, string, start, buffer)) { +/* &&#### implement new interp for buffer arg; check code to see if it + makes more sense than prev */ return string_match_1 (regexp, string, start, decode_buffer (buffer, 0), 0); } @@ -507,17 +503,17 @@ Bytecount length, int case_fold_search, Error_Behavior errb, int no_quit) { - /* This function has been Mule-ized, except for the trt table handling. */ Bytecount val; Intbyte *newnonreloc = (Intbyte *) nonreloc; struct re_pattern_buffer *bufp; - int count; + struct syntax_cache scache_struct; + struct syntax_cache *scache = &scache_struct; bufp = compile_pattern (regexp, 0, (case_fold_search ? XCASE_TABLE_DOWNCASE (Vstandard_case_table) : Qnil), - 0, errb); + reloc, 0, 0, errb); if (!bufp) return -1; /* will only do this when errb != ERROR_ME */ if (!no_quit) @@ -532,15 +528,19 @@ if (!NILP (reloc)) newnonreloc = XSTRING_DATA (reloc); - count = begin_regex_reentrancy (); - /* #### evil current-buffer dependency */ - regex_match_object = reloc; - regex_emacs_buffer = current_buffer; + /* By making the regex object, regex buffer, and syntax cache arguments + to re_{search,match}{,_2}, we've removed the need to do nasty things + to deal with regex reentrancy. (See stack trace in signal.c for proof + that this can happen.) + + #### there is still a potential problem with the regex cache -- + the compiled regex could be overwritten. we'd need 20-fold + reentrancy, though. Fix this. */ + val = re_search (bufp, (char *) newnonreloc + offset, length, 0, - length, 0); + length, 0, reloc, 0, scache); no_quit_in_re_search = 0; - unbind_to (count); return val; } @@ -600,15 +600,13 @@ If ALLOW_QUIT is non-zero, call QUIT periodically. */ static Bytebpos -bi_scan_buffer (struct buffer *buf, Emchar target, Bytebpos st, Bytebpos en, +byte_scan_buffer (struct buffer *buf, Emchar target, Bytebpos st, Bytebpos en, EMACS_INT count, EMACS_INT *shortage, int allow_quit) { - /* This function has been Mule-ized. */ Bytebpos lim = en > 0 ? en : - ((count > 0) ? BI_BUF_ZV (buf) : BI_BUF_BEGV (buf)); + ((count > 0) ? BYTE_BUF_ZV (buf) : BYTE_BUF_BEGV (buf)); /* #### newline cache stuff in this function not yet ported */ - assert (count != 0); if (shortage) @@ -617,16 +615,26 @@ if (count > 0) { #ifdef MULE - /* Due to the Mule representation of characters in a buffer, - we can simply search for characters in the range 0 - 127 - directly. For other characters, we do it the "hard" way. - Note that this way works for all characters but the other - way is faster. */ - if (target >= 0200) + Internal_Format fmt = buf->text->format; + /* Check for char that's unrepresentable in the buffer -- it + certainly can't be there. */ + if (!emchar_fits_in_format (target, fmt, wrap_buffer (buf))) { + *shortage = count; + return lim; + } + /* Due to the Mule representation of characters in a buffer, we can + simply search for characters in the range 0 - 127 directly; for + 8-bit-fixed, we can do this for all characters. In other cases, + we do it the "hard" way. Note that this way works for all + characters and all formats, but the other way is faster. */ + else if (! (fmt == FORMAT_8_BIT_FIXED || + (fmt == FORMAT_DEFAULT && emchar_ascii_p (target)))) + { + Raw_Emchar raw = emchar_to_raw (target, fmt, wrap_buffer (buf)); while (st < lim && count > 0) { - if (BI_BUF_FETCH_CHAR (buf, st) == target) + if (BYTE_BUF_FETCH_CHAR_RAW (buf, st) == raw) count--; INC_BYTEBPOS (buf, st); } @@ -634,19 +642,20 @@ else #endif { + Raw_Emchar raw = emchar_to_raw (target, fmt, wrap_buffer (buf)); while (st < lim && count > 0) { Bytebpos ceil; Intbyte *bufptr; - ceil = BI_BUF_CEILING_OF (buf, st); + ceil = BYTE_BUF_CEILING_OF (buf, st); ceil = min (lim, ceil); - bufptr = (Intbyte *) memchr (BI_BUF_BYTE_ADDRESS (buf, st), - (int) target, ceil - st); + bufptr = (Intbyte *) memchr (BYTE_BUF_BYTE_ADDRESS (buf, st), + raw, ceil - st); if (bufptr) { count--; - st = BI_BUF_PTR_BYTE_POS (buf, bufptr) + 1; + st = BYTE_BUF_PTR_BYTE_POS (buf, bufptr) + 1; } else st = ceil; @@ -662,36 +671,47 @@ else { #ifdef MULE - if (target >= 0200) + Internal_Format fmt = buf->text->format; + /* Check for char that's unrepresentable in the buffer -- it + certainly can't be there. */ + if (!emchar_fits_in_format (target, fmt, wrap_buffer (buf))) { + *shortage = -count; + return lim; + } + else if (! (fmt == FORMAT_8_BIT_FIXED || + (fmt == FORMAT_DEFAULT && emchar_ascii_p (target)))) + { + Raw_Emchar raw = emchar_to_raw (target, fmt, wrap_buffer (buf)); while (st > lim && count < 0) { DEC_BYTEBPOS (buf, st); - if (BI_BUF_FETCH_CHAR (buf, st) == target) + if (BYTE_BUF_FETCH_CHAR_RAW (buf, st) == raw) count++; } } else #endif { + Raw_Emchar raw = emchar_to_raw (target, fmt, wrap_buffer (buf)); while (st > lim && count < 0) { Bytebpos floor; Intbyte *bufptr; Intbyte *floorptr; - floor = BI_BUF_FLOOR_OF (buf, st); + floor = BYTE_BUF_FLOOR_OF (buf, st); floor = max (lim, floor); /* No memrchr() ... */ - bufptr = BI_BUF_BYTE_ADDRESS_BEFORE (buf, st); - floorptr = BI_BUF_BYTE_ADDRESS (buf, floor); + bufptr = BYTE_BUF_BYTE_ADDRESS_BEFORE (buf, st); + floorptr = BYTE_BUF_BYTE_ADDRESS (buf, floor); while (bufptr >= floorptr) { st--; /* At this point, both ST and BUFPTR refer to the same character. When the loop terminates, ST will always point to the last character we tried. */ - if (* (unsigned char *) bufptr == (unsigned char) target) + if (*bufptr == (Intbyte) raw) { count++; break; @@ -722,23 +742,23 @@ scan_buffer (struct buffer *buf, Emchar target, Charbpos start, Charbpos end, EMACS_INT count, EMACS_INT *shortage, int allow_quit) { - Bytebpos bi_retval; - Bytebpos bi_start, bi_end; - - bi_start = charbpos_to_bytebpos (buf, start); + Bytebpos byte_retval; + Bytebpos byte_start, byte_end; + + byte_start = charbpos_to_bytebpos (buf, start); if (end) - bi_end = charbpos_to_bytebpos (buf, end); + byte_end = charbpos_to_bytebpos (buf, end); else - bi_end = 0; - bi_retval = bi_scan_buffer (buf, target, bi_start, bi_end, count, + byte_end = 0; + byte_retval = byte_scan_buffer (buf, target, byte_start, byte_end, count, shortage, allow_quit); - return bytebpos_to_charbpos (buf, bi_retval); + return bytebpos_to_charbpos (buf, byte_retval); } Bytebpos -bi_find_next_newline_no_quit (struct buffer *buf, Bytebpos from, int count) +byte_find_next_newline_no_quit (struct buffer *buf, Bytebpos from, int count) { - return bi_scan_buffer (buf, '\n', from, 0, count, 0, 0); + return byte_scan_buffer (buf, '\n', from, 0, count, 0, 0); } Charbpos @@ -753,11 +773,10 @@ return scan_buffer (buf, '\n', from, 0, count, 0, 1); } -Bytebpos -bi_find_next_emchar_in_string (Lisp_Object str, Emchar target, Bytebpos st, +Bytecount +byte_find_next_emchar_in_string (Lisp_Object str, Emchar target, Bytecount st, EMACS_INT count) { - /* This function has been Mule-ized. */ Bytebpos lim = XSTRING_LENGTH (str) -1; Intbyte *s = XSTRING_DATA (str); @@ -773,9 +792,9 @@ { while (st < lim && count > 0) { - if (XSTRING_CHAR (str, st) == target) + if (string_emchar (str, st) == target) count--; - INC_CHARBYTEBPOS (s, st); + INC_BYTECOUNT (s, st); } } else @@ -788,7 +807,7 @@ if (bufptr) { count--; - st = (Bytebpos)(bufptr - s) + 1; + st = (Bytebpos) (bufptr - s) + 1; } else st = lim; @@ -801,7 +820,8 @@ not after, and only search up to TO. This isn't just find_next_newline (...)-1, because you might hit TO. */ Charbpos -find_before_next_newline (struct buffer *buf, Charbpos from, Charbpos to, int count) +find_before_next_newline (struct buffer *buf, Charbpos from, Charbpos to, + int count) { EMACS_INT shortage; Charbpos pos = scan_buffer (buf, '\n', from, to, count, &shortage, 1); @@ -816,7 +836,6 @@ skip_chars (struct buffer *buf, int forwardp, int syntaxp, Lisp_Object string, Lisp_Object lim) { - /* This function has been Mule-ized. */ REGISTER Intbyte *p, *pend; REGISTER Emchar c; /* We store the first 256 chars in an array here and the rest in @@ -824,11 +843,9 @@ unsigned char fastmap[0400]; int negate = 0; REGISTER int i; -#ifndef emacs - Lisp_Char_Table *syntax_table = XCHAR_TABLE (buf->mirror_syntax_table); -#endif Charbpos limit; - + struct syntax_cache *scache; + if (NILP (lim)) limit = forwardp ? BUF_ZV (buf) : BUF_BEGV (buf); else @@ -922,7 +939,8 @@ if (syntaxp) { - SETUP_SYNTAX_CACHE_FOR_BUFFER (buf, BUF_PT (buf), forwardp ? 1 : -1); + scache = setup_buffer_syntax_cache (buf, BUF_PT (buf), + forwardp ? 1 : -1); /* All syntax designators are normal chars so nothing strange to worry about */ if (forwardp) @@ -930,12 +948,11 @@ while (BUF_PT (buf) < limit && fastmap[(unsigned char) syntax_code_spec - [(int) SYNTAX_FROM_CACHE (syntax_table, - BUF_FETCH_CHAR - (buf, BUF_PT (buf)))]]) + [(int) SYNTAX_FROM_CACHE + (scache, BUF_FETCH_CHAR (buf, BUF_PT (buf)))]]) { BUF_SET_PT (buf, BUF_PT (buf) + 1); - UPDATE_SYNTAX_CACHE_FORWARD (BUF_PT (buf)); + UPDATE_SYNTAX_CACHE_FORWARD (scache, BUF_PT (buf)); } } else @@ -943,12 +960,12 @@ while (BUF_PT (buf) > limit && fastmap[(unsigned char) syntax_code_spec - [(int) SYNTAX_FROM_CACHE (syntax_table, - BUF_FETCH_CHAR - (buf, BUF_PT (buf) - 1))]]) + [(int) SYNTAX_FROM_CACHE + (scache, + BUF_FETCH_CHAR (buf, BUF_PT (buf) - 1))]]) { BUF_SET_PT (buf, BUF_PT (buf) - 1); - UPDATE_SYNTAX_CACHE_BACKWARD (BUF_PT (buf) - 1); + UPDATE_SYNTAX_CACHE_BACKWARD (scache, BUF_PT (buf) - 1); } } } @@ -1054,7 +1071,6 @@ Lisp_Object count, Lisp_Object buffer, int direction, int RE, int posix) { - /* This function has been Mule-ized, except for the trt table handling. */ REGISTER Charbpos np; Charbpos lim; EMACS_INT n = direction; @@ -1121,7 +1137,6 @@ static int trivial_regexp_p (Lisp_Object regexp) { - /* This function has been Mule-ized. */ Bytecount len = XSTRING_LENGTH (regexp); Intbyte *s = XSTRING_DATA (regexp); while (--len >= 0) @@ -1172,14 +1187,12 @@ Charbpos buflim, EMACS_INT n, int RE, Lisp_Object trt, Lisp_Object inverse_trt, int posix) { - /* This function has been Mule-ized, except for the trt table handling. */ Bytecount len = XSTRING_LENGTH (string); Intbyte *base_pat = XSTRING_DATA (string); REGISTER EMACS_INT i, j; Bytebpos p1, p2; Bytecount s1, s2; Bytebpos pos, lim; - int count; if (running_asynch_code) save_search_regs (); @@ -1200,30 +1213,41 @@ if (RE && !trivial_regexp_p (string)) { struct re_pattern_buffer *bufp; - count = begin_regex_reentrancy (); - - bufp = compile_pattern (string, &search_regs, trt, posix, - ERROR_ME); + + bufp = compile_pattern (string, &search_regs, trt, + wrap_buffer (buf), buf, posix, ERROR_ME); /* Get pointers and sizes of the two strings that make up the visible portion of the buffer. */ - p1 = BI_BUF_BEGV (buf); - p2 = BI_BUF_CEILING_OF (buf, p1); + p1 = BYTE_BUF_BEGV (buf); + p2 = BYTE_BUF_CEILING_OF (buf, p1); s1 = p2 - p1; - s2 = BI_BUF_ZV (buf) - p2; - regex_match_object = Qnil; - - while (n < 0) + s2 = BYTE_BUF_ZV (buf) - p2; + + while (n != 0) { Bytecount val; + struct syntax_cache scache_struct; + struct syntax_cache *scache = &scache_struct; + QUIT; - regex_emacs_buffer = buf; + /* By making the regex object, regex buffer, and syntax cache + arguments to re_{search,match}{,_2}, we've removed the need to + do nasty things to deal with regex reentrancy. (See stack + trace in signal.c for proof that this can happen.) + + #### there is still a potential problem with the regex cache -- + the compiled regex could be overwritten. we'd need 20-fold + reentrancy, though. Fix this. */ + val = re_search_2 (bufp, - (char *) BI_BUF_BYTE_ADDRESS (buf, p1), s1, - (char *) BI_BUF_BYTE_ADDRESS (buf, p2), s2, - pos - BI_BUF_BEGV (buf), lim - pos, &search_regs, - pos - BI_BUF_BEGV (buf)); + (char *) BYTE_BUF_BYTE_ADDRESS (buf, p1), s1, + (char *) BYTE_BUF_BYTE_ADDRESS (buf, p2), s2, + pos - BYTE_BUF_BEGV (buf), lim - pos, &search_regs, + n > 0 ? lim - BYTE_BUF_BEGV (buf) : + pos - BYTE_BUF_BEGV (buf), wrap_buffer (buf), + buf, scache); if (val == -2) { @@ -1232,7 +1256,7 @@ if (val >= 0) { int num_regs = search_regs.num_regs; - j = BI_BUF_BEGV (buf); + j = BYTE_BUF_BEGV (buf); for (i = 0; i < num_regs; i++) if (search_regs.start[i] >= 0) { @@ -1241,57 +1265,15 @@ } last_thing_searched = wrap_buffer (buf); /* Set pos to the new position. */ - pos = search_regs.start[0]; + pos = n > 0 ? search_regs.end[0] : search_regs.start[0]; fixup_search_regs_for_buffer (buf); /* And charbpos too. */ - charbpos = search_regs.start[0]; + charbpos = n > 0 ? search_regs.end[0] : search_regs.start[0]; } else - { - unbind_to (count); - return n; - } - n++; + return (n > 0 ? 0 - n : n); + if (n > 0) n--; else n++; } - while (n > 0) - { - Bytecount val; - QUIT; - regex_emacs_buffer = buf; - val = re_search_2 (bufp, - (char *) BI_BUF_BYTE_ADDRESS (buf, p1), s1, - (char *) BI_BUF_BYTE_ADDRESS (buf, p2), s2, - pos - BI_BUF_BEGV (buf), lim - pos, &search_regs, - lim - BI_BUF_BEGV (buf)); - if (val == -2) - { - matcher_overflow (); - } - if (val >= 0) - { - int num_regs = search_regs.num_regs; - j = BI_BUF_BEGV (buf); - for (i = 0; i < num_regs; i++) - if (search_regs.start[i] >= 0) - { - search_regs.start[i] += j; - search_regs.end[i] += j; - } - last_thing_searched = wrap_buffer (buf); - /* Set pos to the new position. */ - pos = search_regs.end[0]; - fixup_search_regs_for_buffer (buf); - /* And charbpos too. */ - charbpos = search_regs.end[0]; - } - else - { - unbind_to (count); - return 0 - n; - } - n--; - } - unbind_to (count); return charbpos; } else /* non-RE case */ @@ -1302,6 +1284,7 @@ Intbyte *patbuf = alloca_array (Intbyte, len * MAX_EMCHAR_LEN); pat = patbuf; #ifdef MULE + /* &&#### needs some 8-bit work here */ while (len > 0) { Intbyte tmp_str[MAX_EMCHAR_LEN]; @@ -1320,18 +1303,17 @@ translated = TRANSLATE (trt, c); inverse = TRANSLATE (inverse_trt, c); - orig_bytelen = charcount_to_bytecount (base_pat, 1); + orig_bytelen = charptr_emchar_len (base_pat); inv_bytelen = set_charptr_emchar (tmp_str, inverse); new_bytelen = set_charptr_emchar (tmp_str, translated); - if (new_bytelen != orig_bytelen || inv_bytelen != orig_bytelen) boyer_moore_ok = 0; if (translated != c || inverse != c) { /* Keep track of which character set row contains the characters that need translation. */ - int charset_base_code = c & ~CHAR_FIELD3_MASK; + int charset_base_code = c & ~EMCHAR_FIELD3_MASK; if (charset_base == -1) charset_base = charset_base_code; else if (charset_base != charset_base_code) @@ -1368,10 +1350,9 @@ } } -/* Do a simple string search N times for the string PAT, - whose length is LEN/LEN_BYTE, - from buffer position POS/POS_BYTE until LIM/LIM_BYTE. - TRT is the translation table. +/* Do a simple string search N times for the string PAT, whose length is + LEN/LEN_BYTE, from buffer position POS until LIM. TRT is the + translation table. Return the character position where the match is found. Otherwise, if M matches remained to be found, return -M. @@ -1381,21 +1362,21 @@ boyer_moore cannot work. */ static Charbpos -simple_search (struct buffer *buf, Intbyte *base_pat, Bytecount len_byte, - Bytebpos idx, Bytebpos lim, EMACS_INT n, Lisp_Object trt) +simple_search (struct buffer *buf, Intbyte *base_pat, Bytecount len, + Bytebpos pos, Bytebpos lim, EMACS_INT n, Lisp_Object trt) { int forward = n > 0; Bytecount buf_len = 0; /* Shut up compiler. */ - if (lim > idx) + if (lim > pos) while (n > 0) { while (1) { - Bytecount this_len = len_byte; - Bytebpos this_idx = idx; + Bytecount this_len = len; + Bytebpos this_pos = pos; Intbyte *p = base_pat; - if (idx >= lim) + if (pos >= lim) goto stop; while (this_len > 0) @@ -1404,25 +1385,25 @@ Bytecount pat_len; pat_ch = charptr_emchar (p); - buf_ch = BI_BUF_FETCH_CHAR (buf, this_idx); + buf_ch = BYTE_BUF_FETCH_CHAR (buf, this_pos); buf_ch = TRANSLATE (trt, buf_ch); if (buf_ch != pat_ch) break; - pat_len = charcount_to_bytecount (p, 1); + pat_len = charptr_emchar_len (p); p += pat_len; this_len -= pat_len; - INC_BYTEBPOS (buf, this_idx); + INC_BYTEBPOS (buf, this_pos); } if (this_len == 0) { - buf_len = this_idx - idx; - idx = this_idx; + buf_len = this_pos - pos; + pos = this_pos; break; } - INC_BYTEBPOS (buf, idx); + INC_BYTEBPOS (buf, pos); } n--; } @@ -1431,36 +1412,36 @@ { while (1) { - Bytecount this_len = len_byte; - Bytebpos this_idx = idx; + Bytecount this_len = len; + Bytebpos this_pos = pos; Intbyte *p; - if (idx <= lim) + if (pos <= lim) goto stop; - p = base_pat + len_byte; + p = base_pat + len; while (this_len > 0) { Emchar pat_ch, buf_ch; DEC_CHARPTR (p); - DEC_BYTEBPOS (buf, this_idx); + DEC_BYTEBPOS (buf, this_pos); pat_ch = charptr_emchar (p); - buf_ch = BI_BUF_FETCH_CHAR (buf, this_idx); + buf_ch = BYTE_BUF_FETCH_CHAR (buf, this_pos); buf_ch = TRANSLATE (trt, buf_ch); if (buf_ch != pat_ch) break; - this_len -= charcount_to_bytecount (p, 1); + this_len -= charptr_emchar_len (p); } if (this_len == 0) { - buf_len = idx - this_idx; - idx = this_idx; + buf_len = pos - this_pos; + pos = this_pos; break; } - DEC_BYTEBPOS (buf, idx); + DEC_BYTEBPOS (buf, pos); } n++; } @@ -1470,13 +1451,13 @@ Charbpos beg, end, retval; if (forward) { - beg = bytebpos_to_charbpos (buf, idx - buf_len); - retval = end = bytebpos_to_charbpos (buf, idx); + beg = bytebpos_to_charbpos (buf, pos - buf_len); + retval = end = bytebpos_to_charbpos (buf, pos); } else { - retval = beg = bytebpos_to_charbpos (buf, idx); - end = bytebpos_to_charbpos (buf, idx + buf_len); + retval = beg = bytebpos_to_charbpos (buf, pos); + end = bytebpos_to_charbpos (buf, pos + buf_len); } set_search_regs (buf, beg, end - beg); @@ -1506,6 +1487,7 @@ Bytebpos pos, Bytebpos lim, EMACS_INT n, Lisp_Object trt, Lisp_Object inverse_trt, int charset_base) { + /* &&#### needs some 8-bit work here */ /* #### Someone really really really needs to comment the workings of this junk somewhat better. @@ -1624,19 +1606,19 @@ int this_translated = 1; /* Is *PTR the last byte of a character? */ - if (pat_end - ptr == 1 || INTBYTE_FIRST_BYTE_P (ptr[1])) + if (pat_end - ptr == 1 || intbyte_first_byte_p (ptr[1])) { Intbyte *charstart = ptr; - while (!INTBYTE_FIRST_BYTE_P (*charstart)) + while (!intbyte_first_byte_p (*charstart)) charstart--; untranslated = charptr_emchar (charstart); - if (charset_base == (untranslated & ~CHAR_FIELD3_MASK)) + if (charset_base == (untranslated & ~EMCHAR_FIELD3_MASK)) { ch = TRANSLATE (trt, untranslated); - if (!INTBYTE_FIRST_BYTE_P (*ptr)) + if (!intbyte_first_byte_p (*ptr)) { translate_prev_byte = ptr[-1]; - if (!INTBYTE_FIRST_BYTE_P (translate_prev_byte)) + if (!intbyte_first_byte_p (translate_prev_byte)) translate_anteprev_byte = ptr[-2]; } } @@ -1660,7 +1642,7 @@ stride_for_teases = BM_tab[j]; BM_tab[j] = dirlen - i; /* A translation table is accompanied by its inverse -- - see comment following downcase_table for details */ + see comment in casetab.c. */ if (this_translated) { Emchar starting_ch = ch; @@ -1690,8 +1672,7 @@ stride_for_teases = BM_tab[j]; BM_tab[j] = dirlen - i; /* A translation table is accompanied by its inverse -- - see comment following downcase_table for details */ - + see comment in casetab.c. */ while ((j = TRANSLATE (inverse_trt, j)) != k) { simple_translate[j] = (Intbyte) k; @@ -1734,20 +1715,22 @@ /* XEmacs change: definitions of CEILING_OF and FLOOR_OF have changed. See buffer.h. */ limit = ((direction > 0) - ? BI_BUF_CEILING_OF (buf, limit) - 1 - : BI_BUF_FLOOR_OF (buf, limit + 1)); + ? BYTE_BUF_CEILING_OF (buf, limit) - 1 + : BYTE_BUF_FLOOR_OF (buf, limit + 1)); /* LIMIT is now the last (not beyond-last!) value POS can take on without hitting edge of buffer or the gap. */ limit = ((direction > 0) ? min (lim - 1, min (limit, pos + 20000)) : max (lim, max (limit, pos - 20000))); - tail_end = BI_BUF_CEILING_OF (buf, pos); - tail_end_ptr = BI_BUF_BYTE_ADDRESS (buf, tail_end); + tail_end = BYTE_BUF_CEILING_OF (buf, pos); + tail_end_ptr = BYTE_BUF_BYTE_ADDRESS (buf, tail_end); if ((limit - pos) * direction > 20) { - p_limit = BI_BUF_BYTE_ADDRESS (buf, limit); - ptr2 = (cursor = BI_BUF_BYTE_ADDRESS (buf, pos)); + /* We have to be careful because the code can generate addresses + that don't point to the beginning of characters. */ + p_limit = BYTE_BUF_BYTE_ADDRESS_NO_VERIFY (buf, limit); + ptr2 = (cursor = BYTE_BUF_BYTE_ADDRESS_NO_VERIFY (buf, pos)); /* In this loop, pos + cursor - ptr2 is the surrogate for pos */ while (1) /* use one cursor setting as long as i can */ @@ -1805,10 +1788,10 @@ cursor -= direction; /* Translate only the last byte of a character. */ if ((cursor == tail_end_ptr - || INTBYTE_FIRST_BYTE_P (cursor[1])) - && (INTBYTE_FIRST_BYTE_P (cursor[0]) + || intbyte_first_byte_p (cursor[1])) + && (intbyte_first_byte_p (cursor[0]) || (translate_prev_byte == cursor[-1] - && (INTBYTE_FIRST_BYTE_P (translate_prev_byte) + && (intbyte_first_byte_p (translate_prev_byte) || translate_anteprev_byte == cursor[-2])))) ch = simple_translate[*cursor]; else @@ -1860,8 +1843,8 @@ /* XEmacs change: definitions of CEILING_OF and FLOOR_OF have changed. See buffer.h. */ limit = ((direction > 0) - ? BI_BUF_CEILING_OF (buf, pos - dirlen + 1) - 1 - : BI_BUF_FLOOR_OF (buf, pos - dirlen)); + ? BYTE_BUF_CEILING_OF (buf, pos - dirlen + 1) - 1 + : BYTE_BUF_FLOOR_OF (buf, pos - dirlen)); limit = ((direction > 0) ? min (limit + len, lim - 1) : max (limit - len, lim)); @@ -1874,9 +1857,9 @@ (the reach is at most len + 21, and typically does not exceed len) */ while ((limit - pos) * direction >= 0) - /* *not* BI_BUF_FETCH_CHAR. We are working here + /* *not* BYTE_BUF_FETCH_CHAR. We are working here with bytes, not characters. */ - pos += BM_tab[*BI_BUF_BYTE_ADDRESS (buf, pos)]; + pos += BM_tab[*BYTE_BUF_BYTE_ADDRESS_NO_VERIFY (buf, pos)]; /* now run the same tests to distinguish going off the end, a match or a phony match. */ if ((pos - limit) * direction <= len) @@ -1893,12 +1876,12 @@ #endif pos -= direction; #ifdef MULE - ptr = BI_BUF_BYTE_ADDRESS (buf, pos); + ptr = BYTE_BUF_BYTE_ADDRESS_NO_VERIFY (buf, pos); if ((ptr == tail_end_ptr - || INTBYTE_FIRST_BYTE_P (ptr[1])) - && (INTBYTE_FIRST_BYTE_P (ptr[0]) + || intbyte_first_byte_p (ptr[1])) + && (intbyte_first_byte_p (ptr[0]) || (translate_prev_byte == ptr[-1] - && (INTBYTE_FIRST_BYTE_P (translate_prev_byte) + && (intbyte_first_byte_p (translate_prev_byte) || translate_anteprev_byte == ptr[-2])))) ch = simple_translate[*ptr]; else @@ -1907,8 +1890,9 @@ break; #else - if (pat[i] != TRANSLATE (trt, - *BI_BUF_BYTE_ADDRESS (buf, pos))) + if (pat[i] != + TRANSLATE (trt, + *BYTE_BUF_BYTE_ADDRESS_NO_VERIFY (buf, pos))) break; #endif } @@ -1954,7 +1938,6 @@ static void set_search_regs (struct buffer *buf, Charbpos beg, Charcount len) { - /* This function has been Mule-ized. */ /* Make sure we have registers in which to store the match position. */ if (search_regs.num_regs == 0) @@ -1980,20 +1963,20 @@ Charcount i, len; EMACS_INT punct_count = 0, word_count = 0; struct buffer *buf = decode_buffer (buffer, 0); - Lisp_Char_Table *syntax_table = XCHAR_TABLE (buf->mirror_syntax_table); + Lisp_Object syntax_table = buf->mirror_syntax_table; CHECK_STRING (string); - len = XSTRING_CHAR_LENGTH (string); + len = string_char_length (string); for (i = 0; i < len; i++) - if (!WORD_SYNTAX_P (syntax_table, XSTRING_CHAR (string, i))) + if (!WORD_SYNTAX_P (syntax_table, string_emchar (string, i))) { punct_count++; if (i > 0 && WORD_SYNTAX_P (syntax_table, - XSTRING_CHAR (string, i - 1))) + string_emchar (string, i - 1))) word_count++; } - if (WORD_SYNTAX_P (syntax_table, XSTRING_CHAR (string, len - 1))) + if (WORD_SYNTAX_P (syntax_table, string_emchar (string, len - 1))) word_count++; if (!word_count) return build_string (""); @@ -2010,13 +1993,13 @@ for (i = 0; i < len; i++) { - Emchar ch = XSTRING_CHAR (string, i); + Emchar ch = string_emchar (string, i); if (WORD_SYNTAX_P (syntax_table, ch)) o += set_charptr_emchar (o, ch); else if (i > 0 && WORD_SYNTAX_P (syntax_table, - XSTRING_CHAR (string, i - 1)) + string_emchar (string, i - 1)) && --word_count) { *o++ = '\\'; @@ -2299,7 +2282,6 @@ */ (replacement, fixedcase, literal, string, strbuffer)) { - /* This function has been Mule-ized. */ /* This function can GC */ enum { nochange, all_caps, cap_initial } case_action; Charbpos pos, last; @@ -2310,7 +2292,7 @@ Emchar c, prevc; Charcount inslen; struct buffer *buf; - Lisp_Char_Table *syntax_table; + Lisp_Object syntax_table; int mc_count; Lisp_Object buffer; int_dynarr *ul_action_dynarr = 0; @@ -2349,13 +2331,14 @@ buf = XBUFFER (buffer); } - syntax_table = XCHAR_TABLE (buf->mirror_syntax_table); + syntax_table = buf->mirror_syntax_table; case_action = nochange; /* We tried an initialization */ /* but some C compilers blew it */ if (search_regs.num_regs == 0) - signal_error (Qinvalid_operation, "replace-match called before any match found", Qunbound); + signal_error (Qinvalid_operation, + "replace-match called before any match found", Qunbound); if (NILP (string)) { @@ -2369,7 +2352,7 @@ { if (search_regs.start[0] < 0 || search_regs.start[0] > search_regs.end[0] - || search_regs.end[0] > XSTRING_CHAR_LENGTH (string)) + || search_regs.end[0] > string_char_length (string)) args_out_of_range (make_int (search_regs.start[0]), make_int (search_regs.end[0])); } @@ -2394,7 +2377,7 @@ if (NILP (string)) c = BUF_FETCH_CHAR (buf, pos); else - c = XSTRING_CHAR (string, pos); + c = string_emchar (string, pos); if (LOWERCASEP (buf, c)) { @@ -2452,7 +2435,7 @@ /* Do case substitution into REPLACEMENT if desired. */ if (NILP (literal)) { - Charcount stlen = XSTRING_CHAR_LENGTH (replacement); + Charcount stlen = string_char_length (replacement); Charcount strpos; /* XEmacs change: rewrote this loop somewhat to make it cleaner. Also added \U, \E, etc. */ @@ -2479,10 +2462,10 @@ Charcount substart = -1; Charcount subend = -1; - c = XSTRING_CHAR (replacement, strpos); + c = string_emchar (replacement, strpos); if (c == '\\' && strpos < stlen - 1) { - c = XSTRING_CHAR (replacement, ++strpos); + c = string_emchar (replacement, ++strpos); if (c == '&') { literal_end = strpos - 1; @@ -2518,7 +2501,7 @@ literal_end = strpos - 1; Dynarr_add (ul_pos_dynarr, (!NILP (accum) - ? XSTRING_CHAR_LENGTH (accum) + ? string_char_length (accum) : 0) + (literal_end - literal_start)); Dynarr_add (ul_action_dynarr, c); } @@ -2567,12 +2550,12 @@ { int i = 0; int cur_action = 'E'; - Charcount stlen = XSTRING_CHAR_LENGTH (replacement); + Charcount stlen = string_char_length (replacement); Charcount strpos; for (strpos = 0; strpos < stlen; strpos++) { - Emchar curchar = XSTRING_CHAR (replacement, strpos); + Emchar curchar = string_emchar (replacement, strpos); Emchar newchar = -1; if (i < Dynarr_length (ul_pos_dynarr) && strpos == Dynarr_at (ul_pos_dynarr, i)) @@ -2621,7 +2604,7 @@ Finsert (1, &replacement); else { - Charcount stlen = XSTRING_CHAR_LENGTH (replacement); + Charcount stlen = string_char_length (replacement); Charcount strpos; struct gcpro gcpro1; GCPRO1 (replacement); @@ -2633,7 +2616,7 @@ */ Charcount offset = BUF_PT (buf) - search_regs.start[sub]; - c = XSTRING_CHAR (replacement, strpos); + c = string_emchar (replacement, strpos); if (c == '\\' && strpos < stlen - 1) { /* XXX FIXME: replacing just a substring non-literally @@ -2642,7 +2625,7 @@ <duwe@caldera.de> claims Finsert_buffer_substring already handles this correctly. */ - c = XSTRING_CHAR (replacement, ++strpos); + c = string_emchar (replacement, ++strpos); if (c == '&') Finsert_buffer_substring (buffer, @@ -2743,7 +2726,6 @@ static Lisp_Object match_limit (Lisp_Object num, int beginningp) { - /* This function has been Mule-ized. */ int n; CHECK_INT (num); @@ -2792,7 +2774,6 @@ */ (integers, reuse)) { - /* This function has been Mule-ized. */ Lisp_Object tail, prev; Lisp_Object *data; int i; @@ -2865,7 +2846,6 @@ */ (list)) { - /* This function has been Mule-ized. */ REGISTER int i; REGISTER Lisp_Object marker; int num_regs;
--- a/src/select-x.c Thu May 02 14:35:32 2002 +0000 +++ b/src/select-x.c Sun May 05 11:33:57 2002 +0000 @@ -297,7 +297,7 @@ /* Optimize for the common ASCII case */ while (ptr <= end) { - if (BYTE_ASCII_P (*ptr)) + if (byte_ascii_p (*ptr)) { ptr++; continue; @@ -1322,7 +1322,7 @@ /* Optimize for the common ASCII case */ for (ptr = data, end = ptr + bytes; ptr <= end; ) { - if (BYTE_ASCII_P (*ptr)) + if (byte_ascii_p (*ptr)) { ptr++; continue;
--- a/src/specifier.c Thu May 02 14:35:32 2002 +0000 +++ b/src/specifier.c Sun May 05 11:33:57 2002 +0000 @@ -279,7 +279,7 @@ the_specs = Fspecifier_specs (obj, Qglobal, Qnil, Qnil); if (NILP (the_specs)) /* there are no global specs */ - write_c_string ("<unspecified>", printcharfun); + write_c_string (printcharfun, "<unspecified>"); else print_internal (the_specs, printcharfun, 1); if (!NILP (sp->fallback)) @@ -350,9 +350,8 @@ inline static Bytecount aligned_sizeof_specifier (Bytecount specifier_type_specific_size) { - return ALIGN_SIZE (offsetof (Lisp_Specifier, data) - + specifier_type_specific_size, - ALIGNOF (max_align_t)); + return MAX_ALIGN_SIZE (offsetof (Lisp_Specifier, data) + + specifier_type_specific_size); } static Bytecount @@ -2946,7 +2945,7 @@ { Lisp_Object specifier = Qnil; - VOID_TO_LISP (specifier, closure); + specifier = VOID_TO_LISP (closure); recompute_one_cached_specifier_in_window (specifier, w); return 0; }
--- a/src/specifier.h Thu May 02 14:35:32 2002 +0000 +++ b/src/specifier.h Sun May 05 11:33:57 2002 +0000 @@ -1,6 +1,6 @@ /* Generic specifier list implementation Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 2002 Ben Wing + Copyright (C) 1995, 1996, 2002 Ben Wing This file is part of XEmacs. @@ -282,10 +282,10 @@ #ifdef ERROR_CHECK_TYPES #define DECLARE_SPECIFIER_TYPE(type) \ extern struct specifier_methods * type##_specifier_methods; \ -INLINE_HEADER struct type##_specifier * \ -error_check_##type##_specifier_data (Lisp_Specifier *sp); \ -INLINE_HEADER struct type##_specifier * \ +DECLARE_INLINE_HEADER ( \ +struct type##_specifier * \ error_check_##type##_specifier_data (Lisp_Specifier *sp) \ +) \ { \ if (SPECIFIERP (sp->magic_parent)) \ { \ @@ -297,10 +297,10 @@ assert (SPECIFIER_TYPE_P (sp, type)); \ return (struct type##_specifier *) sp->data; \ } \ -INLINE_HEADER Lisp_Specifier * \ -error_check_##type##_specifier_type (Lisp_Object obj); \ -INLINE_HEADER Lisp_Specifier * \ +DECLARE_INLINE_HEADER ( \ +Lisp_Specifier * \ error_check_##type##_specifier_type (Lisp_Object obj) \ +) \ { \ Lisp_Specifier *sp = XSPECIFIER (obj); \ assert (SPECIFIER_TYPE_P (sp, type)); \
--- a/src/symbols.c Thu May 02 14:35:32 2002 +0000 +++ b/src/symbols.c Sun May 05 11:33:57 2002 +0000 @@ -244,7 +244,7 @@ XSYMBOL_NEXT (symbol) = 0; *ptr = object; - if (XSTRING_BYTE (XSYMBOL_NAME (symbol), 0) == ':' && EQ (obarray, Vobarray)) + if (string_byte (XSYMBOL_NAME (symbol), 0) == ':' && EQ (obarray, Vobarray)) { /* The LISP way is to put keywords in their own package, but we don't have packages, so we do something simpler. Someday,
--- a/src/symsinit.h Thu May 02 14:35:32 2002 +0000 +++ b/src/symsinit.h Sun May 05 11:33:57 2002 +0000 @@ -111,7 +111,9 @@ void syms_of_filelock (void); void syms_of_floatfns (void); void syms_of_fns (void); +#ifdef USE_C_FONT_LOCK void syms_of_font_lock (void); +#endif /* USE_C_FONT_LOCK */ void syms_of_frame (void); void syms_of_frame_mswindows (void); void syms_of_frame_tty (void); @@ -340,8 +342,10 @@ void vars_of_filelock (void); void vars_of_floatfns (void); void vars_of_fns (void); +#ifdef USE_C_FONT_LOCK void vars_of_font_lock (void); void reinit_vars_of_font_lock (void); +#endif /* USE_C_FONT_LOCK */ void vars_of_frame_tty (void); void vars_of_frame_mswindows (void); void reinit_vars_of_frame_mswindows (void); @@ -461,8 +465,8 @@ void complex_vars_of_menubar (void); void complex_vars_of_scrollbar (void); void complex_vars_of_frame (void); +void complex_vars_of_syntax (void); void complex_vars_of_casetab (void); -void complex_vars_of_syntax (void); void complex_vars_of_chartab (void); void complex_vars_of_buffer (void); void reinit_complex_vars_of_buffer_runtime_only (void);
--- a/src/syntax.c Thu May 02 14:35:32 2002 +0000 +++ b/src/syntax.c Sun May 05 11:33:57 2002 +0000 @@ -1,7 +1,7 @@ /* XEmacs routines to deal with syntax tables; also word and list parsing. Copyright (C) 1985-1994 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 2001 Ben Wing. + Copyright (C) 2001, 2002 Ben Wing. This file is part of XEmacs. @@ -78,18 +78,16 @@ each iteration in re_search_2(). */ int no_quit_in_re_search; -/* Tell the regex routines which buffer to access for SYNTAX() lookups - and the like. */ -struct buffer *regex_emacs_buffer; - -/* In Emacs, this is the string or buffer in which we - are matching. It is used for looking up syntax properties. */ -Lisp_Object regex_match_object; - +/* The standard syntax table is stored where it will automatically + be used in all new buffers. */ Lisp_Object Vstandard_syntax_table; Lisp_Object Vsyntax_designator_chars_string; +Lisp_Object Vtemp_table_for_use_updating_syntax_tables; + +static void syntax_cache_table_was_changed (struct buffer *buf); + /* This is the internal form of the parse state used in parse-partial-sexp. */ struct lisp_parse_state @@ -105,9 +103,9 @@ Charbpos prevlevelstart;/* Char number of start of containing expression */ Charbpos location; /* Char number at which parsing stopped */ int mindepth; /* Minimum depth seen while scanning */ - Charbpos comstr_start; /* Position just after last comment/string starter */ - Lisp_Object levelstarts; /* Char numbers of starts-of-expression - of levels (starting from outermost). */ + Charbpos comstr_start;/* Position just after last comment/string starter */ + Lisp_Object levelstarts;/* Char numbers of starts-of-expression + of levels (starting from outermost). */ }; /* These variables are a cache for finding the start of a defun. @@ -131,7 +129,8 @@ find_defun_start (struct buffer *buf, Charbpos pos) { Charbpos tem; - + struct syntax_cache *scache; + /* Use previous finding, if it's valid and applies to this inquiry. */ if (buf == find_start_buffer /* Reuse the defun-start even if POS is a little farther on. @@ -146,13 +145,13 @@ /* Back up to start of line. */ tem = find_next_newline (buf, pos, -1); - SETUP_SYNTAX_CACHE (tem, 1); + scache = setup_buffer_syntax_cache (buf, tem, 1); while (tem > BUF_BEGV (buf)) { - UPDATE_SYNTAX_CACHE_BACKWARD(tem); + UPDATE_SYNTAX_CACHE_BACKWARD (scache, tem); /* Open-paren at start of line means we found our defun-start. */ - if (SYNTAX_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, tem)) == Sopen) + if (SYNTAX_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, tem)) == Sopen) break; /* Move to beg of previous line. */ tem = find_next_newline (buf, tem, -2); @@ -199,6 +198,32 @@ return decode_buffer (buffer, 0)->syntax_table; } +#ifdef DEBUG_XEMACS + +DEFUN ("mirror-syntax-table", Fmirror_syntax_table, 0, 1, 0, /* +Return the current mirror syntax table, for debugging purposes. +This is the one specified by the current buffer, or by BUFFER if it +is non-nil. +*/ + (buffer)) +{ + return decode_buffer (buffer, 0)->mirror_syntax_table; +} + +DEFUN ("syntax-cache-info", Fsyntax_cache_info, 0, 1, 0, /* +Return info about the syntax cache in BUFFER. +BUFFER defaults to the current buffer if nil. +*/ + (buffer)) +{ + struct buffer *buf = decode_buffer (buffer, 0); + struct syntax_cache *cache = buf->syntax_cache; + return list4 (cache->start, cache->end, make_int (cache->prev_change), + make_int (cache->next_change)); +} + +#endif /* DEBUG_XEMACS */ + DEFUN ("standard-syntax-table", Fstandard_syntax_table, 0, 0, 0, /* Return the standard syntax table. This is the one used for new buffers. @@ -231,14 +256,160 @@ syntax_table = check_syntax_table (syntax_table, Qnil); buf->syntax_table = syntax_table; buf->mirror_syntax_table = XCHAR_TABLE (syntax_table)->mirror_table; + syntax_cache_table_was_changed (buf); /* Indicate that this buffer now has a specified syntax table. */ buf->local_var_flags |= XINT (buffer_local_flags.syntax_table); return syntax_table; } -/* The current syntax state */ -struct syntax_cache syntax_cache; + +static void +init_syntax_cache (struct syntax_cache *cache, Lisp_Object object, + struct buffer *buffer, int infinite) +{ + xzero (*cache); + cache->object = object; + cache->buffer = buffer; + cache->no_syntax_table_prop = 1; + cache->current_syntax_table = + BUFFER_MIRROR_SYNTAX_TABLE (cache->buffer); + cache->start = Qnil; + cache->end = Qnil; + if (infinite) + { + cache->prev_change = EMACS_INT_MIN; + cache->next_change = EMACS_INT_MAX; + } + else + { + cache->prev_change = -1; + cache->next_change = -1; + } +} + +struct syntax_cache * +setup_syntax_cache (struct syntax_cache *cache, Lisp_Object object, + struct buffer *buffer, Charxpos from, int count) +{ + if (BUFFERP (object)) + cache = XBUFFER (object)->syntax_cache; + if (!lookup_syntax_properties) + init_syntax_cache (cache, object, buffer, 1); + else if (!BUFFERP (object)) + init_syntax_cache (cache, object, buffer, 0); + if (lookup_syntax_properties) + { + if (count <= 0) + { + from--; + from = buffer_or_string_clip_to_accessible_byte (cache->object, + from); + } + if (!(from >= cache->prev_change && from < cache->next_change)) + update_syntax_cache (cache, from, count); + } + return cache; +} + +struct syntax_cache * +setup_buffer_syntax_cache (struct buffer *buffer, Charxpos from, int count) +{ + return setup_syntax_cache (NULL, wrap_buffer (buffer), buffer, from, count); +} + +void +mark_buffer_syntax_cache (struct buffer *buf) +{ + struct syntax_cache *cache = buf->syntax_cache; + if (!cache) /* Vbuffer_defaults and such don't have caches */ + return; + mark_object (cache->object); + if (cache->buffer) + mark_object (wrap_buffer (cache->buffer)); + mark_object (cache->current_syntax_table); + mark_object (cache->start); + mark_object (cache->end); +} +static void +reset_buffer_cache_range (struct syntax_cache *cache, Lisp_Object buffer) +{ + Fset_marker (cache->start, make_int (1), buffer); + Fset_marker (cache->end, make_int (1), buffer); + Fset_marker_insertion_type (cache->start, Qt); + Fset_marker_insertion_type (cache->end, Qnil); + cache->prev_change = -1; + cache->next_change = -1; +} + +void +init_buffer_syntax_cache (struct buffer *buf) +{ + struct syntax_cache *cache; + buf->syntax_cache = xnew_and_zero (struct syntax_cache); + cache = buf->syntax_cache; + cache->object = wrap_buffer (buf); + cache->buffer = buf; + cache->no_syntax_table_prop = 1; + cache->current_syntax_table = BUFFER_MIRROR_SYNTAX_TABLE (cache->buffer); + cache->start = Fmake_marker (); + cache->end = Fmake_marker (); + reset_buffer_cache_range (cache, cache->object); +} + +void +uninit_buffer_syntax_cache (struct buffer *buf) +{ + xfree (buf->syntax_cache); + buf->syntax_cache = 0; +} + + +static void +syntax_cache_table_was_changed (struct buffer *buf) +{ + struct syntax_cache *cache = buf->syntax_cache; + if (cache->no_syntax_table_prop) + cache->current_syntax_table = + BUFFER_MIRROR_SYNTAX_TABLE (buf); +} + +/* The syntax-table property on the range covered by EXTENT may be changing, + either because EXTENT has a syntax-table property and is being attached + or detached (this includes having its endpoints changed), or because + the value of EXTENT's syntax-table property is changing. */ + +void +signal_syntax_table_extent_changed (EXTENT extent) +{ + Lisp_Object buffer = extent_object (extent); + if (BUFFERP (buffer)) + { + struct syntax_cache *cache = XBUFFER (buffer)->syntax_cache; + Bytexpos start = extent_endpoint_byte (extent, 0); + Bytexpos end = extent_endpoint_byte (extent, 1); + Bytexpos start2 = byte_marker_position (cache->start); + Bytexpos end2 = byte_marker_position (cache->end); + /* If the extent is entirely before or entirely after the cache range, + it doesn't overlap. Otherwise, invalidate the range. */ + if (!(end < start2 || start > end2)) + reset_buffer_cache_range (cache, buffer); + } +} + +/* Extents have been adjusted for insertion or deletion, so we need to + refetch the start and end position of the extent */ +void +signal_syntax_table_extent_adjust (struct buffer *buf) +{ + struct syntax_cache *cache = buf->syntax_cache; + /* If the cache was invalid before, leave it that way. We only want + to update the limits of validity when they were actually valid. */ + if (cache->prev_change < 0) + return; + cache->prev_change = marker_position (cache->start); + cache->next_change = marker_position (cache->end); +} /* Update syntax_cache to an appropriate setting for position POS @@ -255,82 +426,91 @@ whatever is returned by get-char-property. It might be worth it at some point to merge provided syntax tables - outward to the current buffer. */ + outward to the current buffer (#### rewrite in English please?!). */ void -update_syntax_cache (int pos, int count, int init) +update_syntax_cache (struct syntax_cache *cache, Charxpos cpos, int count) { Lisp_Object tmp_table; + Bytexpos pos; + Bytexpos lim; + Bytexpos next, prev; + int at_begin = 0, at_end = 0; - if (init) + if (NILP (cache->object)) + return; + + pos = buffer_or_string_charxpos_to_bytexpos (cache->object, cpos); + + tmp_table = get_char_property (pos, Qsyntax_table, cache->object, + EXTENT_AT_AFTER, 0); + lim = next_single_property_change (pos, Qsyntax_table, cache->object, + -1); + if (lim < 0) { - syntax_cache.prev_change = -1; - syntax_cache.next_change = -1; + next = buffer_or_string_absolute_end_byte (cache->object); + at_begin = 1; } + else + next = lim; - if (pos > syntax_cache.prev_change && - pos < syntax_cache.next_change) + if (pos < buffer_or_string_absolute_end_byte (cache->object)) + pos = next_bytexpos (cache->object, pos); + lim = previous_single_property_change (pos, Qsyntax_table, cache->object, + -1); + if (lim < 0) { - /* do nothing */ + prev = buffer_or_string_absolute_begin_byte (cache->object); + at_end = 1; } else - { - if (NILP (syntax_cache.object) || EQ (syntax_cache.object, Qt)) - { - int get_change_before = pos + 1; - - tmp_table = Fget_char_property (make_int(pos), Qsyntax_table, - wrap_buffer (syntax_cache.buffer), Qnil); - syntax_cache.next_change = - XINT (Fnext_extent_change (make_int (pos > 0 ? pos : 1), - wrap_buffer (syntax_cache.buffer))); + prev = lim; - if (get_change_before < 1) - get_change_before = 1; - else if (get_change_before > BUF_ZV (syntax_cache.buffer)) - get_change_before = BUF_ZV (syntax_cache.buffer); - - syntax_cache.prev_change = - XINT (Fprevious_extent_change (make_int (get_change_before), - wrap_buffer (syntax_cache.buffer))); - } - else - { - int get_change_before = pos + 1; + cache->prev_change = + buffer_or_string_bytexpos_to_charxpos (cache->object, prev); + cache->next_change = + buffer_or_string_bytexpos_to_charxpos (cache->object, next); - tmp_table = Fget_char_property (make_int(pos), Qsyntax_table, - syntax_cache.object, Qnil); - syntax_cache.next_change = - XINT (Fnext_extent_change (make_int (pos >= 0 ? pos : 0), - syntax_cache.object)); - - if (get_change_before < 0) - get_change_before = 0; - else if (get_change_before > XSTRING_LENGTH(syntax_cache.object)) - get_change_before = XSTRING_LENGTH(syntax_cache.object); - - syntax_cache.prev_change = - XINT (Fprevious_extent_change (make_int (pos >= 0 ? pos : 0), - syntax_cache.object)); - } - - if (EQ (Fsyntax_table_p (tmp_table), Qt)) - { - syntax_cache.use_code = 0; - syntax_cache.current_syntax_table = - XCHAR_TABLE (tmp_table)->mirror_table; - } - else if (CONSP (tmp_table) && INTP (XCAR (tmp_table))) - { - syntax_cache.use_code = 1; - syntax_cache.syntax_code = XINT (XCAR(tmp_table)); - } - else - { - syntax_cache.use_code = 0; - syntax_cache.current_syntax_table = - syntax_cache.buffer->mirror_syntax_table; - } + if (BUFFERP (cache->object)) + { + /* If we are at the beginning or end of buffer, check to see if there's + a zero-length `syntax-table' extent there (highly unlikely); if not, + then we can safely make the end closed, so it will take in newly + inserted text. (If such an extent is inserted, we will be informed + through signal_syntax_table_extent_changed().) */ + Fset_marker (cache->start, make_int (cache->prev_change), cache->object); + Fset_marker_insertion_type + (cache->start, + at_begin && NILP (extent_at (prev, cache->object, Qsyntax_table, + NULL, EXTENT_AT_AT, 0)) + ? Qnil : Qt); + Fset_marker (cache->end, make_int (cache->next_change), cache->object); + Fset_marker_insertion_type + (cache->end, + at_end && NILP (extent_at (next, cache->object, Qsyntax_table, + NULL, EXTENT_AT_AT, 0)) + ? Qt : Qnil); + } + + if (!NILP (Fsyntax_table_p (tmp_table))) + { + cache->use_code = 0; + cache->current_syntax_table = + XCHAR_TABLE (tmp_table)->mirror_table; + cache->no_syntax_table_prop = 0; + } + else if (CONSP (tmp_table) && INTP (XCAR (tmp_table))) + { + cache->use_code = 1; + cache->syntax_code = XINT (XCAR (tmp_table)); + cache->no_syntax_table_prop = 0; + } + else + { + cache->use_code = 0; + cache->no_syntax_table_prop = 1; + cache->current_syntax_table = + BUFFER_MIRROR_SYNTAX_TABLE (cache->buffer); } } @@ -383,16 +563,18 @@ */ (character, syntax_table)) { - Lisp_Char_Table *mirrortab; + Lisp_Object mirrortab; if (NILP (character)) { character = make_char ('\000'); } CHECK_CHAR_COERCE_INT (character); - syntax_table = check_syntax_table (syntax_table, current_buffer->syntax_table); - mirrortab = XCHAR_TABLE (XCHAR_TABLE (syntax_table)->mirror_table); - return make_char (syntax_code_spec[(int) SYNTAX (mirrortab, XCHAR (character))]); + syntax_table = check_syntax_table (syntax_table, + current_buffer->syntax_table); + mirrortab = XCHAR_TABLE (syntax_table)->mirror_table; + return make_char (syntax_code_spec[(int) SYNTAX (mirrortab, + XCHAR (character))]); } #ifdef MULE @@ -401,7 +583,7 @@ charset_syntax (struct buffer *buf, Lisp_Object charset, int *multi_p_out) { *multi_p_out = 1; - /* #### get this right */ + /* !!#### get this right */ return Spunct; } @@ -410,13 +592,13 @@ Lisp_Object syntax_match (Lisp_Object syntax_table, Emchar ch) { - Lisp_Object code = XCHAR_TABLE_VALUE_UNSAFE (syntax_table, ch); + Lisp_Object code = get_char_table (ch, syntax_table); Lisp_Object code2 = code; if (CONSP (code)) code2 = XCAR (code); if (SYNTAX_FROM_CODE (XINT (code2)) == Sinherit) - code = XCHAR_TABLE_VALUE_UNSAFE (Vstandard_syntax_table, ch); + code = get_char_table (ch, Vstandard_syntax_table); return CONSP (code) ? XCDR (code) : Qnil; } @@ -428,12 +610,13 @@ */ (character, syntax_table)) { - Lisp_Char_Table *mirrortab; + Lisp_Object mirrortab; int code; CHECK_CHAR_COERCE_INT (character); - syntax_table = check_syntax_table (syntax_table, current_buffer->syntax_table); - mirrortab = XCHAR_TABLE (XCHAR_TABLE (syntax_table)->mirror_table); + syntax_table = check_syntax_table (syntax_table, + current_buffer->syntax_table); + mirrortab = XCHAR_TABLE (syntax_table)->mirror_table; code = SYNTAX (mirrortab, XCHAR (character)); if (code == Sopen || code == Sclose || code == Sstring) return syntax_match (syntax_table, XCHAR (character)); @@ -448,10 +631,8 @@ There is no word boundary between two word-constituent ASCII characters. */ #define WORD_BOUNDARY_P(c1, c2) \ - (!(CHAR_ASCII_P (c1) && CHAR_ASCII_P (c2)) \ + (!(emchar_ascii_p (c1) && emchar_ascii_p (c2)) \ && word_boundary_p (c1, c2)) - -extern int word_boundary_p (Emchar c1, Emchar c2); #endif /* Return the position across COUNT words from FROM. @@ -464,8 +645,7 @@ Charbpos limit = count > 0 ? BUF_ZV (buf) : BUF_BEGV (buf); Emchar ch0, ch1; enum syntaxcode code; - - SETUP_SYNTAX_CACHE_FOR_BUFFER (buf, from, count); + struct syntax_cache *scache = setup_buffer_syntax_cache (buf, from, count); /* #### is it really worth it to hand expand both cases? JV */ while (count > 0) @@ -477,9 +657,9 @@ if (from == limit) return 0; - UPDATE_SYNTAX_CACHE_FORWARD (from); + UPDATE_SYNTAX_CACHE_FORWARD (scache, from); ch0 = BUF_FETCH_CHAR (buf, from); - code = SYNTAX_FROM_CACHE (mirrortab, ch0); + code = SYNTAX_FROM_CACHE (scache, ch0); from++; if (words_include_escapes @@ -493,9 +673,9 @@ while (from != limit) { - UPDATE_SYNTAX_CACHE_FORWARD (from); + UPDATE_SYNTAX_CACHE_FORWARD (scache, from); ch1 = BUF_FETCH_CHAR (buf, from); - code = SYNTAX_FROM_CACHE (mirrortab, ch1); + code = SYNTAX_FROM_CACHE (scache, ch1); if (!(words_include_escapes && (code == Sescape || code == Scharquote))) if (code != Sword @@ -521,9 +701,9 @@ if (from == limit) return 0; - UPDATE_SYNTAX_CACHE_BACKWARD (from - 1); + UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1); ch1 = BUF_FETCH_CHAR (buf, from - 1); - code = SYNTAX_FROM_CACHE (mirrortab, ch1); + code = SYNTAX_FROM_CACHE (scache, ch1); from--; if (words_include_escapes @@ -537,9 +717,9 @@ while (from != limit) { - UPDATE_SYNTAX_CACHE_BACKWARD (from - 1); + UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1); ch0 = BUF_FETCH_CHAR (buf, from - 1); - code = SYNTAX_FROM_CACHE (mirrortab, ch0); + code = SYNTAX_FROM_CACHE (scache, ch0); if (!(words_include_escapes && (code == Sescape || code == Scharquote))) @@ -632,6 +812,7 @@ /* mask to match comment styles against; for ST_COMMENT_STYLE, this will get set to SYNTAX_COMMENT_STYLE_B, but never get checked */ int mask = comstyle ? SYNTAX_COMMENT_STYLE_B : SYNTAX_COMMENT_STYLE_A; + struct syntax_cache *scache = buf->syntax_cache; /* At beginning of range to scan, we're outside of strings; that determines quote parity to the comment-end. */ @@ -641,11 +822,11 @@ /* Move back and examine a character. */ from--; - UPDATE_SYNTAX_CACHE_BACKWARD (from); + UPDATE_SYNTAX_CACHE_BACKWARD (scache, from); c = BUF_FETCH_CHAR (buf, from); - code = SYNTAX_FROM_CACHE (mirrortab, c); - syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c); + syncode = SYNTAX_CODE_FROM_CACHE (scache, c); + code = SYNTAX_FROM_CODE (syncode); /* is this a 1-char comment end sequence? if so, try to see if style matches previously extracted mask */ @@ -671,17 +852,18 @@ if (SYNTAX_CODE_END_SECOND_P (syncode)) { int prev_syncode; - UPDATE_SYNTAX_CACHE_BACKWARD (from - 1); + UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1); prev_syncode = - SYNTAX_CODE_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, from - 1)); + SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from - 1)); if (SYNTAX_CODES_END_P (prev_syncode, syncode)) { code = Sendcomment; styles_match_p = - SYNTAX_CODES_COMMENT_MASK_END (prev_syncode, syncode) & mask; + SYNTAX_CODES_COMMENT_MASK_END (prev_syncode, + syncode) & mask; from--; - UPDATE_SYNTAX_CACHE_BACKWARD (from); + UPDATE_SYNTAX_CACHE_BACKWARD (scache, from); c = BUF_FETCH_CHAR (buf, from); /* Found a comment-end sequence, so skip past the @@ -694,17 +876,18 @@ if (SYNTAX_CODE_START_SECOND_P (syncode)) { int prev_syncode; - UPDATE_SYNTAX_CACHE_BACKWARD (from - 1); + UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1); prev_syncode = - SYNTAX_CODE_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, from - 1)); + SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from - 1)); if (SYNTAX_CODES_START_P (prev_syncode, syncode)) { code = Scomment; styles_match_p = - SYNTAX_CODES_COMMENT_MASK_START (prev_syncode, syncode) & mask; + SYNTAX_CODES_COMMENT_MASK_START (prev_syncode, + syncode) & mask; from--; - UPDATE_SYNTAX_CACHE_BACKWARD (from); + UPDATE_SYNTAX_CACHE_BACKWARD (scache, from); c = BUF_FETCH_CHAR (buf, from); } } @@ -784,19 +967,21 @@ else /* We can't grok this as a comment; scan it normally. */ from = comment_end; - UPDATE_SYNTAX_CACHE_FORWARD (from - 1); + UPDATE_SYNTAX_CACHE_FORWARD (scache, from - 1); } return from; } static Charbpos -find_end_of_comment (struct buffer *buf, Charbpos from, Charbpos stop, int comstyle) +find_end_of_comment (struct buffer *buf, Charbpos from, Charbpos stop, + int comstyle) { int c; int prev_code; /* mask to match comment styles against; for ST_COMMENT_STYLE, this will get set to SYNTAX_COMMENT_STYLE_B, but never get checked */ int mask = comstyle ? SYNTAX_COMMENT_STYLE_B : SYNTAX_COMMENT_STYLE_A; + struct syntax_cache *scache = buf->syntax_cache; /* This is only called by functions which have already set up the syntax_cache and are keeping it up-to-date */ @@ -807,16 +992,16 @@ return -1; } - UPDATE_SYNTAX_CACHE_FORWARD (from); + UPDATE_SYNTAX_CACHE_FORWARD (scache, from); c = BUF_FETCH_CHAR (buf, from); /* Test for generic comments */ if (comstyle == ST_COMMENT_STYLE) { - if (SYNTAX_FROM_CACHE (mirrortab, c) == Scomment_fence) + if (SYNTAX_FROM_CACHE (scache, c) == Scomment_fence) { from++; - UPDATE_SYNTAX_CACHE_FORWARD (from); + UPDATE_SYNTAX_CACHE_FORWARD (scache, from); break; } from++; @@ -825,25 +1010,25 @@ } else - if (SYNTAX_FROM_CACHE (mirrortab, c) == Sendcomment + if (SYNTAX_FROM_CACHE (scache, c) == Sendcomment && SYNTAX_CODE_MATCHES_1CHAR_P - (SYNTAX_CODE_FROM_CACHE (mirrortab, c), mask)) + (SYNTAX_CODE_FROM_CACHE (scache, c), mask)) /* we have encountered a comment end of the same style as the comment sequence which began this comment section */ { from++; - UPDATE_SYNTAX_CACHE_FORWARD (from); + UPDATE_SYNTAX_CACHE_FORWARD (scache, from); break; } - prev_code = SYNTAX_CODE_FROM_CACHE (mirrortab, c); + prev_code = SYNTAX_CODE_FROM_CACHE (scache, c); from++; - UPDATE_SYNTAX_CACHE_FORWARD (from); + UPDATE_SYNTAX_CACHE_FORWARD (scache, from); if (from < stop && SYNTAX_CODES_MATCH_END_P (prev_code, - SYNTAX_CODE_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, from)), + SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from)), mask) ) @@ -852,7 +1037,7 @@ section */ { from++; - UPDATE_SYNTAX_CACHE_FORWARD (from); + UPDATE_SYNTAX_CACHE_FORWARD (scache, from); break; } } @@ -885,7 +1070,8 @@ int syncode; EMACS_INT n; struct buffer *buf = decode_buffer (buffer, 0); - + struct syntax_cache *scache; + if (NILP (count)) n = 1; else @@ -896,7 +1082,7 @@ from = BUF_PT (buf); - SETUP_SYNTAX_CACHE (from, n); + scache = setup_buffer_syntax_cache (buf, from, n); while (n > 0) { QUIT; @@ -912,10 +1098,10 @@ continue; } - UPDATE_SYNTAX_CACHE_FORWARD (from); + UPDATE_SYNTAX_CACHE_FORWARD (scache, from); c = BUF_FETCH_CHAR (buf, from); - code = SYNTAX_FROM_CACHE (mirrortab, c); - syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c); + syncode = SYNTAX_CODE_FROM_CACHE (scache, c); + code = SYNTAX_FROM_CODE (syncode); if (code == Scomment) { @@ -939,10 +1125,9 @@ && SYNTAX_CODE_START_FIRST_P (syncode)) { int next_syncode; - UPDATE_SYNTAX_CACHE_FORWARD (from + 1); + UPDATE_SYNTAX_CACHE_FORWARD (scache, from + 1); next_syncode = - SYNTAX_CODE_FROM_CACHE (mirrortab, - BUF_FETCH_CHAR (buf, from + 1)); + SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from + 1)); if (SYNTAX_CODES_START_P (syncode, next_syncode)) { @@ -961,7 +1146,8 @@ if (code == Scomment) { - Charbpos newfrom = find_end_of_comment (buf, from, stop, comstyle); + Charbpos newfrom = find_end_of_comment (buf, from, stop, + comstyle); if (newfrom < 0) { /* we stopped because from==stop */ @@ -1004,8 +1190,8 @@ } c = BUF_FETCH_CHAR (buf, from); - code = SYNTAX_FROM_CACHE (mirrortab, c); - syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c); + syncode = SYNTAX_CODE_FROM_CACHE (scache, c); + code = SYNTAX_FROM_CODE (syncode); if (code == Sendcomment) { @@ -1026,10 +1212,9 @@ && SYNTAX_CODE_END_SECOND_P (syncode)) { int prev_syncode; - UPDATE_SYNTAX_CACHE_BACKWARD (from - 1); + UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1); prev_syncode = - SYNTAX_CODE_FROM_CACHE (mirrortab, - BUF_FETCH_CHAR (buf, from - 1)); + SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from - 1)); if (SYNTAX_CODES_END_P (prev_syncode, syncode)) { /* We must record the comment style encountered so that @@ -1076,10 +1261,11 @@ enum syntaxcode code; int syncode; int min_depth = depth; /* Err out if depth gets less than this. */ - + struct syntax_cache *scache; + if (depth > 0) min_depth = 0; - SETUP_SYNTAX_CACHE_FOR_BUFFER (buf, from, count); + scache = setup_buffer_syntax_cache (buf, from, count); while (count > 0) { QUIT; @@ -1089,10 +1275,10 @@ { int comstyle = 0; /* mask for finding matching comment style */ - UPDATE_SYNTAX_CACHE_FORWARD (from); + UPDATE_SYNTAX_CACHE_FORWARD (scache, from); c = BUF_FETCH_CHAR (buf, from); - code = SYNTAX_FROM_CACHE (mirrortab, c); - syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c); + syncode = SYNTAX_CODE_FROM_CACHE (scache, c); + code = SYNTAX_FROM_CODE (syncode); from++; /* a 1-char comment start sequence */ @@ -1108,24 +1294,24 @@ && parse_sexp_ignore_comments) { int next_syncode; - UPDATE_SYNTAX_CACHE_FORWARD (from); + UPDATE_SYNTAX_CACHE_FORWARD (scache, from); next_syncode = - SYNTAX_CODE_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, from)); + SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from)); if (SYNTAX_CODES_START_P (syncode, next_syncode)) { - /* we have encountered a comment start sequence and we - are ignoring all text inside comments. we must record - the comment style this sequence begins so that later, - only a comment end of the same style actually ends - the comment section */ - code = Scomment; + /* we have encountered a comment start sequence and we + are ignoring all text inside comments. we must record + the comment style this sequence begins so that later, + only a comment end of the same style actually ends + the comment section */ + code = Scomment; comstyle = SYNTAX_CODES_COMMENT_MASK_START (syncode, next_syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1; - from++; + from++; + } } - } - UPDATE_SYNTAX_CACHE_FORWARD (from); + UPDATE_SYNTAX_CACHE_FORWARD (scache, from); if (SYNTAX_CODE_PREFIX (syncode)) continue; @@ -1143,9 +1329,8 @@ /* This word counts as a sexp; return at end of it. */ while (from < stop) { - UPDATE_SYNTAX_CACHE_FORWARD (from); - switch (SYNTAX_FROM_CACHE (mirrortab, - BUF_FETCH_CHAR (buf, from))) + UPDATE_SYNTAX_CACHE_FORWARD (scache, from); + switch (SYNTAX_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from))) { case Scharquote: case Sescape: @@ -1168,7 +1353,7 @@ case Scomment: if (!parse_sexp_ignore_comments) break; - UPDATE_SYNTAX_CACHE_FORWARD (from); + UPDATE_SYNTAX_CACHE_FORWARD (scache, from); { Charbpos newfrom = find_end_of_comment (buf, from, stop, comstyle); @@ -1207,7 +1392,8 @@ { if (noerror) return Qnil; - signal_error (Qsyntax_error, "Containing expression ends prematurely", Qunbound); + syntax_error ("Containing expression ends prematurely", + Qunbound); } break; @@ -1218,10 +1404,10 @@ if (code != Sstring_fence) { - /* XEmacs change: call syntax_match on character */ - Emchar ch = BUF_FETCH_CHAR (buf, from - 1); + /* XEmacs change: call syntax_match on character */ + Emchar ch = BUF_FETCH_CHAR (buf, from - 1); Lisp_Object stermobj = - syntax_match (syntax_cache.current_syntax_table, ch); + syntax_match (scache->current_syntax_table, ch); if (CHARP (stermobj)) stringterm = XCHAR (stermobj); @@ -1235,14 +1421,14 @@ { if (from >= stop) goto lose; - UPDATE_SYNTAX_CACHE_FORWARD (from); + UPDATE_SYNTAX_CACHE_FORWARD (scache, from); c = BUF_FETCH_CHAR (buf, from); if (code == Sstring ? c == stringterm - : SYNTAX_FROM_CACHE (mirrortab, c) == Sstring_fence) + : SYNTAX_FROM_CACHE (scache, c) == Sstring_fence) break; - switch (SYNTAX_FROM_CACHE (mirrortab, c)) + switch (SYNTAX_FROM_CACHE (scache, c)) { case Scharquote: case Sescape: @@ -1284,17 +1470,17 @@ int comstyle = 0; /* mask for finding matching comment style */ from--; - UPDATE_SYNTAX_CACHE_BACKWARD (from); + UPDATE_SYNTAX_CACHE_BACKWARD (scache, from); quoted = char_quoted (buf, from); if (quoted) { from--; - UPDATE_SYNTAX_CACHE_BACKWARD (from); + UPDATE_SYNTAX_CACHE_BACKWARD (scache, from); } c = BUF_FETCH_CHAR (buf, from); - code = SYNTAX_FROM_CACHE (mirrortab, c); - syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c); + syncode = SYNTAX_CODE_FROM_CACHE (scache, c); + code = SYNTAX_FROM_CODE (syncode); if (code == Sendcomment && parse_sexp_ignore_comments) { @@ -1311,9 +1497,9 @@ && parse_sexp_ignore_comments) { int prev_syncode; - UPDATE_SYNTAX_CACHE_BACKWARD (from - 1); - prev_syncode = SYNTAX_CODE_FROM_CACHE - (mirrortab, BUF_FETCH_CHAR (buf, from - 1)); + UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1); + prev_syncode = + SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from - 1)); if (SYNTAX_CODES_END_P (prev_syncode, syncode)) { @@ -1339,15 +1525,15 @@ passing it. */ while (from > stop) { - UPDATE_SYNTAX_CACHE_BACKWARD (from); + UPDATE_SYNTAX_CACHE_BACKWARD (scache, from); quoted = char_quoted (buf, from - 1); if (quoted) from--; if (! (quoted || (syncode = - SYNTAX_FROM_CACHE (mirrortab, - BUF_FETCH_CHAR (buf, from - 1))) + SYNTAX_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, + from - 1))) == Sword || syncode == Ssymbol || syncode == Squote)) @@ -1379,7 +1565,8 @@ { if (noerror) return Qnil; - signal_error (Qsyntax_error, "Containing expression ends prematurely", Qunbound); + syntax_error ("Containing expression ends prematurely", + Qunbound); } break; @@ -1400,7 +1587,7 @@ /* XEmacs change: call syntax_match() on character */ Emchar ch = BUF_FETCH_CHAR (buf, from); Lisp_Object stermobj = - syntax_match (syntax_cache.current_syntax_table, ch); + syntax_match (scache->current_syntax_table, ch); if (CHARP (stermobj)) stringterm = XCHAR (stermobj); @@ -1414,12 +1601,12 @@ { if (from == stop) goto lose; - UPDATE_SYNTAX_CACHE_BACKWARD (from - 1); + UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1); c = BUF_FETCH_CHAR (buf, from - 1); if ((code == Sstring ? c == stringterm - : SYNTAX_FROM_CACHE (mirrortab, c) == Sstring_fence) + : SYNTAX_FROM_CACHE (scache, c) == Sstring_fence) && !char_quoted (buf, from - 1)) { break; @@ -1449,7 +1636,7 @@ lose: if (!noerror) - signal_error (Qsyntax_error, "Unbalanced parentheses", Qunbound); + syntax_error ("Unbalanced parentheses", Qunbound); return Qnil; } @@ -1460,11 +1647,12 @@ Charbpos beg = BUF_BEGV (buf); int quoted = 0; Charbpos startpos = pos; + struct syntax_cache *scache = buf->syntax_cache; while (pos > beg) { - UPDATE_SYNTAX_CACHE_BACKWARD (pos - 1); - code = SYNTAX_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, pos - 1)); + UPDATE_SYNTAX_CACHE_BACKWARD (scache, pos - 1); + code = SYNTAX_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, pos - 1)); if (code != Scharquote && code != Sescape) break; @@ -1472,7 +1660,7 @@ quoted = !quoted; } - UPDATE_SYNTAX_CACHE (startpos); + UPDATE_SYNTAX_CACHE (scache, startpos); return quoted; } @@ -1548,18 +1736,15 @@ struct buffer *buf = decode_buffer (buffer, 0); Charbpos beg = BUF_BEGV (buf); Charbpos pos = BUF_PT (buf); -#ifndef emacs - Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table); -#endif Emchar c = '\0'; /* initialize to avoid compiler warnings */ - - - SETUP_SYNTAX_CACHE_FOR_BUFFER (buf, pos, -1); + struct syntax_cache *scache; + + scache = setup_buffer_syntax_cache (buf, pos, -1); while (pos > beg && !char_quoted (buf, pos - 1) /* Previous statement updates syntax table. */ - && (SYNTAX_FROM_CACHE (mirrortab, c = BUF_FETCH_CHAR (buf, pos - 1)) == Squote - || SYNTAX_CODE_PREFIX (SYNTAX_CODE_FROM_CACHE (mirrortab, c)))) + && (SYNTAX_FROM_CACHE (scache, c = BUF_FETCH_CHAR (buf, pos - 1)) == Squote + || SYNTAX_CODE_PREFIX (SYNTAX_CODE_FROM_CACHE (scache, c)))) pos--; BUF_SET_PT (buf, pos); @@ -1594,8 +1779,9 @@ int start_quoted = 0; /* Nonzero means starting after a char quote */ int boundary_stop = commentstop == -1; Lisp_Object tem; - - SETUP_SYNTAX_CACHE (from, 1); + struct syntax_cache *scache; + + scache = setup_buffer_syntax_cache (buf, from, 1); if (NILP (oldstate)) { depth = 0; @@ -1651,7 +1837,8 @@ { curlevel->last = XINT (Fcar (tem)); if (++curlevel == endlevel) - signal_error (Qstack_overflow, "Nesting too deep for parser", Qunbound); + stack_overflow ("Nesting too deep for parser", + make_int (curlevel - levelstart)); curlevel->prev = -1; curlevel->last = -1; tem = Fcdr (tem); @@ -1680,10 +1867,10 @@ QUIT; - UPDATE_SYNTAX_CACHE_FORWARD (from); + UPDATE_SYNTAX_CACHE_FORWARD (scache, from); c = BUF_FETCH_CHAR (buf, from); - code = SYNTAX_FROM_CACHE (mirrortab, c); - syncode = SYNTAX_CODE_FROM_CACHE (mirrortab, c); + syncode = SYNTAX_CODE_FROM_CACHE (scache, c); + code = SYNTAX_FROM_CODE (syncode); from++; /* record the comment style we have entered so that only the @@ -1709,9 +1896,9 @@ SYNTAX_CODE_START_FIRST_P (syncode)) { int next_syncode; - UPDATE_SYNTAX_CACHE_FORWARD (from); + UPDATE_SYNTAX_CACHE_FORWARD (scache, from); next_syncode = - SYNTAX_CODE_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, from)); + SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from)); if (SYNTAX_CODES_START_P (syncode, next_syncode)) { @@ -1720,7 +1907,7 @@ (syncode, next_syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1; state.comstr_start = from - 1; from++; - UPDATE_SYNTAX_CACHE_FORWARD (from); + UPDATE_SYNTAX_CACHE_FORWARD (scache, from); } } @@ -1744,8 +1931,8 @@ symstarted: while (from < end) { - UPDATE_SYNTAX_CACHE_FORWARD (from); - switch (SYNTAX_FROM_CACHE (mirrortab, BUF_FETCH_CHAR (buf, from))) + UPDATE_SYNTAX_CACHE_FORWARD (scache, from); + switch (SYNTAX_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from))) { case Scharquote: case Sescape: @@ -1771,9 +1958,10 @@ startincomment: if (commentstop == 1) goto done; - UPDATE_SYNTAX_CACHE_FORWARD (from); + UPDATE_SYNTAX_CACHE_FORWARD (scache, from); { - Charbpos newfrom = find_end_of_comment (buf, from, end, state.comstyle); + Charbpos newfrom = find_end_of_comment (buf, from, end, + state.comstyle); if (newfrom < 0) { /* we terminated search because from == end */ @@ -1793,7 +1981,8 @@ /* curlevel++->last ran into compiler bug on Apollo */ curlevel->last = from - 1; if (++curlevel == endlevel) - signal_error (Qstack_overflow, "Nesting too deep for parser", Qunbound); + stack_overflow ("Nesting too deep for parser", + make_int (curlevel - levelstart)); curlevel->prev = -1; curlevel->last = -1; if (targetdepth == depth) goto done; @@ -1823,7 +2012,7 @@ /* XEmacs change: call syntax_match() on character */ Emchar ch = BUF_FETCH_CHAR (buf, from - 1); Lisp_Object stermobj = - syntax_match (syntax_cache.current_syntax_table, ch); + syntax_match (scache->current_syntax_table, ch); if (CHARP (stermobj)) state.instring = XCHAR (stermobj); @@ -1838,9 +2027,9 @@ if (from >= end) goto done; - UPDATE_SYNTAX_CACHE_FORWARD (from); + UPDATE_SYNTAX_CACHE_FORWARD (scache, from); c = BUF_FETCH_CHAR (buf, from); - temp_code = SYNTAX_FROM_CACHE (mirrortab, c); + temp_code = SYNTAX_FROM_CACHE (scache, c); if ( state.instring != ST_STRING_STYLE && @@ -1940,6 +2129,8 @@ Sixth arg COMMENTSTOP non-nil means stop at the start of a comment. If it is `syntax-table', stop after the start of a comment or a string, or after the end of a comment or string. +Seventh arg BUFFER specifies the buffer to do the parsing in, and defaults +to the current buffer. */ (from, to, targetdepth, stopbefore, oldstate, commentstop, buffer)) { @@ -1978,8 +2169,10 @@ ? Qnil : (state.instring == ST_STRING_STYLE ? Qt : make_int (state.instring)), val); - val = Fcons (state.thislevelstart < 0 ? Qnil : make_int (state.thislevelstart), val); - val = Fcons (state.prevlevelstart < 0 ? Qnil : make_int (state.prevlevelstart), val); + val = Fcons (state.thislevelstart < 0 ? Qnil : + make_int (state.thislevelstart), val); + val = Fcons (state.prevlevelstart < 0 ? Qnil : + make_int (state.prevlevelstart), val); val = Fcons (make_int (state.depth), val); return val; @@ -2002,45 +2195,92 @@ syntax table as well. */ -struct cmst_arg +static int +copy_to_mirrortab (struct chartab_range *range, Lisp_Object table, + Lisp_Object val, void *arg) { - Lisp_Object mirrortab; - int check_inherit; -}; - -static int -cmst_mapfun (struct chartab_range *range, Lisp_Object val, void *arg) -{ - struct cmst_arg *closure = (struct cmst_arg *) arg; + Lisp_Object mirrortab = VOID_TO_LISP (arg); if (CONSP (val)) val = XCAR (val); - if (SYNTAX_FROM_CODE (XINT (val)) == Sinherit - && closure->check_inherit) - { - struct cmst_arg recursive; + if (SYNTAX_FROM_CODE (XINT (val)) != Sinherit) + put_char_table (mirrortab, range, val); + return 0; +} + +struct cinap +{ + Lisp_Object mirrortab; + Lisp_Object bogus; +}; + +static int +copy_if_not_already_present (struct chartab_range *range, Lisp_Object table, + Lisp_Object val, void *arg) +{ + struct cinap *a = (struct cinap *) arg; - recursive.mirrortab = closure->mirrortab; - recursive.check_inherit = 0; - map_char_table (XCHAR_TABLE (Vstandard_syntax_table), range, - cmst_mapfun, &recursive); + if (CONSP (val)) + val = XCAR (val); + if (SYNTAX_FROM_CODE (XINT (val)) != Sinherit) + { + Lisp_Object existing = + get_range_char_table (range, a->mirrortab, a->bogus); + if (NILP (existing)) + /* nothing at all */ + put_char_table (a->mirrortab, range, val); + else if (!EQ (existing, a->bogus)) + /* full */ + ; + else + { + Freset_char_table (Vtemp_table_for_use_updating_syntax_tables); + copy_char_table_range + (a->mirrortab, + Vtemp_table_for_use_updating_syntax_tables, + range); + put_char_table (a->mirrortab, range, val); + copy_char_table_range + (Vtemp_table_for_use_updating_syntax_tables, + a->mirrortab, range); + } } - else - put_char_table (XCHAR_TABLE (closure->mirrortab), range, val); + return 0; } static void -update_just_this_syntax_table (Lisp_Char_Table *ct) +update_just_this_syntax_table (Lisp_Object table) { struct chartab_range range; - struct cmst_arg arg; + Lisp_Object mirrortab = XCHAR_TABLE (table)->mirror_table; + + range.type = CHARTAB_RANGE_ALL; + Freset_char_table (mirrortab); + /* First, copy the tables values other than inherit into the mirror + table. Then, for tables other than the standard syntax table, map + over the standard table, copying values into the mirror table only if + entries don't already exist in that table. (The copying step requires + another mapping.) + */ - arg.mirrortab = ct->mirror_table; - arg.check_inherit = (CHAR_TABLEP (Vstandard_syntax_table) - && ct != XCHAR_TABLE (Vstandard_syntax_table)); - range.type = CHARTAB_RANGE_ALL; - map_char_table (ct, &range, cmst_mapfun, &arg); + map_char_table (table, &range, copy_to_mirrortab, LISP_TO_VOID (mirrortab)); + /* second clause catches bootstrapping problems when initializing the + standard syntax table */ + if (!EQ (table, Vstandard_syntax_table) && !NILP (Vstandard_syntax_table)) + { + struct cinap cinap; + struct gcpro gcpro1; + cinap.mirrortab = mirrortab; + /* Something that won't be in the table. */ + cinap.bogus = make_float (0.0); + GCPRO1 (cinap.bogus); + map_char_table (Vstandard_syntax_table, &range, + copy_if_not_already_present, &cinap); + UNGCPRO; + } + /* The resetting made the default be Qnil. Put it back to Spunct. */ + set_char_table_default (mirrortab, make_int (Spunct)); } /* Called from chartab.c when a change is made to a syntax table. @@ -2049,20 +2289,18 @@ one. */ void -update_syntax_table (Lisp_Char_Table *ct) +update_syntax_table (Lisp_Object table) { - /* Don't be stymied at startup. */ - if (CHAR_TABLEP (Vstandard_syntax_table) - && ct == XCHAR_TABLE (Vstandard_syntax_table)) + if (EQ (table, Vstandard_syntax_table)) { Lisp_Object syntab; for (syntab = Vall_syntax_tables; !NILP (syntab); syntab = XCHAR_TABLE (syntab)->next_table) - update_just_this_syntax_table (XCHAR_TABLE (syntab)); + update_just_this_syntax_table (syntab); } else - update_just_this_syntax_table (ct); + update_just_this_syntax_table (table); } @@ -2078,6 +2316,10 @@ DEFSUBR (Fsyntax_table_p); DEFSUBR (Fsyntax_table); +#ifdef DEBUG_XEMACS + DEFSUBR (Fmirror_syntax_table); + DEFSUBR (Fsyntax_cache_info); +#endif /* DEBUG_XEMACS */ DEFSUBR (Fstandard_syntax_table); DEFSUBR (Fcopy_syntax_table); DEFSUBR (Fset_syntax_table); @@ -2105,11 +2347,15 @@ parse_sexp_ignore_comments = 0; DEFVAR_BOOL ("lookup-syntax-properties", &lookup_syntax_properties /* -Non-nil means `forward-sexp', etc., grant `syntax-table' property. +Non-nil means `forward-sexp', etc., respect the `syntax-table' property. +This property can be placed on buffers or strings and can be used to explicitly +specify the syntax table to be used for looking up the syntax of the chars +having this property, or to directly specify the syntax of the chars. + The value of this property should be either a syntax table, or a cons of the form (SYNTAXCODE . MATCHCHAR), SYNTAXCODE being the numeric syntax code, MATCHCHAR being nil or the character to match (which is -relevant only for open/close type. +relevant only when the syntax code is open/close-type). */ ); lookup_syntax_properties = 1; @@ -2140,11 +2386,14 @@ Vstandard_syntax_table = Fcopy_syntax_table (Qnil); staticpro (&Vstandard_syntax_table); + Vtemp_table_for_use_updating_syntax_tables = Fmake_char_table (Qgeneric); + staticpro (&Vtemp_table_for_use_updating_syntax_tables); + Vsyntax_designator_chars_string = make_string_nocopy (syntax_code_spec, Smax); staticpro (&Vsyntax_designator_chars_string); - fill_char_table (XCHAR_TABLE (Vstandard_syntax_table), make_int (Spunct)); + set_char_table_default (Vstandard_syntax_table, make_int (Spunct)); for (i = 0; i <= 32; i++) /* Control 0 plus SPACE */ Fput_char_table (make_char (i), make_int (Swhitespace),
--- a/src/syntax.h Thu May 02 14:35:32 2002 +0000 +++ b/src/syntax.h Sun May 05 11:33:57 2002 +0000 @@ -74,25 +74,16 @@ /* Return the syntax code for a particular character and mirror table. */ -#define SYNTAX_CODE_UNSAFE(table, c) \ - XINT (CHAR_TABLE_VALUE_UNSAFE (table, c)) - -INLINE_HEADER int SYNTAX_CODE (Lisp_Char_Table *table, Emchar c); -INLINE_HEADER int -SYNTAX_CODE (Lisp_Char_Table *table, Emchar c) -{ - return SYNTAX_CODE_UNSAFE (table, c); -} - -#define SYNTAX_UNSAFE(table, c) \ - ((enum syntaxcode) (SYNTAX_CODE_UNSAFE (table, c) & 0177)) +#define SYNTAX_CODE(table, c) XINT (get_char_table (c, table)) #define SYNTAX_FROM_CODE(code) ((enum syntaxcode) ((code) & 0177)) + #define SYNTAX(table, c) SYNTAX_FROM_CODE (SYNTAX_CODE (table, c)) -INLINE_HEADER int WORD_SYNTAX_P (Lisp_Char_Table *table, Emchar c); -INLINE_HEADER int -WORD_SYNTAX_P (Lisp_Char_Table *table, Emchar c) +DECLARE_INLINE_HEADER ( +int +WORD_SYNTAX_P (Lisp_Object table, Emchar c) +) { return SYNTAX (table, c) == Sword; } @@ -136,8 +127,6 @@ /* The prefix flag bit for backward-prefix-chars is now put into bit 7. */ -#define SYNTAX_PREFIX_UNSAFE(table, c) \ - ((SYNTAX_CODE_UNSAFE (table, c) >> 7) & 1) #define SYNTAX_PREFIX(table, c) \ ((SYNTAX_CODE (table, c) >> 7) & 1) @@ -175,6 +164,9 @@ #define SYNTAX_SECOND_CHAR_END 0x03 #define SYNTAX_SECOND_CHAR 0x33 +#if 0 + +/* #### Entirely unused. Should they be deleted? */ /* #### These are now more or less equivalent to SYNTAX_COMMENT_MATCH_START ...*/ @@ -232,12 +224,7 @@ ? SYNTAX_COMMENT_STYLE_B \ : 0))) -EXFUN (Fchar_syntax, 2); -EXFUN (Fforward_word, 2); - -/* The standard syntax table is stored where it will automatically - be used in all new buffers. */ -extern Lisp_Object Vstandard_syntax_table; +#endif /* 0 */ /* This array, indexed by a character, contains the syntax code which that character signifies (as a char). @@ -258,161 +245,113 @@ Lisp_Object syntax_match (Lisp_Object table, Emchar ch); extern int no_quit_in_re_search; -extern struct buffer *regex_emacs_buffer; + +void update_syntax_table (Lisp_Object table); -/* This is the string or buffer in which we are matching. It is used - for looking up syntax properties. */ -extern Lisp_Object regex_match_object; - -void update_syntax_table (Lisp_Char_Table *ct); - -#ifdef emacs + +/****************************** syntax caches ********************************/ extern int lookup_syntax_properties; +/* Now that the `syntax-table' property exists, and can override the syntax + table or directly specify the syntax, we cache the last place we + retrieved the syntax-table property. This is because, when moving + linearly through text (e.g. in the regex routines or the scanning + routines in syntax.c), we only need to recalculate at the next place the + syntax-table property changes (i.e. not every position), and when we do + need to recalculate, we can update the info from the previous info + faster than if we did the whole calculation from scratch. */ struct syntax_cache { - int use_code; /* Whether to use syntax_code - or current_syntax_table. */ - struct buffer* buffer; /* The buffer the current syntax cache - applies to. */ + int use_code; /* Whether to use syntax_code or + current_syntax_table. This is + set depending on whether the + syntax-table property is a + syntax table or a syntax + code. */ + int no_syntax_table_prop; /* If non-zero, there was no + `syntax-table' property on the + current range, and so we're + using the buffer's syntax table. + This is important to note because + sometimes the buffer's syntax + table can be changed. */ Lisp_Object object; /* The buffer or string the current - syntax cache applies to. */ + syntax cache applies to, or + Qnil for a string of text not + coming from a buffer or string. */ + struct buffer *buffer; /* The buffer that supplies the + syntax tables, or 0 for the + standard syntax table. If + OBJECT is a buffer, this will + always be the same buffer. */ int syntax_code; /* Syntax code of current char. */ Lisp_Object current_syntax_table; /* Syntax table for current pos. */ - Lisp_Object old_prop; /* Syntax-table prop at prev pos. */ - - Charbpos next_change; /* Position of the next extent + Lisp_Object start, end; /* Markers to keep track of the + known region in a buffer. + Formerly we used an internal + extent, but it seems that having + an extent over the entire buffer + causes serious slowdowns in + extent operations! Yuck! */ + Charxpos next_change; /* Position of the next extent change. */ - Charbpos prev_change; /* Position of the previous - extent change. */ + Charxpos prev_change; /* Position of the previous extent + change. */ }; -extern struct syntax_cache syntax_cache; + +/* Note that the external interface to the syntax-cache uses charpos's, but + intnernally we use bytepos's, for speed. */ -void update_syntax_cache (int pos, int count, int init); +void update_syntax_cache (struct syntax_cache *cache, Charxpos pos, int count); +struct syntax_cache *setup_syntax_cache (struct syntax_cache *cache, + Lisp_Object object, + struct buffer *buffer, + Charxpos from, int count); +struct syntax_cache *setup_buffer_syntax_cache (struct buffer *buffer, + Charxpos from, int count); /* Make syntax cache state good for CHARPOS, assuming it is currently good for a position before CHARPOS. */ -#define UPDATE_SYNTAX_CACHE_FORWARD(pos) \ - (lookup_syntax_properties \ - ? (update_syntax_cache ((pos), 1, 0), 1) \ - : 0) +DECLARE_INLINE_HEADER ( +void +UPDATE_SYNTAX_CACHE_FORWARD (struct syntax_cache *cache, Charxpos pos) +) +{ + if (!(pos >= cache->prev_change && pos < cache->next_change)) + update_syntax_cache (cache, pos, 1); +} /* Make syntax cache state good for CHARPOS, assuming it is currently good for a position after CHARPOS. */ -#define UPDATE_SYNTAX_CACHE_BACKWARD(pos) \ - (lookup_syntax_properties \ - ? (update_syntax_cache ((pos), -1, 0), 1) \ - : 0) +DECLARE_INLINE_HEADER ( +void +UPDATE_SYNTAX_CACHE_BACKWARD (struct syntax_cache *cache, Charxpos pos) +) +{ + if (!(pos >= cache->prev_change && pos < cache->next_change)) + update_syntax_cache (cache, pos, -1); +} /* Make syntax cache state good for CHARPOS */ -#define UPDATE_SYNTAX_CACHE(pos) \ - (lookup_syntax_properties \ - ? (update_syntax_cache ((pos), 0, 0), 1) \ - : 0) - -#define SYNTAX_FROM_CACHE(table, c) \ - SYNTAX_FROM_CODE (SYNTAX_CODE_FROM_CACHE (table, c)) - -#define SYNTAX_CODE_FROM_CACHE(table, c) \ - ( syntax_cache.use_code \ - ? syntax_cache.syntax_code \ - : SYNTAX_CODE (XCHAR_TABLE (syntax_cache.current_syntax_table), \ - c) \ - ) - -/* Convert the byte offset BYTEPOS into a character position, - for the object recorded in syntax_cache with SETUP_SYNTAX_TABLE_FOR_OBJECT. - - The value is meant for use in the UPDATE_SYNTAX_TABLE... macros. - These macros do nothing when parse_sexp_lookup_properties is 0, - so we return 0 in that case, for speed. */ -#define SYNTAX_CACHE_BYTE_TO_CHAR(bytepos) \ - (! lookup_syntax_properties \ - ? 0 \ - : STRINGP (syntax_cache.object) \ - ? string_index_byte_to_char (syntax_cache.object, bytepos) \ - : (BUFFERP (syntax_cache.object) || NILP (syntax_cache.object)) \ - ? bytebpos_to_charbpos (syntax_cache.buffer, \ - bytepos + BI_BUF_BEGV (syntax_cache.buffer)) \ - : (bytepos)) - -#define SYNTAX_CACHE_OBJECT_BYTE_TO_CHAR(obj, buf, bytepos) \ - (! lookup_syntax_properties \ - ? 0 \ - : STRINGP (obj) \ - ? string_index_byte_to_char (obj, bytepos) \ - : (BUFFERP (obj) || NILP (obj)) \ - ? bytebpos_to_charbpos (buf, bytepos + BI_BUF_BEGV (buf)) \ - : (bytepos)) - -#else /* not emacs */ - -#define update_syntax_cache(pos, count, init) -#define UPDATE_SYNTAX_CACHE_FORWARD(pos) -#define UPDATE_SYNTAX_CACHE_BACKWARD(pos) -#define UPDATE_SYNTAX_CACHE(pos) -#define SYNTAX_FROM_CACHE SYNTAX -#define SYNTAX_CODE_FROM_CACHE SYNTAX_CODE - -#endif /* emacs */ +DECLARE_INLINE_HEADER ( +void +UPDATE_SYNTAX_CACHE (struct syntax_cache *cache, Charxpos pos) +) +{ + if (!(pos >= cache->prev_change && pos < cache->next_change)) + update_syntax_cache (cache, pos, 0); +} -#define SETUP_SYNTAX_CACHE(FROM, COUNT) \ - do { \ - syntax_cache.buffer = current_buffer; \ - syntax_cache.object = Qnil; \ - syntax_cache.current_syntax_table \ - = current_buffer->mirror_syntax_table; \ - syntax_cache.use_code = 0; \ - if (lookup_syntax_properties) \ - update_syntax_cache ((COUNT) > 0 ? (FROM) : (FROM) - 1, \ - (COUNT), 1); \ - } while (0) - -#define SETUP_SYNTAX_CACHE_FOR_BUFFER(BUFFER, FROM, COUNT) \ - do { \ - syntax_cache.buffer = (BUFFER); \ - syntax_cache.object = Qnil; \ - syntax_cache.current_syntax_table = \ - syntax_cache.buffer->mirror_syntax_table; \ - syntax_cache.use_code = 0; \ - if (lookup_syntax_properties) \ - update_syntax_cache ((FROM) + ((COUNT) > 0 ? 0 : -1), \ - (COUNT), 1); \ - } while (0) +#define SYNTAX_FROM_CACHE(cache, c) \ + SYNTAX_FROM_CODE (SYNTAX_CODE_FROM_CACHE (cache, c)) -#define SETUP_SYNTAX_CACHE_FOR_OBJECT(OBJECT, BUFFER, FROM, COUNT) \ - do { \ - syntax_cache.buffer = (BUFFER); \ - syntax_cache.object = (OBJECT); \ - if (NILP (syntax_cache.object)) \ - { \ - /* do nothing */; \ - } \ - else if (EQ (syntax_cache.object, Qt)) \ - { \ - /* do nothing */; \ - } \ - else if (STRINGP (syntax_cache.object)) \ - { \ - /* do nothing */; \ - } \ - else if (BUFFERP (syntax_cache.object)) \ - { \ - syntax_cache.buffer = XBUFFER (syntax_cache.object); \ - } \ - else \ - { \ - /* OBJECT must be buffer/string/t/nil */ \ - assert(0); \ - } \ - syntax_cache.current_syntax_table \ - = syntax_cache.buffer->mirror_syntax_table; \ - syntax_cache.use_code = 0; \ - if (lookup_syntax_properties) \ - update_syntax_cache ((FROM) + ((COUNT) > 0 ? 0 : -1), \ - (COUNT), 1); \ - } while (0) +#define SYNTAX_CODE_FROM_CACHE(cache, c) \ + ((cache)->use_code ? (cache)->syntax_code \ + : SYNTAX_CODE ((cache)->current_syntax_table, c)) + + +/***************************** syntax code macros ****************************/ #define SYNTAX_CODE_PREFIX(c) \ ((c >> 7) & 1)
--- a/src/syswindows.h Thu May 02 14:35:32 2002 +0000 +++ b/src/syswindows.h Sun May 05 11:33:57 2002 +0000 @@ -835,6 +835,15 @@ Lisp_Object tstr_to_local_file_format (Extbyte *pathout); +/* Convert from local file format, as used in XEmacs, to valid win32 + filenames as can be given to Windows API routines. Under native XEmacs, + this is a no-op, but under Cygwin, the local names look different -- + Cygwin mount points, forward slashes, etc. Currently, under Cygwin, we + actually allow local names to be of both formats, i.e. Cygwin or Win32 + native. So we check to see if we have Win32 native already (a cheesy + check, look for letter plus colon at beginning of name) and do nothing + in that case. */ + #ifdef CYGWIN #define LOCAL_TO_WIN32_FILE_FORMAT(path, pathout) \ do { \ @@ -880,6 +889,56 @@ } while (0) #endif +/* Convert a local-format file name or URL in internal format into a Win32 + file name or URL in tstr format. */ + +#ifdef CYGWIN + +#define LOCAL_FILE_FORMAT_MAYBE_URL_TO_TSTR(lispstr, pathout) \ +do \ +{ \ + Intbyte *lffmutt_fname1; \ + Intbyte *lffmutt_pathint = XSTRING_DATA (lispstr); \ + \ + if ((lffmutt_fname1 = qxestrchr (lffmutt_pathint, ':')) != NULL \ + && *++lffmutt_fname1 == '/' && *++lffmutt_fname1 == '/') \ + { \ + /* If URL style file, the innards may have Cygwin mount points and \ + the like. so separate out the innards, process them, and put back \ + together. */ \ + if (qxestrncasecmp_c (lffmutt_pathint, "file://", 7) == 0) \ + { \ + Intbyte *lffmutt_path1, *lffmutt_path2; \ + LOCAL_TO_WIN32_FILE_FORMAT (lffmutt_pathint + 7, lffmutt_path1); \ + if (lffmutt_path1 == lffmutt_pathint + 7) /* Optimization */ \ + lffmutt_path2 = lffmutt_pathint; \ + else \ + { \ + lffmutt_path2 = alloca_intbytes (7 + qxestrlen (lffmutt_path1) \ + + 1); \ + qxestrncpy (lffmutt_path2, lffmutt_pathint, 7); \ + qxestrcpy (lffmutt_path2 + 7, lffmutt_path1); \ + } \ + C_STRING_TO_TSTR (lffmutt_path2, pathout); \ + } \ + else \ + /* A straight URL, just convert */ \ + LISP_STRING_TO_TSTR (lispstr, pathout); \ + } \ + else \ + /* Not URL-style, must be a straight filename. */ \ + LOCAL_FILE_FORMAT_TO_TSTR (lispstr, pathout); \ +} while (0) + +#else /* not CYGWIN */ + + /* URL's (and everything else) are already in the right format */ +#define LOCAL_FILE_FORMAT_MAYBE_URL_TO_TSTR(lispstr, pathout) \ + LOCAL_FILE_FORMAT_TO_TSTR (lispstr, pathout) + +#endif /* not CYGWIN */ + + Intbyte *urlify_filename (Intbyte *filename); Intbyte *mswindows_canonicalize_filename (Intbyte *name); #define MSWINDOWS_NORMALIZE_FILENAME(name) \
--- a/src/tests.c Thu May 02 14:35:32 2002 +0000 +++ b/src/tests.c Sun May 05 11:33:57 2002 +0000 @@ -360,6 +360,7 @@ TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque_dos, LISP_BUFFER, Fcurrent_buffer(), intern ("undecided")); + /* &&#### needs some 8-bit work here */ DFC_CHECK_DATA (BUF_BYTE_ADDRESS (current_buffer, BUF_PT (current_buffer)), sizeof (int_foo) - 1, int_foo);
--- a/src/text.c Thu May 02 14:35:32 2002 +0000 +++ b/src/text.c Sun May 05 11:33:57 2002 +0000 @@ -39,188 +39,20 @@ /************************************************************************/ /* - There are three possible ways to specify positions in a buffer. All - of these are one-based: the beginning of the buffer is position or - index 1, and 0 is not a valid position. - - As a "buffer position" (typedef Charbpos): - - This is an index specifying an offset in characters from the - beginning of the buffer. Note that buffer positions are - logically *between* characters, not on a character. The - difference between two buffer positions specifies the number of - characters between those positions. Buffer positions are the - only kind of position externally visible to the user. - - As a "byte index" (typedef Bytebpos): - - This is an index over the bytes used to represent the characters - in the buffer. If there is no Mule support, this is identical - to a buffer position, because each character is represented - using one byte. However, with Mule support, many characters - require two or more bytes for their representation, and so a - byte index may be greater than the corresponding buffer - position. - - As a "memory index" (typedef Membpos): - - This is the byte index adjusted for the gap. For positions - before the gap, this is identical to the byte index. For - positions after the gap, this is the byte index plus the gap - size. There are two possible memory indices for the gap - position; the memory index at the beginning of the gap should - always be used, except in code that deals with manipulating the - gap, where both indices may be seen. The address of the - character "at" (i.e. following) a particular position can be - obtained from the formula - - buffer_start_address + memory_index(position) - 1 - - except in the case of characters at the gap position. - - Other typedefs: - =============== - - Emchar: - ------- - This typedef represents a single Emacs character, which can be - ASCII, ISO-8859, or some extended character, as would typically - be used for Kanji. Note that the representation of a character - as an Emchar is *not* the same as the representation of that - same character in a string; thus, you cannot do the standard - C trick of passing a pointer to a character to a function that - expects a string. - - An Emchar takes up 19 bits of representation and (for code - compatibility and such) is compatible with an int. This - representation is visible on the Lisp level. The important - characteristics of the Emchar representation are - - -- values 0x00 - 0x7f represent ASCII. - -- values 0x80 - 0xff represent the right half of ISO-8859-1. - -- values 0x100 and up represent all other characters. - - This means that Emchar values are upwardly compatible with - the standard 8-bit representation of ASCII/ISO-8859-1. - - Intbyte: - -------- - The data in a buffer or string is logically made up of Intbyte - objects, where a Intbyte takes up the same amount of space as a - char. (It is declared differently, though, to catch invalid - usages.) Strings stored using Intbytes are said to be in - "internal format". The important characteristics of internal - format are - - -- ASCII characters are represented as a single Intbyte, - in the range 0 - 0x7f. - -- All other characters are represented as a Intbyte in - the range 0x80 - 0x9f followed by one or more Intbytes - in the range 0xa0 to 0xff. - - This leads to a number of desirable properties: - - -- Given the position of the beginning of a character, - you can find the beginning of the next or previous - character in constant time. - -- When searching for a substring or an ASCII character - within the string, you need merely use standard - searching routines. - - array of char: - -------------- - Strings that go in or out of Emacs are in "external format", - typedef'ed as an array of char or a char *. There is more - than one external format (JIS, EUC, etc.) but they all - have similar properties. They are modal encodings, - which is to say that the meaning of particular bytes is - not fixed but depends on what "mode" the string is currently - in (e.g. bytes in the range 0 - 0x7f might be - interpreted as ASCII, or as Hiragana, or as 2-byte Kanji, - depending on the current mode). The mode starts out in - ASCII/ISO-8859-1 and is switched using escape sequences -- - for example, in the JIS encoding, 'ESC $ B' switches to a - mode where pairs of bytes in the range 0 - 0x7f - are interpreted as Kanji characters. - - External-formatted data is generally desirable for passing - data between programs because it is upwardly compatible - with standard ASCII/ISO-8859-1 strings and may require - less space than internal encodings such as the one - described above. In addition, some encodings (e.g. JIS) - keep all characters (except the ESC used to switch modes) - in the printing ASCII range 0x20 - 0x7e, which results in - a much higher probability that the data will avoid being - garbled in transmission. Externally-formatted data is - generally not very convenient to work with, however, and - for this reason is usually converted to internal format - before any work is done on the string. - - NOTE: filenames need to be in external format so that - ISO-8859-1 characters come out correctly. - - Charcount: - ---------- - This typedef represents a count of characters, such as - a character offset into a string or the number of - characters between two positions in a buffer. The - difference between two Charbpos's is a Charcount, and - character positions in a string are represented using - a Charcount. - - Bytecount: - ---------- - Similar to a Charcount but represents a count of bytes. - The difference between two Bytebpos's is a Bytecount. - - - Usage of the various representations: - ===================================== - - Memory indices are used in low-level functions in insdel.c and for - extent endpoints and marker positions. The reason for this is that - this way, the extents and markers don't need to be updated for most - insertions, which merely shrink the gap and don't move any - characters around in memory. - - (The beginning-of-gap memory index simplifies insertions w.r.t. - markers, because text usually gets inserted after markers. For - extents, it is merely for consistency, because text can get - inserted either before or after an extent's endpoint depending on - the open/closedness of the endpoint.) - - Byte indices are used in other code that needs to be fast, - such as the searching, redisplay, and extent-manipulation code. - - Buffer positions are used in all other code. This is because this - representation is easiest to work with (especially since Lisp - code always uses buffer positions), necessitates the fewest - changes to existing code, and is the safest (e.g. if the text gets - shifted underneath a buffer position, it will still point to a - character; if text is shifted under a byte index, it might point - to the middle of a character, which would be bad). - - Similarly, Charcounts are used in all code that deals with strings - except for code that needs to be fast, which used Bytecounts. - - Strings are always passed around internally using internal format. - Conversions between external format are performed at the time - that the data goes in or out of Emacs. - - Working with the various representations: - ========================================= */ - -/* We write things this way because it's very important the - MAX_BYTEBPOS_GAP_SIZE_3 is a multiple of 3. (As it happens, - 65535 is a multiple of 3, but this may not always be the - case.) */ - - -/* - 1. Character Sets - ================= + ========================================================================== + 1. Character Sets + ========================================================================== A character set (or "charset") is an ordered set of characters. + + A character (which is, BTW, a surprisingly complex concept) is, in a + written representation of text, the most basic written unit that has a + meaning of its own. It's comparable to a phoneme when analyzing words + in spoken speech. Just like with a phoneme (which is an abstract + concept, and is represented in actual spoken speech by one or more + allophones, ...&&#### finish this., a character is actually an abstract + concept + A particular character in a charset is indexed using one or more "position codes", which are non-negative integers. The number of position codes needed to identify a particular @@ -298,8 +130,9 @@ This is a bit ad-hoc but gets the job done. - 2. Encodings - ============ + ========================================================================== + 2. Encodings + ========================================================================== An "encoding" is a way of numerically representing characters from one or more character sets. If an encoding @@ -378,8 +211,9 @@ Initially, Printing-ASCII is invoked. - 3. Internal Mule Encodings - ========================== + ========================================================================== + 3. Internal Mule Encodings + ========================================================================== In XEmacs/Mule, each character set is assigned a unique number, called a "leading byte". This is used in the encodings of a @@ -489,10 +323,202 @@ Note that character codes 0 - 255 are the same as the "binary encoding" described above. -*/ - -/* - About Unicode support: + + Most of the code in XEmacs knows nothing of the representation of a + character other than that values 0 - 255 represent ASCII, Control 1, + and Latin 1. + + WARNING WARNING WARNING: The Boyer-Moore code in search.c, and the + code in search_buffer() that determines whether that code can be used, + knows that "field 3" in a character always corresponds to the last + byte in the textual representation of the character. (This is important + because the Boyer-Moore algorithm works by looking at the last byte + of the search string and &&#### finish this. + + ========================================================================== + 4. Buffer Positions and Other Typedefs + ========================================================================== + + A. Buffer Positions + + There are three possible ways to specify positions in a buffer. All + of these are one-based: the beginning of the buffer is position or + index 1, and 0 is not a valid position. + + As a "buffer position" (typedef Charbpos): + + This is an index specifying an offset in characters from the + beginning of the buffer. Note that buffer positions are + logically *between* characters, not on a character. The + difference between two buffer positions specifies the number of + characters between those positions. Buffer positions are the + only kind of position externally visible to the user. + + As a "byte index" (typedef Bytebpos): + + This is an index over the bytes used to represent the characters + in the buffer. If there is no Mule support, this is identical + to a buffer position, because each character is represented + using one byte. However, with Mule support, many characters + require two or more bytes for their representation, and so a + byte index may be greater than the corresponding buffer + position. + + As a "memory index" (typedef Membpos): + + This is the byte index adjusted for the gap. For positions + before the gap, this is identical to the byte index. For + positions after the gap, this is the byte index plus the gap + size. There are two possible memory indices for the gap + position; the memory index at the beginning of the gap should + always be used, except in code that deals with manipulating the + gap, where both indices may be seen. The address of the + character "at" (i.e. following) a particular position can be + obtained from the formula + + buffer_start_address + memory_index(position) - 1 + + except in the case of characters at the gap position. + + B. Other Typedefs + + Emchar: + ------- + This typedef represents a single Emacs character, which can be + ASCII, ISO-8859, or some extended character, as would typically + be used for Kanji. Note that the representation of a character + as an Emchar is *not* the same as the representation of that + same character in a string; thus, you cannot do the standard + C trick of passing a pointer to a character to a function that + expects a string. + + An Emchar takes up 19 bits of representation and (for code + compatibility and such) is compatible with an int. This + representation is visible on the Lisp level. The important + characteristics of the Emchar representation are + + -- values 0x00 - 0x7f represent ASCII. + -- values 0x80 - 0xff represent the right half of ISO-8859-1. + -- values 0x100 and up represent all other characters. + + This means that Emchar values are upwardly compatible with + the standard 8-bit representation of ASCII/ISO-8859-1. + + Intbyte: + -------- + The data in a buffer or string is logically made up of Intbyte + objects, where a Intbyte takes up the same amount of space as a + char. (It is declared differently, though, to catch invalid + usages.) Strings stored using Intbytes are said to be in + "internal format". The important characteristics of internal + format are + + -- ASCII characters are represented as a single Intbyte, + in the range 0 - 0x7f. + -- All other characters are represented as a Intbyte in + the range 0x80 - 0x9f followed by one or more Intbytes + in the range 0xa0 to 0xff. + + This leads to a number of desirable properties: + + -- Given the position of the beginning of a character, + you can find the beginning of the next or previous + character in constant time. + -- When searching for a substring or an ASCII character + within the string, you need merely use standard + searching routines. + + array of char: + -------------- + Strings that go in or out of Emacs are in "external format", + typedef'ed as an array of char or a char *. There is more + than one external format (JIS, EUC, etc.) but they all + have similar properties. They are modal encodings, + which is to say that the meaning of particular bytes is + not fixed but depends on what "mode" the string is currently + in (e.g. bytes in the range 0 - 0x7f might be + interpreted as ASCII, or as Hiragana, or as 2-byte Kanji, + depending on the current mode). The mode starts out in + ASCII/ISO-8859-1 and is switched using escape sequences -- + for example, in the JIS encoding, 'ESC $ B' switches to a + mode where pairs of bytes in the range 0 - 0x7f + are interpreted as Kanji characters. + + External-formatted data is generally desirable for passing + data between programs because it is upwardly compatible + with standard ASCII/ISO-8859-1 strings and may require + less space than internal encodings such as the one + described above. In addition, some encodings (e.g. JIS) + keep all characters (except the ESC used to switch modes) + in the printing ASCII range 0x20 - 0x7e, which results in + a much higher probability that the data will avoid being + garbled in transmission. Externally-formatted data is + generally not very convenient to work with, however, and + for this reason is usually converted to internal format + before any work is done on the string. + + NOTE: filenames need to be in external format so that + ISO-8859-1 characters come out correctly. + + Charcount: + ---------- + This typedef represents a count of characters, such as + a character offset into a string or the number of + characters between two positions in a buffer. The + difference between two Charbpos's is a Charcount, and + character positions in a string are represented using + a Charcount. + + Bytecount: + ---------- + Similar to a Charcount but represents a count of bytes. + The difference between two Bytebpos's is a Bytecount. + + + C. Usage of the Various Representations + + Memory indices are used in low-level functions in insdel.c and for + extent endpoints and marker positions. The reason for this is that + this way, the extents and markers don't need to be updated for most + insertions, which merely shrink the gap and don't move any + characters around in memory. + + (The beginning-of-gap memory index simplifies insertions w.r.t. + markers, because text usually gets inserted after markers. For + extents, it is merely for consistency, because text can get + inserted either before or after an extent's endpoint depending on + the open/closedness of the endpoint.) + + Byte indices are used in other code that needs to be fast, + such as the searching, redisplay, and extent-manipulation code. + + Buffer positions are used in all other code. This is because this + representation is easiest to work with (especially since Lisp + code always uses buffer positions), necessitates the fewest + changes to existing code, and is the safest (e.g. if the text gets + shifted underneath a buffer position, it will still point to a + character; if text is shifted under a byte index, it might point + to the middle of a character, which would be bad). + + Similarly, Charcounts are used in all code that deals with strings + except for code that needs to be fast, which used Bytecounts. + + Strings are always passed around internally using internal format. + Conversions between external format are performed at the time + that the data goes in or out of Emacs. + + D. Working With the Various Representations + + We write things this way because it's very important the + MAX_BYTEBPOS_GAP_SIZE_3 is a multiple of 3. (As it happens, + 65535 is a multiple of 3, but this may not always be the + case. #### unfinished + + ========================================================================== + 5. Miscellaneous + ========================================================================== + + A. Unicode Support Adding Unicode support is very desirable. Unicode will likely be a very common representation in the future, and thus we should @@ -508,10 +534,11 @@ leading bytes and move them into private space. The CNS charsets are good candidates since they are rarely used, and JAPANESE_JISX0208_1978 is becoming less and less used and could - also be dumped. */ - - -/* Composite characters are characters constructed by overstriking two + also be dumped. + + B. Composite Characters + + Composite characters are characters constructed by overstriking two or more regular characters. 1) The old Mule implementation involves storing composite characters @@ -538,7 +565,9 @@ over the XEmacs process lifetime, and you only need to increase the size of a Mule character from 19 to 21 bits. Or you could use 0x8D C1 C2 C3 C4, allowing for about - 85 million (slightly over 2^26) composite characters. */ + 85 million (slightly over 2^26) composite characters. + +*/ /************************************************************************/ @@ -560,7 +589,7 @@ rep_bytes_by_first_byte(c) is more efficient than the equivalent canonical computation: - XCHARSET_REP_BYTES (CHARSET_BY_LEADING_BYTE (c)) */ + XCHARSET_REP_BYTES (charset_by_leading_byte (c)) */ const Bytecount rep_bytes_by_first_byte[0xA0] = { /* 0x00 - 0x7f are for straight ASCII */ @@ -1010,7 +1039,7 @@ Intbyte * convert_emchar_string_into_malloced_string (Emchar *arr, int nels, - Bytecount *len_out) + Bytecount *len_out) { /* Damn zero-termination. */ Intbyte *str = (Intbyte *) alloca (nels * MAX_EMCHAR_LEN + 1); @@ -1030,6 +1059,145 @@ return str; } +#define COPY_TEXT_BETWEEN_FORMATS(srcfmt, dstfmt) \ +do \ +{ \ + if (dst) \ + { \ + Intbyte *dstend = dst + dstlen; \ + Intbyte *dstp = dst; \ + const Intbyte *srcend = src + srclen; \ + const Intbyte *srcp = src; \ + \ + while (srcp < srcend) \ + { \ + Emchar ch = charptr_emchar_fmt (srcp, srcfmt, srcobj); \ + Bytecount len = emchar_len_fmt (ch, dstfmt); \ + \ + if (dstp + len <= dstend) \ + { \ + set_charptr_emchar_fmt (dstp, ch, dstfmt, dstobj); \ + dstp += len; \ + } \ + else \ + break; \ + INC_CHARPTR_FMT (srcp, srcfmt); \ + } \ + text_checking_assert (srcp <= srcend); \ + if (src_used) \ + *src_used = srcp - src; \ + return dstp - dst; \ + } \ + else \ + { \ + const Intbyte *srcend = src + srclen; \ + const Intbyte *srcp = src; \ + Bytecount total = 0; \ + \ + while (srcp < srcend) \ + { \ + total += emchar_len_fmt (charptr_emchar_fmt (srcp, srcfmt, \ + srcobj), dstfmt); \ + INC_CHARPTR_FMT (srcp, srcfmt); \ + } \ + text_checking_assert (srcp == srcend); \ + if (src_used) \ + *src_used = srcp - src; \ + return total; \ + } \ +} \ +while (0) + +/* Copy as much text from SRC/SRCLEN to DST/DSTLEN as will fit, converting + from SRCFMT/SRCOBJ to DSTFMT/DSTOBJ. Return number of bytes stored into + DST as return value, and number of bytes copied from SRC through + SRC_USED (if not NULL). If DST is NULL, don't actually store anything + and just return the size needed to store all the text. Will not copy + partial characters into DST. */ + +Bytecount +copy_text_between_formats (const Intbyte *src, Bytecount srclen, + Internal_Format srcfmt, + Lisp_Object srcobj, + Intbyte *dst, Bytecount dstlen, + Internal_Format dstfmt, + Lisp_Object dstobj, + Bytecount *src_used) +{ + if (srcfmt == dstfmt && + objects_have_same_internal_representation (srcobj, dstobj)) + { + if (dst) + { + srclen = min (srclen, dstlen); + srclen = validate_intbyte_string_backward (src, srclen); + memcpy (dst, src, srclen); + if (src_used) + *src_used = srclen; + return srclen; + } + else + return srclen; + } + /* Everything before the final else statement is an optimization. + The inner loops inside COPY_TEXT_BETWEEN_FORMATS() have a number + of calls to *_fmt(), each of which has a switch statement in it. + By using constants as the FMT argument, these switch statements + will be optimized out of existence. */ +#define ELSE_FORMATS(fmt1, fmt2) \ + else if (srcfmt == fmt1 && dstfmt == fmt2) \ + COPY_TEXT_BETWEEN_FORMATS (fmt1, fmt2) + ELSE_FORMATS (FORMAT_DEFAULT, FORMAT_8_BIT_FIXED); + ELSE_FORMATS (FORMAT_8_BIT_FIXED, FORMAT_DEFAULT); + ELSE_FORMATS (FORMAT_DEFAULT, FORMAT_32_BIT_FIXED); + ELSE_FORMATS (FORMAT_32_BIT_FIXED, FORMAT_DEFAULT); + else + COPY_TEXT_BETWEEN_FORMATS (srcfmt, dstfmt); +#undef ELSE_FORMATS +} + +/* Copy as much buffer text in BUF, starting at POS, of length LEN, as will + fit into DST/DSTLEN, converting to DSTFMT. Return number of bytes + stored into DST as return value, and number of bytes copied from BUF + through SRC_USED (if not NULL). If DST is NULL, don't actually store + anything and just return the size needed to store all the text. */ + +Bytecount +copy_buffer_text_out (struct buffer *buf, Bytebpos pos, + Bytecount len, Intbyte *dst, Bytecount dstlen, + Internal_Format dstfmt, Lisp_Object dstobj, + Bytecount *src_used) +{ + Bytecount dst_used = 0; + if (src_used) + *src_used = 0; + + { + BUFFER_TEXT_LOOP (buf, pos, len, runptr, runlen) + { + Bytecount the_src_used, the_dst_used; + + the_dst_used = copy_text_between_formats (runptr, runlen, + BUF_FORMAT (buf), + wrap_buffer (buf), + dst, dstlen, dstfmt, + dstobj, &the_src_used); + dst_used += the_dst_used; + if (src_used) + *src_used += the_src_used; + if (dst) + { + dst += the_dst_used; + dstlen -= the_dst_used; + if (!dstlen) + break; + } + } + } + + return dst_used; +} + /************************************************************************/ /* charset properties of strings */ @@ -1055,7 +1223,7 @@ while (str < strend) { - charsets[CHAR_LEADING_BYTE (charptr_emchar (str)) - MIN_LEADING_BYTE] = + charsets[emchar_leading_byte (charptr_emchar (str)) - MIN_LEADING_BYTE] = 1; INC_CHARPTR (str); } @@ -1083,7 +1251,7 @@ for (i = 0; i < len; i++) { - charsets[CHAR_LEADING_BYTE (str[i]) - MIN_LEADING_BYTE] = 1; + charsets[emchar_leading_byte (str[i]) - MIN_LEADING_BYTE] = 1; } #endif } @@ -1098,7 +1266,7 @@ { #ifdef MULE Emchar ch = charptr_emchar (str); - cols += XCHARSET_COLUMNS (CHAR_CHARSET (ch)); + cols += XCHARSET_COLUMNS (emchar_charset (ch)); #else cols++; #endif @@ -1116,7 +1284,7 @@ int i; for (i = 0; i < len; i++) - cols += XCHARSET_COLUMNS (CHAR_CHARSET (str[i])); + cols += XCHARSET_COLUMNS (emchar_charset (str[i])); return cols; #else /* not MULE */ @@ -1133,7 +1301,7 @@ while (str < end) { - if (!BYTE_ASCII_P (*str)) + if (!byte_ascii_p (*str)) retval++; INC_CHARPTR (str); } @@ -1268,7 +1436,8 @@ } Intbyte * -eicpyout_malloc_fmt (Eistring *eistr, Bytecount *len_out, Internal_Format fmt) +eicpyout_malloc_fmt (Eistring *eistr, Bytecount *len_out, Internal_Format fmt, + Lisp_Object object) { Intbyte *ptr; @@ -1289,32 +1458,22 @@ #ifdef MULE -/* We include the basic functions here that require no specific - knowledge of how data is Mule-encoded into a buffer other - than the basic (00 - 7F), (80 - 9F), (A0 - FF) scheme. - Anything that requires more specific knowledge goes into - mule-charset.c. */ - -/* Given a pointer to a text string and a length in bytes, return - the equivalent length in characters. */ - -Charcount -bytecount_to_charcount (const Intbyte *ptr, Bytecount len) +/* Skip as many ASCII bytes as possible in the memory block [PTR, END). + Return pointer to the first non-ASCII byte. optimized for long + stretches of ASCII. */ +inline static const Intbyte * +skip_ascii (const Intbyte *ptr, const Intbyte *end) { - Charcount count = 0; - const Intbyte *end = ptr + len; - -#if SIZEOF_LONG == 8 -# define STRIDE_TYPE long -# define HIGH_BIT_MASK 0x8080808080808080UL -#elif SIZEOF_LONG_LONG == 8 && !(defined (i386) || defined (__i386__)) -# define STRIDE_TYPE long long -# define HIGH_BIT_MASK 0x8080808080808080ULL -#elif SIZEOF_LONG == 4 -# define STRIDE_TYPE long -# define HIGH_BIT_MASK 0x80808080UL +#ifdef EFFICIENT_INT_128_BIT +# define STRIDE_TYPE INT_128_BIT +# define HIGH_BIT_MASK \ + MAKE_128_BIT_UNSIGNED_CONSTANT (0x80808080808080808080808080808080) +#elif defined (EFFICIENT_INT_64_BIT) +# define STRIDE_TYPE INT_64_BIT +# define HIGH_BIT_MASK MAKE_64_BIT_UNSIGNED_CONSTANT (0x8080808080808080) #else -# error Add support for 128-bit systems here +# define STRIDE_TYPE INT_32_BIT +# define HIGH_BIT_MASK MAKE_32_BIT_UNSIGNED_CONSTANT (0x80808080) #endif #define ALIGN_BITS ((EMACS_UINT) (ALIGNOF (STRIDE_TYPE) - 1)) @@ -1322,39 +1481,52 @@ #define ALIGNED(ptr) ((((EMACS_UINT) ptr) & ALIGN_BITS) == 0) #define STRIDE sizeof (STRIDE_TYPE) - while (ptr < end) + const unsigned STRIDE_TYPE *ascii_end; + + /* Need to do in 3 sections -- before alignment start, aligned chunk, + after alignment end. */ + while (!ALIGNED (ptr)) { - if (BYTE_ASCII_P (*ptr)) - { - /* optimize for long stretches of ASCII */ - if (! ALIGNED (ptr)) - ptr++, count++; - else - { - const unsigned STRIDE_TYPE *ascii_end = - (const unsigned STRIDE_TYPE *) ptr; - /* This loop screams, because we can detect ASCII - characters 4 or 8 at a time. */ - while ((const Intbyte *) ascii_end + STRIDE <= end - && !(*ascii_end & HIGH_BIT_MASK)) - ascii_end++; - if ((Intbyte *) ascii_end == ptr) - ptr++, count++; - else - { - count += (Intbyte *) ascii_end - ptr; - ptr = (Intbyte *) ascii_end; - } - } - } - else - { - /* optimize for successive characters from the same charset */ - Intbyte leading_byte = *ptr; - int bytes = REP_BYTES_BY_FIRST_BYTE (leading_byte); - while ((ptr < end) && (*ptr == leading_byte)) - ptr += bytes, count++; - } + if (ptr == end || !byte_ascii_p (*ptr)) + return ptr; + ptr++; + } + ascii_end = (const unsigned STRIDE_TYPE *) ptr; + /* This loop screams, because we can detect ASCII + characters 4 or 8 at a time. */ + while ((const Intbyte *) ascii_end + STRIDE <= end + && !(*ascii_end & HIGH_BIT_MASK)) + ascii_end++; + ptr = (Intbyte *) ascii_end; + while (ptr < end && byte_ascii_p (*ptr)) + ptr++; + return ptr; +} + +/* Function equivalents of bytecount_to_charcount/charcount_to_bytecount. + These work on strings of all sizes but are more efficient than a simple + loop on large strings and probably less efficient on sufficiently small + strings. */ + +Charcount +bytecount_to_charcount_fun (const Intbyte *ptr, Bytecount len) +{ + Charcount count = 0; + const Intbyte *end = ptr + len; + while (1) + { + const Intbyte *newptr = skip_ascii (ptr, end); + count += newptr - ptr; + ptr = newptr; + if (ptr == end) + break; + { + /* Optimize for successive characters from the same charset */ + Intbyte leading_byte = *ptr; + int bytes = rep_bytes_by_first_byte (leading_byte); + while (ptr < end && *ptr == leading_byte) + ptr += bytes, count++; + } } /* Bomb out if the specified substring ends in the middle @@ -1368,29 +1540,28 @@ return count; } -/* Given a pointer to a text string and a length in characters, return - the equivalent length in bytes. */ - Bytecount -charcount_to_bytecount (const Intbyte *ptr, Charcount len) +charcount_to_bytecount_fun (const Intbyte *ptr, Charcount len) { const Intbyte *newptr = ptr; - - text_checking_assert (len >= 0); - while (len > 0) + while (1) { - INC_CHARPTR (newptr); - len--; + const Intbyte *newnewptr = skip_ascii (newptr, newptr + len); + len -= newnewptr - newptr; + newptr = newnewptr; + if (!len) + break; + { + /* Optimize for successive characters from the same charset */ + Intbyte leading_byte = *newptr; + int bytes = rep_bytes_by_first_byte (leading_byte); + while (len > 0 && *newptr == leading_byte) + newptr += bytes, len--; + } } return newptr - ptr; } -inline static void -update_entirely_ascii_p_flag (struct buffer *buf) -{ - buf->text->entirely_ascii_p = buf->text->z == buf->text->bufz; -} - /* The next two functions are the actual meat behind the charbpos-to-bytebpos and bytebpos-to-charbpos conversions. Currently the method they use is fairly unsophisticated; see buffer.h. @@ -1422,11 +1593,11 @@ /* Check for some cached positions, for speed. */ if (x == BUF_PT (buf)) - return BI_BUF_PT (buf); + return BYTE_BUF_PT (buf); if (x == BUF_ZV (buf)) - return BI_BUF_ZV (buf); + return BYTE_BUF_ZV (buf); if (x == BUF_BEGV (buf)) - return BI_BUF_BEGV (buf); + return BYTE_BUF_BEGV (buf); bufmin = buf->text->mule_bufmin; bufmax = buf->text->mule_bufmax; @@ -1474,7 +1645,7 @@ if (diffpt < diffmax && diffpt <= diffzv) { bufmax = bufmin = BUF_PT (buf); - bytmax = bytmin = BI_BUF_PT (buf); + bytmax = bytmin = BYTE_BUF_PT (buf); /* We set the size to 1 even though it doesn't really matter because the new known region contains no characters. We do this because this is the most @@ -1486,7 +1657,7 @@ if (diffzv < diffmax) { bufmax = bufmin = BUF_ZV (buf); - bytmax = bytmin = BI_BUF_ZV (buf); + bytmax = bytmin = BYTE_BUF_ZV (buf); size = 1; } } @@ -1516,7 +1687,7 @@ if (diffpt < diffmin && diffpt <= diffbegv) { bufmax = bufmin = BUF_PT (buf); - bytmax = bytmin = BI_BUF_PT (buf); + bytmax = bytmin = BYTE_BUF_PT (buf); /* We set the size to 1 even though it doesn't really matter because the new known region contains no characters. We do this because this is the most @@ -1528,7 +1699,7 @@ if (diffbegv < diffmin) { bufmax = bufmin = BUF_BEGV (buf); - bytmax = bytmin = BI_BUF_BEGV (buf); + bytmax = bytmin = BYTE_BUF_BEGV (buf); size = 1; } } @@ -1698,11 +1869,11 @@ int add_to_cache = 0; /* Check for some cached positions, for speed. */ - if (x == BI_BUF_PT (buf)) + if (x == BYTE_BUF_PT (buf)) return BUF_PT (buf); - if (x == BI_BUF_ZV (buf)) + if (x == BYTE_BUF_ZV (buf)) return BUF_ZV (buf); - if (x == BI_BUF_BEGV (buf)) + if (x == BYTE_BUF_BEGV (buf)) return BUF_BEGV (buf); bufmin = buf->text->mule_bufmin; @@ -1718,16 +1889,16 @@ when the size of the character just seen changes. We optimize this, however, by first shifting the known region to - one of the cached points if it's close by. (We don't check BI_BEG or - BI_Z, even though they're cached; most of the time these will be the - same as BI_BEGV and BI_ZV, and when they're not, they're not likely + one of the cached points if it's close by. (We don't check BYTE_BEG or + BYTE_Z, even though they're cached; most of the time these will be the + same as BYTE_BEGV and BYTE_ZV, and when they're not, they're not likely to be used.) */ if (x > bytmax) { Bytebpos diffmax = x - bytmax; - Bytebpos diffpt = x - BI_BUF_PT (buf); - Bytebpos diffzv = BI_BUF_ZV (buf) - x; + Bytebpos diffpt = x - BYTE_BUF_PT (buf); + Bytebpos diffzv = BYTE_BUF_ZV (buf) - x; /* #### This value could stand some more exploration. */ Bytecount heuristic_hack = (bytmax - bytmin) >> 2; @@ -1740,10 +1911,10 @@ diffzv = -diffzv; /* But also implement a heuristic that favors the known region - over BI_PT or BI_ZV. The reason for this is that switching to - BI_PT or BI_ZV will wipe out the knowledge in the known region, + over BYTE_PT or BYTE_ZV. The reason for this is that switching to + BYTE_PT or BYTE_ZV will wipe out the knowledge in the known region, which might be annoying if the known region is large and - BI_PT or BI_ZV is not that much closer than the end of the known + BYTE_PT or BYTE_ZV is not that much closer than the end of the known region. */ diffzv += heuristic_hack; @@ -1751,7 +1922,7 @@ if (diffpt < diffmax && diffpt <= diffzv) { bufmax = bufmin = BUF_PT (buf); - bytmax = bytmin = BI_BUF_PT (buf); + bytmax = bytmin = BYTE_BUF_PT (buf); /* We set the size to 1 even though it doesn't really matter because the new known region contains no characters. We do this because this is the most @@ -1763,7 +1934,7 @@ if (diffzv < diffmax) { bufmax = bufmin = BUF_ZV (buf); - bytmax = bytmin = BI_BUF_ZV (buf); + bytmax = bytmin = BYTE_BUF_ZV (buf); size = 1; } } @@ -1774,8 +1945,8 @@ else { Bytebpos diffmin = bytmin - x; - Bytebpos diffpt = BI_BUF_PT (buf) - x; - Bytebpos diffbegv = x - BI_BUF_BEGV (buf); + Bytebpos diffpt = BYTE_BUF_PT (buf) - x; + Bytebpos diffbegv = x - BYTE_BUF_BEGV (buf); /* #### This value could stand some more exploration. */ Bytecount heuristic_hack = (bytmax - bytmin) >> 2; @@ -1793,7 +1964,7 @@ if (diffpt < diffmin && diffpt <= diffbegv) { bufmax = bufmin = BUF_PT (buf); - bytmax = bytmin = BI_BUF_PT (buf); + bytmax = bytmin = BYTE_BUF_PT (buf); /* We set the size to 1 even though it doesn't really matter because the new known region contains no characters. We do this because this is the most @@ -1805,7 +1976,7 @@ if (diffbegv < diffmin) { bufmax = bufmin = BUF_BEGV (buf); - bytmax = bytmin = BI_BUF_BEGV (buf); + bytmax = bytmin = BYTE_BUF_BEGV (buf); size = 1; } } @@ -1981,7 +2152,7 @@ } if (start >= buf->text->mule_bufmax) - goto done; + return; /* The insertion is either before the known region, in which case it shoves it forward; or within the known region, in which case @@ -2054,17 +2225,15 @@ } } } - done: - update_entirely_ascii_p_flag (buf); } -/* Text from START to END (equivalent in Bytebposs: from BI_START to - BI_END) was deleted. */ +/* Text from START to END (equivalent in Bytebpos's: from BYTE_START to + BYTE_END) was deleted. */ void buffer_mule_signal_deleted_region (struct buffer *buf, Charbpos start, - Charbpos end, Bytebpos bi_start, - Bytebpos bi_end) + Charbpos end, Bytebpos byte_start, + Bytebpos byte_end) { int i; @@ -2075,64 +2244,42 @@ if (buf->text->mule_charbpos_cache[i] > end) { buf->text->mule_charbpos_cache[i] -= end - start; - buf->text->mule_bytebpos_cache[i] -= bi_end - bi_start; + buf->text->mule_bytebpos_cache[i] -= byte_end - byte_start; } /* In the range; moves to start of range */ else if (buf->text->mule_charbpos_cache[i] > start) { buf->text->mule_charbpos_cache[i] = start; - buf->text->mule_bytebpos_cache[i] = bi_start; + buf->text->mule_bytebpos_cache[i] = byte_start; } } /* We don't care about any text after the end of the known region. */ end = min (end, buf->text->mule_bufmax); - bi_end = min (bi_end, buf->text->mule_bytmax); + byte_end = min (byte_end, buf->text->mule_bytmax); if (start >= end) - goto done; + return; /* The end of the known region offsets by the total amount of deletion, since it's all before it. */ buf->text->mule_bufmax -= end - start; - buf->text->mule_bytmax -= bi_end - bi_start; + buf->text->mule_bytmax -= byte_end - byte_start; /* Now we don't care about any text after the start of the known region. */ end = min (end, buf->text->mule_bufmin); - bi_end = min (bi_end, buf->text->mule_bytmin); + byte_end = min (byte_end, buf->text->mule_bytmin); if (start < end) { buf->text->mule_bufmin -= end - start; - buf->text->mule_bytmin -= bi_end - bi_start; + buf->text->mule_bytmin -= byte_end - byte_start; } - - done: - update_entirely_ascii_p_flag (buf); } #endif /* MULE */ -#ifdef ERROR_CHECK_TEXT - -Bytebpos -charbpos_to_bytebpos (struct buffer *buf, Charbpos x) -{ - Bytebpos retval = real_charbpos_to_bytebpos (buf, x); - ASSERT_VALID_BYTEBPOS_UNSAFE (buf, retval); - return retval; -} - -Charbpos -bytebpos_to_charbpos (struct buffer *buf, Bytebpos x) -{ - ASSERT_VALID_BYTEBPOS_UNSAFE (buf, x); - return real_bytebpos_to_charbpos (buf, x); -} - -#endif /* ERROR_CHECK_TEXT */ - /************************************************************************/ /* verifying buffer and string positions */ @@ -2250,7 +2397,8 @@ void get_buffer_range_char (struct buffer *b, Lisp_Object from, Lisp_Object to, - Charbpos *from_out, Charbpos *to_out, unsigned int flags) + Charbpos *from_out, Charbpos *to_out, + unsigned int flags) { /* Does not GC */ Charbpos min_allowed, max_allowed; @@ -2292,7 +2440,8 @@ void get_buffer_range_byte (struct buffer *b, Lisp_Object from, Lisp_Object to, - Bytebpos *from_out, Bytebpos *to_out, unsigned int flags) + Bytebpos *from_out, Bytebpos *to_out, + unsigned int flags) { Charbpos s, e; @@ -2339,7 +2488,7 @@ get_string_pos_char (Lisp_Object string, Lisp_Object pos, unsigned int flags) { return get_string_pos_char_1 (string, pos, flags, - XSTRING_CHAR_LENGTH (string)); + string_char_length (string)); } Bytecount @@ -2357,7 +2506,7 @@ unsigned int flags) { Charcount min_allowed = 0; - Charcount max_allowed = XSTRING_CHAR_LENGTH (string); + Charcount max_allowed = string_char_length (string); if (NILP (from) && (flags & GB_ALLOW_NIL)) *from_out = min_allowed; @@ -2408,7 +2557,7 @@ } -Charbpos +Charxpos get_buffer_or_string_pos_char (Lisp_Object object, Lisp_Object pos, unsigned int flags) { @@ -2417,7 +2566,7 @@ get_buffer_pos_char (XBUFFER (object), pos, flags); } -Bytebpos +Bytexpos get_buffer_or_string_pos_byte (Lisp_Object object, Lisp_Object pos, unsigned int flags) { @@ -2428,76 +2577,146 @@ void get_buffer_or_string_range_char (Lisp_Object object, Lisp_Object from, - Lisp_Object to, Charbpos *from_out, - Charbpos *to_out, unsigned int flags) + Lisp_Object to, Charxpos *from_out, + Charxpos *to_out, unsigned int flags) { if (STRINGP (object)) get_string_range_char (object, from, to, from_out, to_out, flags); else - get_buffer_range_char (XBUFFER (object), from, to, from_out, to_out, flags); + get_buffer_range_char (XBUFFER (object), from, to, from_out, to_out, + flags); } void get_buffer_or_string_range_byte (Lisp_Object object, Lisp_Object from, - Lisp_Object to, Bytebpos *from_out, - Bytebpos *to_out, unsigned int flags) + Lisp_Object to, Bytexpos *from_out, + Bytexpos *to_out, unsigned int flags) { if (STRINGP (object)) get_string_range_byte (object, from, to, from_out, to_out, flags); else - get_buffer_range_byte (XBUFFER (object), from, to, from_out, to_out, flags); + get_buffer_range_byte (XBUFFER (object), from, to, from_out, to_out, + flags); } -Charbpos +Charxpos buffer_or_string_accessible_begin_char (Lisp_Object object) { return STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object)); } -Charbpos +Charxpos buffer_or_string_accessible_end_char (Lisp_Object object) { return STRINGP (object) ? - XSTRING_CHAR_LENGTH (object) : BUF_ZV (XBUFFER (object)); + string_char_length (object) : BUF_ZV (XBUFFER (object)); } -Bytebpos +Bytexpos buffer_or_string_accessible_begin_byte (Lisp_Object object) { - return STRINGP (object) ? 0 : BI_BUF_BEGV (XBUFFER (object)); + return STRINGP (object) ? 0 : BYTE_BUF_BEGV (XBUFFER (object)); } -Bytebpos +Bytexpos buffer_or_string_accessible_end_byte (Lisp_Object object) { return STRINGP (object) ? - XSTRING_LENGTH (object) : BI_BUF_ZV (XBUFFER (object)); + XSTRING_LENGTH (object) : BYTE_BUF_ZV (XBUFFER (object)); } -Charbpos +Charxpos buffer_or_string_absolute_begin_char (Lisp_Object object) { return STRINGP (object) ? 0 : BUF_BEG (XBUFFER (object)); } -Charbpos +Charxpos buffer_or_string_absolute_end_char (Lisp_Object object) { return STRINGP (object) ? - XSTRING_CHAR_LENGTH (object) : BUF_Z (XBUFFER (object)); + string_char_length (object) : BUF_Z (XBUFFER (object)); +} + +Bytexpos +buffer_or_string_absolute_begin_byte (Lisp_Object object) +{ + return STRINGP (object) ? 0 : BYTE_BUF_BEG (XBUFFER (object)); +} + +Bytexpos +buffer_or_string_absolute_end_byte (Lisp_Object object) +{ + return STRINGP (object) ? + XSTRING_LENGTH (object) : BYTE_BUF_Z (XBUFFER (object)); +} + +Charbpos +charbpos_clip_to_bounds (Charbpos lower, Charbpos num, Charbpos upper) +{ + return (num < lower ? lower : + num > upper ? upper : + num); } Bytebpos -buffer_or_string_absolute_begin_byte (Lisp_Object object) +bytebpos_clip_to_bounds (Bytebpos lower, Bytebpos num, Bytebpos upper) +{ + return (num < lower ? lower : + num > upper ? upper : + num); +} + +Charxpos +charxpos_clip_to_bounds (Charxpos lower, Charxpos num, Charxpos upper) { - return STRINGP (object) ? 0 : BI_BUF_BEG (XBUFFER (object)); + return (num < lower ? lower : + num > upper ? upper : + num); +} + +Bytexpos +bytexpos_clip_to_bounds (Bytexpos lower, Bytexpos num, Bytexpos upper) +{ + return (num < lower ? lower : + num > upper ? upper : + num); } -Bytebpos -buffer_or_string_absolute_end_byte (Lisp_Object object) +/* These could be implemented in terms of the get_buffer_or_string() + functions above, but those are complicated and handle lots of weird + cases stemming from uncertain external input. */ + +Charxpos +buffer_or_string_clip_to_accessible_char (Lisp_Object object, Charxpos pos) +{ + return (charxpos_clip_to_bounds + (pos, buffer_or_string_accessible_begin_char (object), + buffer_or_string_accessible_end_char (object))); +} + +Bytexpos +buffer_or_string_clip_to_accessible_byte (Lisp_Object object, Bytexpos pos) { - return STRINGP (object) ? - XSTRING_LENGTH (object) : BI_BUF_Z (XBUFFER (object)); + return (bytexpos_clip_to_bounds + (pos, buffer_or_string_accessible_begin_byte (object), + buffer_or_string_accessible_end_byte (object))); +} + +Charxpos +buffer_or_string_clip_to_absolute_char (Lisp_Object object, Charxpos pos) +{ + return (charxpos_clip_to_bounds + (pos, buffer_or_string_absolute_begin_char (object), + buffer_or_string_absolute_end_char (object))); +} + +Bytexpos +buffer_or_string_clip_to_absolute_byte (Lisp_Object object, Bytexpos pos) +{ + return (bytexpos_clip_to_bounds + (pos, buffer_or_string_absolute_begin_byte (object), + buffer_or_string_absolute_end_byte (object))); } @@ -2597,7 +2816,7 @@ for (end = ptr + len; ptr < end;) { Intbyte c = - (BYTE_ASCII_P (*ptr)) ? *ptr : + (byte_ascii_p (*ptr)) ? *ptr : (*ptr == LEADING_BYTE_CONTROL_1) ? (*(ptr+1) - 0x20) : (*ptr == LEADING_BYTE_LATIN_ISO8859_1) ? (*(ptr+1)) : '~'; @@ -2636,7 +2855,7 @@ for (p = ptr; p < end; p++) { - if (!BYTE_ASCII_P (*p)) + if (!byte_ascii_p (*p)) goto the_hard_way; } @@ -2776,9 +2995,9 @@ { Intbyte c = *ptr; - if (BYTE_ASCII_P (c)) + if (byte_ascii_p (c)) Dynarr_add (conversion_in_dynarr, c); - else if (BYTE_C1_P (c)) + else if (byte_c1_p (c)) { Dynarr_add (conversion_in_dynarr, LEADING_BYTE_CONTROL_1); Dynarr_add (conversion_in_dynarr, c + 0x20); @@ -2819,10 +3038,10 @@ { Intbyte c = *ptr; - if (BYTE_ASCII_P (c)) + if (byte_ascii_p (c)) Dynarr_add (conversion_in_dynarr, c); #ifdef MULE - else if (BYTE_C1_P (c)) + else if (byte_c1_p (c)) { Dynarr_add (conversion_in_dynarr, LEADING_BYTE_CONTROL_1); Dynarr_add (conversion_in_dynarr, c + 0x20); @@ -2940,10 +3159,10 @@ Lisp_Object charset; p = str; - BREAKUP_CHAR (c, charset, c1, c2); - lb = CHAR_LEADING_BYTE (c); - if (LEADING_BYTE_PRIVATE_P (lb)) - *p++ = PRIVATE_LEADING_BYTE_PREFIX (lb); + BREAKUP_EMCHAR (c, charset, c1, c2); + lb = emchar_leading_byte (c); + if (leading_byte_private_p (lb)) + *p++ = private_leading_byte_prefix (lb); *p++ = lb; if (EQ (charset, Vcharset_control_1)) c1 += 0x20; @@ -2967,23 +3186,23 @@ if (i0 == LEADING_BYTE_CONTROL_1) return (Emchar) (*++str - 0x20); - if (LEADING_BYTE_PREFIX_P (i0)) + if (leading_byte_prefix_p (i0)) i0 = *++str; i1 = *++str & 0x7F; - charset = CHARSET_BY_LEADING_BYTE (i0); + charset = charset_by_leading_byte (i0); if (XCHARSET_DIMENSION (charset) == 2) i2 = *++str & 0x7F; - return MAKE_CHAR (charset, i1, i2); + return make_emchar (charset, i1, i2); } /* Return whether CH is a valid Emchar, assuming it's non-ASCII. - Do not call this directly. Use the macro valid_char_p() instead. */ + Do not call this directly. Use the macro valid_emchar_p() instead. */ int -non_ascii_valid_char_p (Emchar ch) +non_ascii_valid_emchar_p (Emchar ch) { int f1, f2, f3; @@ -2991,9 +3210,9 @@ if (ch & ~0x7FFFF) return 0; - f1 = CHAR_FIELD1 (ch); - f2 = CHAR_FIELD2 (ch); - f3 = CHAR_FIELD3 (ch); + f1 = emchar_field1 (ch); + f2 = emchar_field2 (ch); + f3 = emchar_field3 (ch); if (f1 == 0) { @@ -3001,9 +3220,9 @@ Lisp_Object charset; /* leading byte must be correct */ - if (f2 < MIN_CHAR_FIELD2_OFFICIAL || - (f2 > MAX_CHAR_FIELD2_OFFICIAL && f2 < MIN_CHAR_FIELD2_PRIVATE) || - f2 > MAX_CHAR_FIELD2_PRIVATE) + if (f2 < MIN_EMCHAR_FIELD2_OFFICIAL || + (f2 > MAX_EMCHAR_FIELD2_OFFICIAL && f2 < MIN_EMCHAR_FIELD2_PRIVATE) || + f2 > MAX_EMCHAR_FIELD2_PRIVATE) return 0; /* octet not out of range */ if (f3 < 0x20) @@ -3014,7 +3233,7 @@ FIELD2_TO_OFFICIAL_LEADING_BYTE and FIELD2_TO_PRIVATE_LEADING_BYTE are the same. */ - charset = CHARSET_BY_LEADING_BYTE (f2 + FIELD2_TO_OFFICIAL_LEADING_BYTE); + charset = charset_by_leading_byte (f2 + FIELD2_TO_OFFICIAL_LEADING_BYTE); if (EQ (charset, Qnil)) return 0; /* check range as per size (94 or 96) of charset */ @@ -3026,9 +3245,9 @@ Lisp_Object charset; /* leading byte must be correct */ - if (f1 < MIN_CHAR_FIELD1_OFFICIAL || - (f1 > MAX_CHAR_FIELD1_OFFICIAL && f1 < MIN_CHAR_FIELD1_PRIVATE) || - f1 > MAX_CHAR_FIELD1_PRIVATE) + if (f1 < MIN_EMCHAR_FIELD1_OFFICIAL || + (f1 > MAX_EMCHAR_FIELD1_OFFICIAL && f1 < MIN_EMCHAR_FIELD1_PRIVATE) || + f1 > MAX_EMCHAR_FIELD1_PRIVATE) return 0; /* octets not out of range */ if (f2 < 0x20 || f3 < 0x20) @@ -3046,12 +3265,12 @@ #endif /* ENABLE_COMPOSITE_CHARS */ /* charset exists */ - if (f1 <= MAX_CHAR_FIELD1_OFFICIAL) + if (f1 <= MAX_EMCHAR_FIELD1_OFFICIAL) charset = - CHARSET_BY_LEADING_BYTE (f1 + FIELD1_TO_OFFICIAL_LEADING_BYTE); + charset_by_leading_byte (f1 + FIELD1_TO_OFFICIAL_LEADING_BYTE); else charset = - CHARSET_BY_LEADING_BYTE (f1 + FIELD1_TO_PRIVATE_LEADING_BYTE); + charset_by_leading_byte (f1 + FIELD1_TO_PRIVATE_LEADING_BYTE); if (EQ (charset, Qnil)) return 0; @@ -3062,13 +3281,13 @@ } /* Copy the character pointed to by SRC into DST. Do not call this - directly. Use the macro charptr_copy_char() instead. + directly. Use the macro charptr_copy_emchar() instead. Return the number of bytes copied. */ Bytecount -non_ascii_charptr_copy_char (const Intbyte *src, Intbyte *dst) +non_ascii_charptr_copy_emchar (const Intbyte *src, Intbyte *dst) { - Bytecount bytes = REP_BYTES_BY_FIRST_BYTE (*src); + Bytecount bytes = rep_bytes_by_first_byte (*src); Bytecount i; for (i = bytes; i; i--, dst++, src++) *dst = *src; @@ -3097,7 +3316,7 @@ str[0] = (Intbyte) ch; - for (bytes = REP_BYTES_BY_FIRST_BYTE (ch) - 1; bytes; bytes--) + for (bytes = rep_bytes_by_first_byte (ch) - 1; bytes; bytes--) { int c = Lstream_getc (stream); text_checking_assert (c >= 0); @@ -3224,7 +3443,7 @@ if (!NILP (arg2)) invalid_argument ("Charset is of dimension one; second octet must be nil", arg2); - return make_char (MAKE_CHAR (charset, a1, 0)); + return make_char (make_emchar (charset, a1, 0)); } CHECK_INT (arg2); @@ -3232,7 +3451,7 @@ if (a2 < lowlim || a2 > highlim) args_out_of_range_3 (arg2, make_int (lowlim), make_int (highlim)); - return make_char (MAKE_CHAR (charset, a1, a2)); + return make_char (make_emchar (charset, a1, a2)); #else int a1; int lowlim, highlim; @@ -3265,8 +3484,8 @@ { CHECK_CHAR_COERCE_INT (ch); - return XCHARSET_NAME (CHARSET_BY_LEADING_BYTE - (CHAR_LEADING_BYTE (XCHAR (ch)))); + return XCHARSET_NAME (charset_by_leading_byte + (emchar_leading_byte (XCHAR (ch)))); } DEFUN ("char-octet", Fchar_octet, 1, 2, 0, /* @@ -3280,7 +3499,7 @@ CHECK_CHAR_COERCE_INT (ch); - BREAKUP_CHAR (XCHAR (ch), charset, octet0, octet1); + BREAKUP_EMCHAR (XCHAR (ch), charset, octet0, octet1); if (NILP (n) || EQ (n, Qzero)) return make_int (octet0); @@ -3304,7 +3523,7 @@ GCPRO2 (charset, rc); CHECK_CHAR_COERCE_INT (character); - BREAKUP_CHAR (XCHAR (character), charset, c1, c2); + BREAKUP_EMCHAR (XCHAR (character), charset, c1, c2); if (XCHARSET_DIMENSION (Fget_charset (charset)) == 2) { @@ -3341,7 +3560,7 @@ { if (composite_char_row_next >= 128) invalid_operation ("No more composite chars available", lispstr); - emch = MAKE_CHAR (Vcharset_composite, composite_char_row_next, + emch = make_emchar (Vcharset_composite, composite_char_row_next, composite_char_col_next); Fputhash (make_char (emch), lispstr, Vcomposite_char_char2string_hash_table); @@ -3369,7 +3588,7 @@ return str; } -xxDEFUN ("make-composite-char", Fmake_composite_char, 1, 1, 0, /* +DEFUN ("make-composite-char", Fmake_composite_char, 1, 1, 0, /* Convert a string into a single composite character. The character is the result of overstriking all the characters in the string. @@ -3381,7 +3600,7 @@ XSTRING_LENGTH (string))); } -xxDEFUN ("composite-char-string", Fcomposite_char_string, 1, 1, 0, /* +DEFUN ("composite-char-string", Fcomposite_char_string, 1, 1, 0, /* Return a string of the characters comprising a composite character. */ (ch)) @@ -3390,7 +3609,7 @@ CHECK_CHAR (ch); emch = XCHAR (ch); - if (CHAR_LEADING_BYTE (emch) != LEADING_BYTE_COMPOSITE) + if (emchar_leading_byte (emch) != LEADING_BYTE_COMPOSITE) invalid_argument ("Must be composite char", ch); return composite_char_string (emch); }
--- a/src/text.h Thu May 02 14:35:32 2002 +0000 +++ b/src/text.h Sun May 05 11:33:57 2002 +0000 @@ -52,32 +52,68 @@ #ifndef MULE -#define REP_BYTES_BY_FIRST_BYTE(fb) 1 -#define BYTE_ASCII_P(byte) 1 -# define MAX_EMCHAR_LEN 1 +#define rep_bytes_by_first_byte(fb) 1 +#define byte_ascii_p(byte) 1 +#define MAX_EMCHAR_LEN 1 #else /* MULE */ /* These are carefully designed to work if BYTE is signed or unsigned. */ /* Note that SPC and DEL are considered ASCII, not control. */ -#define BYTE_ASCII_P(byte) (((byte) & ~0x7f) == 0) -#define BYTE_C0_P(byte) (((byte) & ~0x1f) == 0) -#define BYTE_C1_P(byte) (((byte) & ~0x1f) == 0x80) +#define byte_ascii_p(byte) (((byte) & ~0x7f) == 0) +#define byte_c0_p(byte) (((byte) & ~0x1f) == 0) +#define byte_c1_p(byte) (((byte) & ~0x1f) == 0x80) /* Does BYTE represent the first byte of a character? */ -#define INTBYTE_FIRST_BYTE_P(byte) ((byte) < 0xA0) +#ifdef ERROR_CHECK_TEXT + +DECLARE_INLINE_HEADER ( +int +intbyte_first_byte_p_1 (int byte, const char *file, int line) +) +{ + assert_at_line (byte >= 0 && byte < 256, file, line); + return byte < 0xA0; +} + +#define intbyte_first_byte_p(byte) \ + intbyte_first_byte_p_1 (byte, __FILE__, __LINE__) + +#else + +#define intbyte_first_byte_p(byte) ((byte) < 0xA0) + +#endif + +#ifdef ERROR_CHECK_TEXT /* Does BYTE represent the first byte of a multi-byte character? */ -#define INTBYTE_LEADING_BYTE_P(byte) BYTE_C1_P (byte) +DECLARE_INLINE_HEADER ( +int +intbyte_leading_byte_p_1 (int byte, const char *file, int line) +) +{ + assert_at_line (byte >= 0 && byte < 256, file, line); + return byte_c1_p (byte); +} + +#define intbyte_leading_byte_p(byte) \ + intbyte_leading_byte_p_1 (byte, __FILE__, __LINE__) + +#else + +#define intbyte_leading_byte_p(byte) byte_c1_p (byte) + +#endif /* Table of number of bytes in the string representation of a character indexed by the first byte of that representation. This value can be derived in other ways -- e.g. something like - XCHARSET_REP_BYTES (CHARSET_BY_LEADING_BYTE (first_byte)) + XCHARSET_REP_BYTES (charset_by_leading_byte (first_byte)) but it's faster this way. */ extern const Bytecount rep_bytes_by_first_byte[0xA0]; @@ -85,32 +121,209 @@ #ifdef ERROR_CHECK_TEXT -INLINE_HEADER Bytecount REP_BYTES_BY_FIRST_BYTE_1 (int fb, const char *file, - int line); -INLINE_HEADER Bytecount -REP_BYTES_BY_FIRST_BYTE_1 (int fb, const char *file, int line) +DECLARE_INLINE_HEADER ( +Bytecount +rep_bytes_by_first_byte_1 (int fb, const char *file, int line) +) { - assert_at_line (fb < 0xA0, file, line); + assert_at_line (fb >= 0 && fb < 0xA0, file, line); return rep_bytes_by_first_byte[fb]; } -#define REP_BYTES_BY_FIRST_BYTE(fb) \ - REP_BYTES_BY_FIRST_BYTE_1 (fb, __FILE__, __LINE__) +#define rep_bytes_by_first_byte(fb) \ + rep_bytes_by_first_byte_1 (fb, __FILE__, __LINE__) #else /* ERROR_CHECK_TEXT */ -#define REP_BYTES_BY_FIRST_BYTE(fb) (rep_bytes_by_first_byte[fb]) +#define rep_bytes_by_first_byte(fb) (rep_bytes_by_first_byte[fb]) #endif /* ERROR_CHECK_TEXT */ -/* Is this character represented by more than one byte in a string? */ - -#define CHAR_MULTIBYTE_P(c) ((c) >= 0x80) - -#define CHAR_ASCII_P(c) (!CHAR_MULTIBYTE_P (c)) +/* Is this character represented by more than one byte in a string in the + default format? */ + +#define emchar_multibyte_p(c) ((c) >= 0x80) + +#define emchar_ascii_p(c) (!emchar_multibyte_p (c)) + +/* Maximum number of bytes per Emacs character when represented as text, in + any format. + */ #define MAX_EMCHAR_LEN 4 +#endif /* not MULE */ + +/* ---------------- Handling non-default formats ----------------- */ + +/* We support, at least to some extent, formats other than the default + variable-width format, for speed; all of these alternative formats are + fixed-width. Currently we only handle these non-default formats in + buffers, because access to their text is strictly controlled and thus + the details of the format mostly compartmentalized. The only really + tricky part is the search code -- the regex, Boyer-Moore, and + simple-search algorithms in search.c and regex.c. All other code that + knows directly about the buffer representation is the basic code to + modify or retrieve the buffer text. + + Supporting fixed-width formats in Lisp strings is harder, but possible + -- FSF currently does this, for example. In this case, however, + probably only 8-bit-fixed is reasonable for Lisp strings -- getting + non-ASCII-compatible fixed-width formats to work is much, much harder + because a lot of code assumes that strings are ASCII-compatible + (i.e. ASCII + other characters represented exclusively using high-bit + bytes) and a lot of code mixes Lisp strings and non-Lisp strings freely. + + The different possible fixed-width formats are 8-bit fixed, 16-bit + fixed, and 32-bit fixed. The latter can represent all possible + characters, but at a substantial memory penalty. The other two can + represent only a subset of the possible characters. How these subsets + are defined can be simple or very tricky. + + Currently we support only the default format and the 8-bit fixed format, + and in the latter, we only allow these to be the first 256 characters in + an Emchar (ASCII and Latin 1). + + One reasonable approach for 8-bit fixed is to allow the upper half to + represent any 1-byte charset, which is specified on a per-buffer basis. + This should work fairly well in practice since most documents are in + only one foreign language (possibly with some English mixed in). I + think FSF does something like this; or at least, they have something + called nonascii-translation-table and use it when converting from + 8-bit-fixed text ("unibyte text") to default text ("multibyte text"). + With 16-bit fixed, you could do something like assign chunks of the 64K + worth of characters to charsets as they're encountered in documents. + This should work well with most Asian documents. + + If/when we switch to using Unicode internally, we might have formats more + like this: + + -- UTF-8 or some extension as the default format. Perl uses an + extension that handles 64-bit chars and requires as much as 13 bytes per + char, vs. the standard of 31-bit chars and 6 bytes max. UTF-8 has the + same basic properties as our own variable-width format (see text.c, + Internal String Encoding) and so most code would not need to be changed. + + -- UTF-16 as a "pseudo-fixed" format (i.e. 16-bit fixed plus surrogates + for representing characters not in the BMP, aka >= 65536). The vast + majority of documents will have no surrogates in them so byte/char + conversion will be very fast. + + -- an 8-bit fixed format, like currently. + + -- possibly, UCS-4 as a 32-bit fixed format. + + The fixed-width formats essentially treat the buffer as an array of + 8-bit, 16-bit or 32-bit integers. This means that how they are stored + in memory (in particular, big-endian or little-endian) depends on the + native format of the machine's processor. It also means we have to + worry a bit about alignment (basically, we just need to keep the gap an + integral size of the character size, and get things aligned properly + when converting the buffer between formats). + */ +typedef enum internal_format +{ + FORMAT_DEFAULT, + FORMAT_8_BIT_FIXED, + FORMAT_16_BIT_FIXED, /* not implemented */ + FORMAT_32_BIT_FIXED /* not implemented */ +} Internal_Format; + +#ifdef MULE +/* "OBJECT" below will usually be a buffer, string, or nil. This needs to + be passed in because the interpretation of 8-bit-fixed and 16-bit-fixed + values may depend on the buffer, e.g. depending on what language the + text in the buffer is in. */ + +/* True if Emchar CH can be represented in 8-bit-fixed format. */ +#define emchar_8_bit_fixed_p(ch, object) (((ch) & ~0xff) == 0) +/* Convert Emchar CH to an 8-bit int, as will be stored in the buffer. */ +#define emchar_to_raw_8_bit_fixed(ch, object) ((Intbyte) (ch)) +/* Convert the other way. */ +#define raw_8_bit_fixed_to_emchar(ch, object) ((Emchar) (ch)) + +#define emchar_16_bit_fixed_p(ch, object) (((ch) & ~0xffff) == 0) +/* Convert Emchar CH to a 16-bit int, as will be stored in the buffer. */ +#define emchar_to_raw_16_bit_fixed(ch, object) ((UINT_16_BIT) (ch)) +/* Convert the other way. */ +#define raw_16_bit_fixed_to_emchar(ch, object) ((Emchar) (ch)) + +/* Convert Emchar CH to a 32-bit int, as will be stored in the buffer. */ +#define emchar_to_raw_32_bit_fixed(ch, object) ((UINT_32_BIT) (ch)) +/* Convert the other way. */ +#define raw_32_bit_fixed_to_emchar(ch, object) ((Emchar) (ch)) + +/* Return the "raw value" of a character as stored in the buffer. In the + default format, this is just the same as the character. In fixed-width + formats, this is the actual value in the buffer, which will be limited + to the range as established by the format. This is used when searching + for a character in a buffer -- it's faster to convert the character to + the raw value and look for that, than repeatedly convert each raw value + in the buffer into a character. */ + +DECLARE_INLINE_HEADER ( +Raw_Emchar +emchar_to_raw (Emchar ch, Internal_Format fmt, Lisp_Object object) +) +{ + switch (fmt) + { + case FORMAT_DEFAULT: + return (Raw_Emchar) ch; + case FORMAT_16_BIT_FIXED: + text_checking_assert (emchar_16_bit_fixed_p (ch, object)); + return (Raw_Emchar) emchar_to_raw_16_bit_fixed (ch, object); + case FORMAT_32_BIT_FIXED: + return (Raw_Emchar) emchar_to_raw_32_bit_fixed (ch, object); + default: + text_checking_assert (fmt == FORMAT_8_BIT_FIXED); + text_checking_assert (emchar_8_bit_fixed_p (ch, object)); + return (Raw_Emchar) emchar_to_raw_8_bit_fixed (ch, object); + } +} + +/* Return whether CH is representable in the given format in the given + object. */ + +DECLARE_INLINE_HEADER ( +int +emchar_fits_in_format (Emchar ch, Internal_Format fmt, Lisp_Object object) +) +{ + switch (fmt) + { + case FORMAT_DEFAULT: + return 1; + case FORMAT_16_BIT_FIXED: + return emchar_16_bit_fixed_p (ch, object); + case FORMAT_32_BIT_FIXED: + return 1; + default: + text_checking_assert (fmt == FORMAT_8_BIT_FIXED); + return emchar_8_bit_fixed_p (ch, object); + } +} + +/* Assuming the formats are the same, return whether the two objects + represent text in exactly the same way. */ + +DECLARE_INLINE_HEADER ( +int +objects_have_same_internal_representation (Lisp_Object srcobj, + Lisp_Object dstobj) +) +{ + /* &&#### implement this properly when we allow per-object format + differences */ + return 1; +} + +#else + +#define emchar_to_raw(ch, fmt, object) ((Raw_Emchar) (ch)) +#define emchar_fits_in_format(ch, fmt, object) 1 +#define objects_have_same_internal_representation(srcobj, dstobj) 1 + #endif /* MULE */ int dfc_coding_system_is_unicode (Lisp_Object coding_system); @@ -132,210 +345,200 @@ /* */ /************************************************************************/ -/* NOTE: In all the following macros, we follow these rules concerning - multiple evaluation of the arguments: +/* + Use the following functions/macros on contiguous text in any of the + internal formats. Those that take a format arg work on all internal + formats; the others work only on the default (variable-width under Mule) + format. If the text you're operating on is known to come from a buffer, + use the buffer-level functions in buffer.h, which automatically know the + correct format and handle the gap. + + Some terminology: + + "charptr" appearing in the macros means "internal-format text" -- type + `Intbyte *'. Operations on such pointers themselves, rather than on the + text being pointed to, have "charptr" instead of "charptr" in the macro + name. "emchar" in the macro names means an Emchar -- the representation + of a character as a single integer rather than a series of bytes, as part + of "charptr". Many of the macros below are for converting between the + two representations of characters. + + Note also that we try to consistently distinguish between an "Emchar" and + a Lisp character. Stuff working with Lisp characters often just says + "char", so we consistently use "Emchar" when that's what we're working + with. */ + +/* The three golden rules of macros: 1) Anything that's an lvalue can be evaluated more than once. - 2) Anything that's a Lisp Object can be evaluated more than once. - This should probably be changed, but this follows the way - that all the macros in lisp.h do things. - 3) 'struct buffer *' arguments can be evaluated more than once. - 4) Nothing else can be evaluated more than once. Use inline + + 2) Macros where anything else can be evaluated more than once should + have the word "unsafe" in their name (exceptions may be made for + large sets of macros that evaluate arguments of certain types more + than once, e.g. struct buffer * arguments, when clearly indicated in + the macro documentation). These macros are generally meant to be + called only by other macros that have already stored the calling + values in temporary variables. + + 3) Nothing else can be evaluated more than once. Use inline functions, if necessary, to prevent multiple evaluation. - 5) An exception to (4) is that there are some macros below that - may evaluate their arguments more than once. They are all - denoted with the word "unsafe" in their name and are generally - meant to be called only by other macros that have already - stored the calling values in temporary variables. - - - Use the following functions/macros on contiguous strings of data. - If the text you're operating on is known to come from a buffer, use - the buffer-level functions below -- they know about the gap and may - be more efficient. - - - ---------------------------------------------------------------------------- - (A) For working with charptr's (pointers to internally-formatted text): - ---------------------------------------------------------------------------- - - VALID_CHARPTR_P (ptr): - Given a charptr, does it point to the beginning of a character? - - ASSERT_VALID_CHARPTR (ptr): - If error-checking is enabled, assert that the given charptr - points to the beginning of a character. Otherwise, do nothing. - - INC_CHARPTR (ptr): - Given a charptr (assumed to point at the beginning of a character), - modify that pointer so it points to the beginning of the next - character. - - DEC_CHARPTR (ptr): - Given a charptr (assumed to point at the beginning of a - character or at the very end of the text), modify that pointer - so it points to the beginning of the previous character. - - VALIDATE_CHARPTR_BACKWARD (ptr): - Make sure that PTR is pointing to the beginning of a character. - If not, back up until this is the case. Note that there are not - too many places where it is legitimate to do this sort of thing. - It's an error if you're passed an "invalid" char * pointer. - NOTE: PTR *must* be pointing to a valid part of the string (i.e. - not the very end, unless the string is zero-terminated or - something) in order for this function to not cause crashes. - - VALIDATE_CHARPTR_FORWARD (ptr): - Make sure that PTR is pointing to the beginning of a character. - If not, move forward until this is the case. Note that there - are not too many places where it is legitimate to do this sort - of thing. It's an error if you're passed an "invalid" char * - pointer. - - --------------------------------------------------------------------- - (B) For working with the length (in bytes and characters) of a - section of internally-formatted text: - --------------------------------------------------------------------- - - bytecount_to_charcount (ptr, nbi): - Given a pointer to a text string and a length in bytes, - return the equivalent length in characters. - - charcount_to_bytecount (ptr, nch): - Given a pointer to a text string and a length in characters, - return the equivalent length in bytes. - - charptr_n_addr (ptr, n): - Return a pointer to the beginning of the character offset N - (in characters) from PTR. - - ------------------------------------------------------------------------- - (C) For retrieving or changing the character pointed to by a charptr: - ------------------------------------------------------------------------- - - charptr_emchar (ptr): - Retrieve the character pointed to by PTR as an Emchar. - - charptr_emchar_n (ptr, n): - Retrieve the character at offset N (in characters) from PTR, - as an Emchar. - - set_charptr_emchar (ptr, ch): - Store the character CH (an Emchar) as internally-formatted - text starting at PTR. Return the number of bytes stored. - - charptr_copy_char (src, dst): - Retrieve the character pointed to by SRC and store it as - internally-formatted text in DST. - - ---------------------------------- - (D) For working with Emchars: - ---------------------------------- - - [Note that there are other functions/macros for working with Emchars - in charset.h, for retrieving the charset of an Emchar and such.] - - valid_char_p (ch): - Return whether the given Emchar is valid. - - CHARP (ch): - Return whether the given Lisp_Object is a character. - - CHECK_CHAR_COERCE_INT (ch): - Signal an error if CH is not a valid character or integer Lisp_Object. - If CH is an integer Lisp_Object, convert it to a character Lisp_Object, - but merely by repackaging, without performing tests for char validity. - - MAX_EMCHAR_LEN: - Maximum number of buffer bytes per Emacs character. + + NOTE: The functions and macros below are given full prototypes in their + docs, even when the implementation is a macro. In such cases, passing + an argument of a type other than expected will produce undefined + results. Also, given that macros can do things functions can't (in + particular, directly modify arguments as if they were passed by + reference), the declaration syntax has been extended to include the + call-by-reference syntax from C++, where an & after a type indicates + that the argument is an lvalue and is passed by reference, i.e. the + function can modify its value. (This is equivalent in C to passing a + pointer to the argument, but without the need to explicitly worry about + pointers.) + + When to capitalize macros: + + -- Capitalize macros doing stuff obviously impossible with (C) + functions, e.g. directly modifying arguments as if they were passed by + reference. + + -- Capitalize macros that evaluate *any* argument more than once regardless + of whether that's "allowed" (e.g. buffer arguments). + + -- Capitalize macros that directly access a field in a Lisp_Object or + its equivalent underlying structure. In such cases, access through the + Lisp_Object precedes the macro with an X, and access through the underlying + structure doesn't. + + -- Capitalize certain other basic macros relating to Lisp_Objects; e.g. + FRAMEP, CHECK_FRAME, etc. + + -- Try to avoid capitalizing any other macros. */ /* ---------------------------------------------------------------------- */ -/* (A) For working with charptr's (pointers to internally-formatted text) */ +/* Working with charptr's (pointers to internally-formatted text) */ /* ---------------------------------------------------------------------- */ +/* Given an charptr, does it point to the beginning of a character? + */ + #ifdef MULE -# define VALID_CHARPTR_P(ptr) INTBYTE_FIRST_BYTE_P (* (unsigned char *) ptr) +# define valid_charptr_p(ptr) intbyte_first_byte_p (* (ptr)) #else -# define VALID_CHARPTR_P(ptr) 1 +# define valid_charptr_p(ptr) 1 #endif -#ifdef ERROR_CHECK_TEXT -# define ASSERT_VALID_CHARPTR(ptr) assert (VALID_CHARPTR_P (ptr)) -#else -# define ASSERT_VALID_CHARPTR(ptr) -#endif - -/* Note that INC_CHARPTR() and DEC_CHARPTR() have to be written in +/* If error-checking is enabled, assert that the given charptr points to + the beginning of a character. Otherwise, do nothing. + */ + +#define assert_valid_charptr(ptr) text_checking_assert (valid_charptr_p (ptr)) + +/* Given a charptr (assumed to point at the beginning of a character), + modify that pointer so it points to the beginning of the next character. + + Note that INC_CHARPTR() and DEC_CHARPTR() have to be written in completely separate ways. INC_CHARPTR() cannot use the DEC_CHARPTR() trick of looking for a valid first byte because it might run off the end of the string. DEC_CHARPTR() can't use the INC_CHARPTR() method because it doesn't have easy access to the first byte of the character it's moving over. */ -#define REAL_INC_CHARPTR(ptr) \ - ((void) ((ptr) += REP_BYTES_BY_FIRST_BYTE (* (unsigned char *) (ptr)))) - -#define REAL_INC_CHARBYTEBPOS(ptr, pos) \ - (pos += REP_BYTES_BY_FIRST_BYTE (* (unsigned char *) (ptr))) - -#define REAL_DEC_CHARPTR(ptr) do { \ - (ptr)--; \ -} while (!VALID_CHARPTR_P (ptr)) +#define INC_CHARPTR(ptr) do { \ + assert_valid_charptr (ptr); \ + (ptr) += rep_bytes_by_first_byte (* (ptr)); \ +} while (0) + +#define INC_CHARPTR_FMT(ptr, fmt) \ +do { \ + Internal_Format __icf_fmt = (fmt); \ + switch (__icf_fmt) \ + { \ + case FORMAT_DEFAULT: \ + INC_CHARPTR (ptr); \ + break; \ + case FORMAT_16_BIT_FIXED: \ + text_checking_assert (ptr == ALIGN_PTR (ptr, UINT_16_BIT)); \ + (ptr) += 2; \ + break; \ + case FORMAT_32_BIT_FIXED: \ + text_checking_assert (ptr == ALIGN_PTR (ptr, UINT_32_BIT)); \ + (ptr) += 4; \ + break; \ + default: \ + text_checking_assert (fmt == FORMAT_8_BIT_FIXED); \ + (ptr)++; \ + break; \ + } \ +} while (0) + +/* Given a charptr (assumed to point at the beginning of a character or at + the very end of the text), modify that pointer so it points to the + beginning of the previous character. + */ #ifdef ERROR_CHECK_TEXT -#define INC_CHARPTR(ptr) do { \ - ASSERT_VALID_CHARPTR (ptr); \ - REAL_INC_CHARPTR (ptr); \ +/* We use a separate definition to avoid warnings about unused dc_ptr1 */ +#define DEC_CHARPTR(ptr) do { \ + const Intbyte *dc_ptr1 = (ptr); \ + do { \ + (ptr)--; \ + } while (!valid_charptr_p (ptr)); \ + text_checking_assert (dc_ptr1 - (ptr) == rep_bytes_by_first_byte (*(ptr))); \ } while (0) - -#define INC_CHARBYTEBPOS(ptr, pos) do { \ - ASSERT_VALID_CHARPTR (ptr); \ - REAL_INC_CHARBYTEBPOS (ptr, pos); \ +#else +#define DEC_CHARPTR(ptr) do { \ + do { \ + (ptr)--; \ + } while (!valid_charptr_p (ptr)); \ } while (0) - -#define DEC_CHARPTR(ptr) do { \ - const Intbyte *dc_ptr1 = (ptr); \ - const Intbyte *dc_ptr2 = dc_ptr1; \ - REAL_DEC_CHARPTR (dc_ptr2); \ - assert (dc_ptr1 - dc_ptr2 == \ - REP_BYTES_BY_FIRST_BYTE (*dc_ptr2)); \ - (ptr) = (Intbyte *) dc_ptr2; \ +#endif /* ERROR_CHECK_TEXT */ + +#define DEC_CHARPTR_FMT(ptr, fmt) \ +do { \ + Internal_Format __icf_fmt = (fmt); \ + switch (__icf_fmt) \ + { \ + case FORMAT_DEFAULT: \ + DEC_CHARPTR (ptr); \ + break; \ + case FORMAT_16_BIT_FIXED: \ + text_checking_assert (ptr == ALIGN_PTR (ptr, UINT_16_BIT)); \ + (ptr) -= 2; \ + break; \ + case FORMAT_32_BIT_FIXED: \ + text_checking_assert (ptr == ALIGN_PTR (ptr, UINT_32_BIT)); \ + (ptr) -= 4; \ + break; \ + default: \ + text_checking_assert (fmt == FORMAT_8_BIT_FIXED); \ + (ptr)--; \ + break; \ + } \ } while (0) -#else /* ! ERROR_CHECK_TEXT */ -#define INC_CHARBYTEBPOS(ptr, pos) REAL_INC_CHARBYTEBPOS (ptr, pos) -#define INC_CHARPTR(ptr) REAL_INC_CHARPTR (ptr) -#define DEC_CHARPTR(ptr) REAL_DEC_CHARPTR (ptr) -#endif /* ! ERROR_CHECK_TEXT */ - #ifdef MULE +/* Make sure that PTR is pointing to the beginning of a character. If not, + back up until this is the case. Note that there are not too many places + where it is legitimate to do this sort of thing. It's an error if + you're passed an "invalid" char * pointer. NOTE: PTR *must* be pointing + to a valid part of the string (i.e. not the very end, unless the string + is zero-terminated or something) in order for this function to not cause + crashes. + */ + /* Note that this reads the byte at *PTR! */ #define VALIDATE_CHARPTR_BACKWARD(ptr) do { \ - while (!VALID_CHARPTR_P (ptr)) ptr--; \ + while (!valid_charptr_p (ptr)) ptr--; \ } while (0) -/* Given a Intbyte string at PTR of size N, possibly with a partial - character at the end, return the size of the longest substring of - complete characters. Does not assume that the byte at *(PTR + N) is - readable. */ -DECLARE_INLINE_HEADER ( -Bytecount -validate_intbyte_string_backward (const Intbyte *ptr, Bytecount n) -) -{ - const Intbyte *ptr2; - - if (n == 0) - return n; - ptr2 = ptr + n - 1; - VALIDATE_CHARPTR_BACKWARD (ptr2); - if (ptr2 + REP_BYTES_BY_FIRST_BYTE (*ptr2) != ptr + n) - return ptr2 - ptr; - return n; -} +/* Make sure that PTR is pointing to the beginning of a character. If not, + move forward until this is the case. Note that there are not too many + places where it is legitimate to do this sort of thing. It's an error + if you're passed an "invalid" char * pointer. + */ /* This needs to be trickier than VALIDATE_CHARPTR_BACKWARD() to avoid the possibility of running off the end of the string. */ @@ -353,110 +556,470 @@ #else /* not MULE */ #define VALIDATE_CHARPTR_BACKWARD(ptr) #define VALIDATE_CHARPTR_FORWARD(ptr) +#endif /* not MULE */ + +#ifdef MULE + +/* Given a Intbyte string at PTR of size N, possibly with a partial + character at the end, return the size of the longest substring of + complete characters. Does not assume that the byte at *(PTR + N) is + readable. Note that there are not too many places where it is + legitimate to do this sort of thing. It's an error if you're passed an + "invalid" offset. */ + +DECLARE_INLINE_HEADER ( +Bytecount +validate_intbyte_string_backward (const Intbyte *ptr, Bytecount n) +) +{ + const Intbyte *ptr2; + + if (n == 0) + return n; + ptr2 = ptr + n - 1; + VALIDATE_CHARPTR_BACKWARD (ptr2); + if (ptr2 + rep_bytes_by_first_byte (*ptr2) != ptr + n) + return ptr2 - ptr; + return n; +} + +#else + #define validate_intbyte_string_backward(ptr, n) (n) -#endif /* not MULE */ + +#endif /* MULE */ /* -------------------------------------------------------------- */ -/* (B) For working with the length (in bytes and characters) of a */ -/* section of internally-formatted text */ +/* Working with the length (in bytes and characters) of a */ +/* section of internally-formatted text */ /* -------------------------------------------------------------- */ -INLINE_HEADER const Intbyte * -charptr_n_addr (const Intbyte *ptr, Charcount offset); -INLINE_HEADER const Intbyte * +#ifdef MULE + +Charcount bytecount_to_charcount_fun (const Intbyte *ptr, Bytecount len); +Bytecount charcount_to_bytecount_fun (const Intbyte *ptr, Charcount len); + +/* Given a pointer to a text string and a length in bytes, return + the equivalent length in characters. */ + +DECLARE_INLINE_HEADER ( +Charcount +bytecount_to_charcount (const Intbyte *ptr, Bytecount len) +) +{ + if (len < 20) /* Just a random guess, but it should be more or less correct. + If number of bytes is small, just do a simple loop, + which should be more efficient. */ + { + Charcount count = 0; + const Intbyte *end = ptr + len; + while (ptr < end) + { + INC_CHARPTR (ptr); + count++; + } + /* Bomb out if the specified substring ends in the middle + of a character. Note that we might have already gotten + a core dump above from an invalid reference, but at least + we will get no farther than here. + + This also catches len < 0. */ + text_checking_assert (ptr == end); + + return count; + } + else + return bytecount_to_charcount_fun (ptr, len); +} + +/* Given a pointer to a text string and a length in characters, return the + equivalent length in bytes. +*/ + +DECLARE_INLINE_HEADER ( +Bytecount +charcount_to_bytecount (const Intbyte *ptr, Charcount len) +) +{ + text_checking_assert (len >= 0); + if (len < 20) /* See above */ + { + const Intbyte *newptr = ptr; + while (len > 0) + { + INC_CHARPTR (newptr); + len--; + } + return newptr - ptr; + } + else + return charcount_to_bytecount_fun (ptr, len); +} + +/* Given a pointer to a text string in the specified format and a length in + bytes, return the equivalent length in characters. +*/ + +DECLARE_INLINE_HEADER ( +Charcount +bytecount_to_charcount_fmt (const Intbyte *ptr, Bytecount len, + Internal_Format fmt) +) +{ + switch (fmt) + { + case FORMAT_DEFAULT: + return bytecount_to_charcount (ptr, len); + case FORMAT_16_BIT_FIXED: + text_checking_assert (ptr == ALIGN_PTR (ptr, UINT_16_BIT)); + return (Charcount) (len << 1); + case FORMAT_32_BIT_FIXED: + text_checking_assert (ptr == ALIGN_PTR (ptr, UINT_32_BIT)); + return (Charcount) (len << 2); + default: + text_checking_assert (fmt == FORMAT_8_BIT_FIXED); + return (Charcount) len; + } +} + +/* Given a pointer to a text string in the specified format and a length in + characters, return the equivalent length in bytes. +*/ + +DECLARE_INLINE_HEADER ( +Bytecount +charcount_to_bytecount_fmt (const Intbyte *ptr, Charcount len, + Internal_Format fmt) +) +{ + switch (fmt) + { + case FORMAT_DEFAULT: + return charcount_to_bytecount (ptr, len); + case FORMAT_16_BIT_FIXED: + text_checking_assert (ptr == ALIGN_PTR (ptr, UINT_16_BIT)); + text_checking_assert (!(len & 1)); + return (Bytecount) (len >> 1); + case FORMAT_32_BIT_FIXED: + text_checking_assert (!(len & 3)); + text_checking_assert (ptr == ALIGN_PTR (ptr, UINT_32_BIT)); + return (Bytecount) (len >> 2); + default: + text_checking_assert (fmt == FORMAT_8_BIT_FIXED); + return (Bytecount) len; + } +} + +#else + +#define bytecount_to_charcount(ptr, len) ((Charcount) (len)) +#define bytecount_to_charcount_fmt(ptr, len, fmt) ((Charcount) (len)) +#define charcount_to_bytecount(ptr, len) ((Bytecount) (len)) +#define charcount_to_bytecount_fmt(ptr, len, fmt) ((Bytecount) (len)) + +#endif /* MULE */ + +/* Return the length of the first character at PTR. Equivalent to + charcount_to_bytecount (ptr, 1). + + [Since charcount_to_bytecount() is Written as inline, a smart compiler + should really optimize charcount_to_bytecount (ptr, 1) to the same as + the following, with no error checking. But since this idiom occurs so + often, we'll be helpful and define a special macro for it.] +*/ + +#define charptr_emchar_len(ptr) rep_bytes_by_first_byte (*(ptr)) + +/* Return the length of the first character at PTR, which is in the + specified internal format. Equivalent to charcount_to_bytecount_fmt + (ptr, 1, fmt). +*/ + +DECLARE_INLINE_HEADER ( +Bytecount +charptr_emchar_len_fmt (const Intbyte *ptr, Internal_Format fmt) +) +{ + switch (fmt) + { + case FORMAT_DEFAULT: + return charptr_emchar_len (ptr); + case FORMAT_16_BIT_FIXED: + text_checking_assert (ptr == ALIGN_PTR (ptr, UINT_16_BIT)); + return 2; + case FORMAT_32_BIT_FIXED: + text_checking_assert (ptr == ALIGN_PTR (ptr, UINT_32_BIT)); + return 4; + default: + text_checking_assert (fmt == FORMAT_8_BIT_FIXED); + return 1; + } +} + +/* Return a pointer to the beginning of the character offset N (in + characters) from PTR. +*/ + +DECLARE_INLINE_HEADER ( +const Intbyte * charptr_n_addr (const Intbyte *ptr, Charcount offset) +) { return ptr + charcount_to_bytecount (ptr, offset); } +/* Given a charptr and an offset into the text pointed to by the charptr, + modify the offset so it points to the beginning of the next character. +*/ + +#define INC_BYTECOUNT(ptr, pos) do { \ + assert_valid_charptr (ptr); \ + (pos += rep_bytes_by_first_byte (* ((ptr) + (pos)))); \ +} while (0) + /* -------------------------------------------------------------------- */ -/* (C) For retrieving or changing the character pointed to by a charptr */ +/* Retrieving or changing the character pointed to by a charptr */ /* -------------------------------------------------------------------- */ #define simple_charptr_emchar(ptr) ((Emchar) (ptr)[0]) #define simple_set_charptr_emchar(ptr, x) \ ((ptr)[0] = (Intbyte) (x), (Bytecount) 1) -#define simple_charptr_copy_char(src, dst) \ +#define simple_charptr_copy_emchar(src, dst) \ ((dst)[0] = *(src), (Bytecount) 1) #ifdef MULE Emchar non_ascii_charptr_emchar (const Intbyte *ptr); Bytecount non_ascii_set_charptr_emchar (Intbyte *ptr, Emchar c); -Bytecount non_ascii_charptr_copy_char (const Intbyte *src, Intbyte *dst); - -INLINE_HEADER Emchar charptr_emchar (const Intbyte *ptr); -INLINE_HEADER Emchar +Bytecount non_ascii_charptr_copy_emchar (const Intbyte *src, Intbyte *dst); + +/* Retrieve the character pointed to by PTR as an Emchar. */ + +DECLARE_INLINE_HEADER ( +Emchar charptr_emchar (const Intbyte *ptr) +) { - return BYTE_ASCII_P (*ptr) ? + return byte_ascii_p (*ptr) ? simple_charptr_emchar (ptr) : non_ascii_charptr_emchar (ptr); } -INLINE_HEADER Bytecount set_charptr_emchar (Intbyte *ptr, Emchar x); -INLINE_HEADER Bytecount +/* Retrieve the character pointed to by PTR (a pointer to text in the + format FMT, coming from OBJECT [a buffer, string?, or nil]) as an + Emchar. + + Note: For these and other *_fmt() functions, if you pass in a constant + FMT, the switch will be optimized out of existence. Therefore, there is + no need to create separate versions for the various formats for + "efficiency reasons". In fact, we don't really need charptr_emchar() + and such written separately, but they are used often so it's simpler + that way. */ + +DECLARE_INLINE_HEADER ( +Emchar +charptr_emchar_fmt (const Intbyte *ptr, Internal_Format fmt, + Lisp_Object object) +) +{ + switch (fmt) + { + case FORMAT_DEFAULT: + return charptr_emchar (ptr); + case FORMAT_16_BIT_FIXED: + text_checking_assert (ptr == ALIGN_PTR (ptr, UINT_16_BIT)); + return raw_16_bit_fixed_to_emchar (* (UINT_16_BIT *) ptr, object); + case FORMAT_32_BIT_FIXED: + text_checking_assert (ptr == ALIGN_PTR (ptr, UINT_32_BIT)); + return raw_32_bit_fixed_to_emchar (* (UINT_32_BIT *) ptr, object); + default: + text_checking_assert (fmt == FORMAT_8_BIT_FIXED); + return raw_8_bit_fixed_to_emchar (*ptr, object); + } +} + +/* Return the character at PTR (which is in format FMT), suitable for + comparison with an ASCII character. This guarantees that if the + character at PTR is ASCII (range 0 - 127), that character will be + returned; otherwise, some character outside of the ASCII range will be + returned, but not necessarily the character actually at PTR. This will + be faster than charptr_emchar_fmt() for some formats -- in particular, + FORMAT_DEFAULT. */ + +DECLARE_INLINE_HEADER ( +Emchar +charptr_emchar_ascii_fmt (const Intbyte *ptr, Internal_Format fmt, + Lisp_Object object) +) +{ + switch (fmt) + { + case FORMAT_DEFAULT: + return (Emchar) *ptr; + case FORMAT_16_BIT_FIXED: + text_checking_assert (ptr == ALIGN_PTR (ptr, UINT_16_BIT)); + return raw_16_bit_fixed_to_emchar (* (UINT_16_BIT *) ptr, object); + case FORMAT_32_BIT_FIXED: + text_checking_assert (ptr == ALIGN_PTR (ptr, UINT_32_BIT)); + return raw_32_bit_fixed_to_emchar (* (UINT_32_BIT *) ptr, object); + default: + text_checking_assert (fmt == FORMAT_8_BIT_FIXED); + return raw_8_bit_fixed_to_emchar (*ptr, object); + } +} + +/* Return the "raw value" of the character at PTR, in format FMT. This is + useful when searching for a character; convert the character using + emchar_to_raw(). */ + +DECLARE_INLINE_HEADER ( +Raw_Emchar +charptr_emchar_raw_fmt (const Intbyte *ptr, Internal_Format fmt) +) +{ + switch (fmt) + { + case FORMAT_DEFAULT: + return (Raw_Emchar) charptr_emchar (ptr); + case FORMAT_16_BIT_FIXED: + text_checking_assert (ptr == ALIGN_PTR (ptr, UINT_16_BIT)); + return (Raw_Emchar) (* (UINT_16_BIT *) ptr); + case FORMAT_32_BIT_FIXED: + text_checking_assert (ptr == ALIGN_PTR (ptr, UINT_32_BIT)); + return (Raw_Emchar) (* (UINT_32_BIT *) ptr); + default: + text_checking_assert (fmt == FORMAT_8_BIT_FIXED); + return (Raw_Emchar) (*ptr); + } +} + +/* Store the character CH (an Emchar) as internally-formatted text starting + at PTR. Return the number of bytes stored. +*/ + +DECLARE_INLINE_HEADER ( +Bytecount set_charptr_emchar (Intbyte *ptr, Emchar x) +) { - return !CHAR_MULTIBYTE_P (x) ? + return !emchar_multibyte_p (x) ? simple_set_charptr_emchar (ptr, x) : non_ascii_set_charptr_emchar (ptr, x); } -INLINE_HEADER Bytecount -charptr_copy_char (const Intbyte *src, Intbyte *dst); -INLINE_HEADER Bytecount -charptr_copy_char (const Intbyte *src, Intbyte *dst) +/* Store the character CH (an Emchar) as internally-formatted text of + format FMT starting at PTR, which comes from OBJECT. Return the number + of bytes stored. +*/ + +DECLARE_INLINE_HEADER ( +Bytecount +set_charptr_emchar_fmt (Intbyte *ptr, Emchar x, Internal_Format fmt, + Lisp_Object object) +) { - return BYTE_ASCII_P (*src) ? - simple_charptr_copy_char (src, dst) : - non_ascii_charptr_copy_char (src, dst); + switch (fmt) + { + case FORMAT_DEFAULT: + return set_charptr_emchar (ptr, x); + case FORMAT_16_BIT_FIXED: + text_checking_assert (emchar_16_bit_fixed_p (x, object)); + text_checking_assert (ptr == ALIGN_PTR (ptr, UINT_16_BIT)); + * (UINT_16_BIT *) ptr = emchar_to_raw_16_bit_fixed (x, object); + return 2; + case FORMAT_32_BIT_FIXED: + text_checking_assert (ptr == ALIGN_PTR (ptr, UINT_32_BIT)); + * (UINT_32_BIT *) ptr = emchar_to_raw_32_bit_fixed (x, object); + return 4; + default: + text_checking_assert (fmt == FORMAT_8_BIT_FIXED); + text_checking_assert (emchar_8_bit_fixed_p (x, object)); + *ptr = emchar_to_raw_8_bit_fixed (x, object); + return 1; + } +} + +/* Retrieve the character pointed to by SRC and store it as + internally-formatted text in DST. +*/ + +DECLARE_INLINE_HEADER ( +Bytecount +charptr_copy_emchar (const Intbyte *src, Intbyte *dst) +) +{ + return byte_ascii_p (*src) ? + simple_charptr_copy_emchar (src, dst) : + non_ascii_charptr_copy_emchar (src, dst); } #else /* not MULE */ -# define charptr_emchar(ptr) simple_charptr_emchar (ptr) -# define set_charptr_emchar(ptr, x) simple_set_charptr_emchar (ptr, x) -# define charptr_copy_char(src, dst) simple_charptr_copy_char (src, dst) +# define charptr_emchar(ptr) simple_charptr_emchar (ptr) +# define charptr_emchar_fmt(ptr, fmt, object) charptr_emchar (ptr) +# define charptr_emchar_ascii_fmt(ptr, fmt, object) charptr_emchar (ptr) +# define charptr_emchar_raw_fmt(ptr, fmt) charptr_emchar (ptr) +# define set_charptr_emchar(ptr, x) simple_set_charptr_emchar (ptr, x) +# define set_charptr_emchar_fmt(ptr, x, fmt, obj) set_charptr_emchar (ptr, x) +# define charptr_copy_emchar(src, dst) simple_charptr_copy_emchar (src, dst) #endif /* not MULE */ +/* Retrieve the character at offset N (in characters) from PTR, as an + Emchar. +*/ + #define charptr_emchar_n(ptr, offset) \ charptr_emchar (charptr_n_addr (ptr, offset)) /* ---------------------------- */ -/* (D) For working with Emchars */ +/* Working with Emchars */ /* ---------------------------- */ +/* NOTE: There are other functions/macros for working with Emchars in + charset.h, for retrieving the charset of an Emchar, the length of an + Emchar when converted to text, etc. +*/ + #ifdef MULE -int non_ascii_valid_char_p (Emchar ch); - -INLINE_HEADER int valid_char_p (Emchar ch); -INLINE_HEADER int -valid_char_p (Emchar ch) +int non_ascii_valid_emchar_p (Emchar ch); + +/* Return whether the given Emchar is valid. + */ + +DECLARE_INLINE_HEADER ( +int +valid_emchar_p (Emchar ch) +) { - return (! (ch & ~0xFF)) || non_ascii_valid_char_p (ch); + return (! (ch & ~0xFF)) || non_ascii_valid_emchar_p (ch); } #else /* not MULE */ -#define valid_char_p(ch) (! (ch & ~0xFF)) +#define valid_emchar_p(ch) (! (ch & ~0xFF)) #endif /* not MULE */ -#define CHAR_INTP(x) (INTP (x) && valid_char_p (XINT (x))) +#define CHAR_INTP(x) (INTP (x) && valid_emchar_p (XINT (x))) #define CHAR_OR_CHAR_INTP(x) (CHARP (x) || CHAR_INTP (x)) -INLINE_HEADER Emchar XCHAR_OR_CHAR_INT (Lisp_Object obj); -INLINE_HEADER Emchar +DECLARE_INLINE_HEADER ( +Emchar XCHAR_OR_CHAR_INT (Lisp_Object obj) +) { return CHARP (obj) ? XCHAR (obj) : XINT (obj); } +/* Signal an error if CH is not a valid character or integer Lisp_Object. + If CH is an integer Lisp_Object, convert it to a character Lisp_Object, + but merely by repackaging, without performing tests for char validity. + */ + #define CHECK_CHAR_COERCE_INT(x) do { \ if (CHARP (x)) \ ; \ @@ -470,6 +1033,221 @@ /************************************************************************/ /* */ +/* working with Lisp strings */ +/* */ +/************************************************************************/ + +#define string_char_length(s) \ + string_index_byte_to_char (s, XSTRING_LENGTH (s)) +#define string_byte(s, i) (XSTRING_DATA (s)[i] + 0) +/* In case we ever allow strings to be in a different format ... */ +#define set_string_byte(s, i, c) (XSTRING_DATA (s)[i] = (c)) + +#define ASSERT_VALID_CHAR_STRING_INDEX_UNSAFE(s, x) do { \ + text_checking_assert ((x) >= 0 && x <= string_char_length (s)); \ +} while (0) + +#define ASSERT_VALID_BYTE_STRING_INDEX_UNSAFE(s, x) do { \ + text_checking_assert ((x) >= 0 && x <= XSTRING_LENGTH (s)); \ + text_checking_assert (valid_charptr_p (string_byte_addr (s, x))); \ +} while (0) + +/* Convert offset I in string S to a pointer to text there. */ +#define string_byte_addr(s, i) (&(XSTRING_DATA (s)[i])) +/* Convert pointer to text in string S into the byte offset to that text. */ +#define string_addr_to_byte(s, ptr) ((Bytecount) ((ptr) - XSTRING_DATA (s))) +/* Return the Emchar at *CHARACTER* offset I. */ +#define string_emchar(s, i) charptr_emchar (string_char_addr (s, i)) + +#ifdef ERROR_CHECK_TEXT +#define SLEDGEHAMMER_CHECK_ASCII_BEGIN +#endif + +#ifdef SLEDGEHAMMER_CHECK_ASCII_BEGIN +void sledgehammer_check_ascii_begin (Lisp_Object str); +#else +#define sledgehammer_check_ascii_begin(str) +#endif + +/* Make an alloca'd copy of a Lisp string */ +#define LISP_STRING_TO_ALLOCA(s, lval) \ +do { \ + Intbyte **_lta_ = (Intbyte **) &(lval); \ + Lisp_Object _lta_2 = (s); \ + *_lta_ = alloca_array (Intbyte, 1 + XSTRING_LENGTH (_lta_2)); \ + memcpy (*_lta_, XSTRING_DATA (_lta_2), 1 + XSTRING_LENGTH (_lta_2)); \ +} while (0) + +/* Make an alloca'd copy of a Intbyte * */ +#define INTBYTE_STRING_TO_ALLOCA(p, lval) \ +do { \ + Intbyte **_bsta_ = (Intbyte **) &(lval); \ + const Intbyte *_bsta_2 = (p); \ + Bytecount _bsta_3 = qxestrlen (_bsta_2); \ + *_bsta_ = alloca_array (Intbyte, 1 + _bsta_3); \ + memcpy (*_bsta_, _bsta_2, 1 + _bsta_3); \ +} while (0) + +#define alloca_intbytes(num) alloca_array (Intbyte, num) +#define alloca_extbytes(num) alloca_array (Extbyte, num) + +void resize_string (Lisp_Object s, Bytecount pos, Bytecount delta); + +/* Convert a byte index into a string into a char index. */ +DECLARE_INLINE_HEADER ( +Charcount +string_index_byte_to_char (Lisp_Object s, Bytecount idx) +) +{ + Charcount retval; + ASSERT_VALID_BYTE_STRING_INDEX_UNSAFE (s, idx); +#ifdef MULE + if (idx <= (Bytecount) XSTRING_ASCII_BEGIN (s)) + retval = (Charcount) idx; + else + retval = (XSTRING_ASCII_BEGIN (s) + + bytecount_to_charcount (XSTRING_DATA (s) + + XSTRING_ASCII_BEGIN (s), + idx - XSTRING_ASCII_BEGIN (s))); +# ifdef SLEDGEHAMMER_CHECK_ASCII_BEGIN + assert (retval == bytecount_to_charcount (XSTRING_DATA (s), idx)); +# endif +#else + retval = (Charcount) idx; +#endif + /* Don't call ASSERT_VALID_CHAR_STRING_INDEX_UNSAFE() here because it will + call string_index_byte_to_char(). */ + return retval; +} + +/* Convert a char index into a string into a byte index. */ +DECLARE_INLINE_HEADER ( +Bytecount +string_index_char_to_byte (Lisp_Object s, Charcount idx) +) +{ + Bytecount retval; + ASSERT_VALID_CHAR_STRING_INDEX_UNSAFE (s, idx); +#ifdef MULE + if (idx <= (Charcount) XSTRING_ASCII_BEGIN (s)) + retval = (Bytecount) idx; + else + retval = (XSTRING_ASCII_BEGIN (s) + + charcount_to_bytecount (XSTRING_DATA (s) + + XSTRING_ASCII_BEGIN (s), + idx - XSTRING_ASCII_BEGIN (s))); +# ifdef SLEDGEHAMMER_CHECK_ASCII_BEGIN + assert (retval == charcount_to_bytecount (XSTRING_DATA (s), idx)); +# endif +#else + retval = (Bytecount) idx; +#endif + ASSERT_VALID_BYTE_STRING_INDEX_UNSAFE (s, retval); + return retval; +} + +/* Convert a substring length (starting at byte offset OFF) from bytes to + chars. */ +DECLARE_INLINE_HEADER ( +Charcount +string_offset_byte_to_char_len (Lisp_Object s, Bytecount off, Bytecount len) +) +{ + Charcount retval; + ASSERT_VALID_BYTE_STRING_INDEX_UNSAFE (s, off); + ASSERT_VALID_BYTE_STRING_INDEX_UNSAFE (s, off + len); +#ifdef MULE + if (off + len <= (Bytecount) XSTRING_ASCII_BEGIN (s)) + retval = (Charcount) len; + else if (off < (Bytecount) XSTRING_ASCII_BEGIN (s)) + retval = + XSTRING_ASCII_BEGIN (s) - (Charcount) off + + bytecount_to_charcount (XSTRING_DATA (s) + XSTRING_ASCII_BEGIN (s), + len - (XSTRING_ASCII_BEGIN (s) - off)); + else + retval = bytecount_to_charcount (XSTRING_DATA (s) + off, len); +# ifdef SLEDGEHAMMER_CHECK_ASCII_BEGIN + assert (retval == bytecount_to_charcount (XSTRING_DATA (s) + off, len)); +# endif +#else + retval = (Charcount) len; +#endif + return retval; +} + +/* Convert a substring length (starting at byte offset OFF) from chars to + bytes. */ +DECLARE_INLINE_HEADER ( +Bytecount +string_offset_char_to_byte_len (Lisp_Object s, Bytecount off, Charcount len) +) +{ + Bytecount retval; + ASSERT_VALID_BYTE_STRING_INDEX_UNSAFE (s, off); +#ifdef MULE + /* casts to avoid errors from combining Bytecount/Charcount and warnings + from signed/unsigned comparisons */ + if (off + (Bytecount) len <= (Bytecount) XSTRING_ASCII_BEGIN (s)) + retval = (Bytecount) len; + else if (off < (Bytecount) XSTRING_ASCII_BEGIN (s)) + retval = + XSTRING_ASCII_BEGIN (s) - off + + charcount_to_bytecount (XSTRING_DATA (s) + XSTRING_ASCII_BEGIN (s), + len - (XSTRING_ASCII_BEGIN (s) - + (Charcount) off)); + else + retval = charcount_to_bytecount (XSTRING_DATA (s) + off, len); +# ifdef SLEDGEHAMMER_CHECK_ASCII_BEGIN + assert (retval == charcount_to_bytecount (XSTRING_DATA (s) + off, len)); +# endif +#else + retval = (Bytecount) len; +#endif + ASSERT_VALID_BYTE_STRING_INDEX_UNSAFE (s, off + retval); + return retval; +} + +DECLARE_INLINE_HEADER ( +const Intbyte * +string_char_addr (Lisp_Object s, Charcount idx) +) +{ + return XSTRING_DATA (s) + string_index_char_to_byte (s, idx); +} + +/* WARNING: If you modify an existing string, you must call + bump_string_modiff() afterwards. */ +#ifdef MULE +void set_string_char (Lisp_Object s, Charcount i, Emchar c); +#else +#define set_string_char(s, i, c) set_string_byte (s, i, c) +#endif /* not MULE */ + +/* Return index to character before the one at IDX. */ +DECLARE_INLINE_HEADER ( +Bytecount +prev_string_index (Lisp_Object s, Bytecount idx) +) +{ + const Intbyte *ptr = string_byte_addr (s, idx); + DEC_CHARPTR (ptr); + return string_addr_to_byte (s, ptr); +} + +/* Return index to character after the one at IDX. */ +DECLARE_INLINE_HEADER ( +Bytecount +next_string_index (Lisp_Object s, Bytecount idx) +) +{ + const Intbyte *ptr = string_byte_addr (s, idx); + INC_CHARPTR (ptr); + return string_addr_to_byte (s, ptr); +} + + +/************************************************************************/ +/* */ /* working with Eistrings */ /* */ /************************************************************************/ @@ -598,10 +1376,10 @@ that is "null-terminated" (the meaning of this depends on the nature of the default internal format). void eicpy_raw_fmt (Eistring *eistr, const Intbyte *data, Bytecount len, - Internal_Format intfmt); + Internal_Format intfmt, Lisp_Object object); ... from raw internal-format data in the specified format. void eicpy_rawz_fmt (Eistring *eistr, const Intbyte *data, - Internal_Format intfmt); + Internal_Format intfmt, Lisp_Object object); ... from raw internal-format data in the specified format that is "null-terminated" (the meaning of this depends on the nature of the specific format). @@ -651,7 +1429,7 @@ void eicpyout_alloca_fmt (Eistring *eistr, LVALUE: Intbyte *ptr_out, LVALUE: Bytecount len_out, - Internal_Format intfmt); + Internal_Format intfmt, Lisp_Object object); Like eicpyout_alloca(), but converts to the specified internal format. (No formats other than FORMAT_DEFAULT are currently implemented, and you get an assertion failure if you try.) @@ -664,7 +1442,7 @@ a NULL pointer. Intbyte *eicpyout_malloc_fmt (Eistring *eistr, Internal_Format intfmt, - Bytecount *intlen_out); + Bytecount *intlen_out, Lisp_Object object); Like eicpyout_malloc(), but converts to the specified internal format. (No formats other than FORMAT_DEFAULT are currently implemented, and you get an assertion failure if you try.) @@ -1007,14 +1785,6 @@ Bytecount extlen_; } Eistring; -typedef enum internal_format -{ - FORMAT_DEFAULT, - FORMAT_FIXED_8, - FORMAT_FIXED_16, - FORMAT_FIXED_32 -} Internal_Format; - extern Eistring the_eistring_zero_init, the_eistring_malloc_zero_init; #define DECLARE_EISTRING(name) \ @@ -1146,7 +1916,7 @@ do { \ Lisp_Object ei3 = (lisp_string); \ EI_ALLOC_AND_COPY (ei, XSTRING_DATA (ei3), XSTRING_LENGTH (ei3), \ - XSTRING_CHAR_LENGTH (ei3)); \ + string_char_length (ei3)); \ } while (0) #define eicpy_lstr_off(ei, lisp_string, off, charoff, len, charlen) \ @@ -1166,7 +1936,7 @@ EI_ALLOC_AND_COPY (ei, ei23data + ei23off, ei23len, ei23charlen); \ } while (0) -#define eicpy_raw_fmt(ei, ptr, len, fmt) \ +#define eicpy_raw_fmt(ei, ptr, len, fmt, object) \ do { \ const Intbyte *ei12ptr = (ptr); \ Internal_Format ei12fmt = (fmt); \ @@ -1176,17 +1946,18 @@ bytecount_to_charcount (ei12ptr, ei12len)); \ } while (0) -#define eicpy_raw(ei, ptr, len) eicpy_raw_fmt (ei, ptr, len, FORMAT_DEFAULT) - -#define eicpy_rawz_fmt(ei, ptr, fmt) \ -do { \ - const Intbyte *ei12p1ptr = (ptr); \ - Internal_Format ei12p1fmt = (fmt); \ - assert (ei12p1fmt == FORMAT_DEFAULT); \ - eicpy_raw_fmt (ei, ei12p1ptr, qxestrlen (ei12p1ptr), fmt); \ +#define eicpy_raw(ei, ptr, len) \ + eicpy_raw_fmt (ei, ptr, len, FORMAT_DEFAULT, Qnil) + +#define eicpy_rawz_fmt(ei, ptr, fmt, object) \ +do { \ + const Intbyte *ei12p1ptr = (ptr); \ + Internal_Format ei12p1fmt = (fmt); \ + assert (ei12p1fmt == FORMAT_DEFAULT); \ + eicpy_raw_fmt (ei, ei12p1ptr, qxestrlen (ei12p1ptr), fmt, object); \ } while (0) -#define eicpy_rawz(ei, ptr) eicpy_rawz_fmt (ei, ptr, FORMAT_DEFAULT) +#define eicpy_rawz(ei, ptr) eicpy_rawz_fmt (ei, ptr, FORMAT_DEFAULT, Qnil) #define eicpy_ch(ei, ch) \ do { \ @@ -1261,12 +2032,12 @@ } while (0) #define eicpyout_alloca(eistr, ptrout, lenout) \ - eicpyout_alloca_fmt (eistr, ptrout, lenout, FORMAT_DEFAULT) + eicpyout_alloca_fmt (eistr, ptrout, lenout, FORMAT_DEFAULT, Qnil) #define eicpyout_malloc(eistr, lenout) \ - eicpyout_malloc_fmt (eistr, lenout, FORMAT_DEFAULT) + eicpyout_malloc_fmt (eistr, lenout, FORMAT_DEFAULT, Qnil) Intbyte *eicpyout_malloc_fmt (Eistring *eistr, Bytecount *len_out, - Internal_Format fmt); -#define eicpyout_alloca_fmt(eistr, ptrout, lenout, fmt) \ + Internal_Format fmt, Lisp_Object object); +#define eicpyout_alloca_fmt(eistr, ptrout, lenout, fmt, object) \ do { \ Internal_Format ei23fmt = (fmt); \ Intbyte *ei23ptrout = &(ptrout); \ @@ -1449,7 +2220,7 @@ do { \ Lisp_Object ei17 = (lisp_string); \ eicat_1 (ei, XSTRING_DATA (ei17), XSTRING_LENGTH (ei17), \ - XSTRING_CHAR_LENGTH (ei17)); \ + string_char_length (ei17)); \ } while (0) #define eicat_ch(ei, ch) \ @@ -2023,75 +2794,11 @@ \ if (!__gserr__) \ { \ - var = alloca_intbytes (99); \ + var = alloca_intbytes (99); \ qxesprintf (var, "Unknown error %d", __gsnum__); \ } \ else \ EXTERNAL_TO_C_STRING (__gserr__, var, Qstrerror_encoding); \ } while (0) -/************************************************************************/ -/* Lisp string representation convenience functions */ -/************************************************************************/ - -/* Because the representation of internally formatted data is subject - to change, it's bad style to do something like - - strcmp (XSTRING_DATA (s), "foo") - - Instead, use the portable: - - intbyte_strcmp (XSTRING_DATA (s), "foo") or - intbyte_memcmp (XSTRING_DATA (s), "foo", 3) - -*/ - -/* Like strcmp, except first arg points at internally formatted data, - while the second points at a string of only ASCII chars. */ -DECLARE_INLINE_HEADER ( -int -intbyte_strcmp (const Intbyte *bp, const char *ascii_string) -) -{ -#ifdef MULE - while (1) - { - int diff; - type_checking_assert (BYTE_ASCII_P (*ascii_string)); - if ((diff = charptr_emchar (bp) - *(Intbyte *) ascii_string) != 0) - return diff; - if (*ascii_string == '\0') - return 0; - ascii_string++; - INC_CHARPTR (bp); - } -#else - return strcmp ((char *)bp, ascii_string); -#endif -} - -/* Like memcmp, except first arg points at internally formatted data, - while the second points at a string of only ASCII chars. */ - -DECLARE_INLINE_HEADER ( -int -intbyte_memcmp (const Intbyte *bp, const char *ascii_string, Bytecount len) -) -{ -#ifdef MULE - while (len--) - { - int diff = charptr_emchar (bp) - *(Intbyte *) ascii_string; - type_checking_assert (BYTE_ASCII_P (*ascii_string)); - if (diff != 0) - return diff; - ascii_string++; - INC_CHARPTR (bp); - } - return 0; -#else - return memcmp (bp, ascii_string, len); -#endif -} - #endif /* INCLUDED_text_h_ */
--- a/src/tooltalk.c Thu May 02 14:35:32 2002 +0000 +++ b/src/tooltalk.c Sun May 05 11:33:57 2002 +0000 @@ -345,7 +345,7 @@ fflush (tooltalk_log_file); #endif - VOID_TO_LISP (message_, tt_message_user (m, TOOLTALK_MESSAGE_KEY)); + message_ = VOID_TO_LISP (tt_message_user (m, TOOLTALK_MESSAGE_KEY)); pattern = make_tooltalk_pattern (p); cb = XTOOLTALK_MESSAGE (message_)->callback; GCPRO2 (message_, pattern); @@ -389,7 +389,7 @@ #endif message_ = make_tooltalk_message (m); - VOID_TO_LISP (pattern, tt_pattern_user (p, TOOLTALK_PATTERN_KEY)); + pattern = VOID_TO_LISP (tt_pattern_user (p, TOOLTALK_PATTERN_KEY)); cb = XTOOLTALK_PATTERN (pattern)->callback; GCPRO2 (message_, pattern); if (!NILP (Vtooltalk_pattern_handler_hook))
--- a/src/ui-byhand.c Thu May 02 14:35:32 2002 +0000 +++ b/src/ui-byhand.c Sun May 05 11:33:57 2002 +0000 @@ -473,7 +473,7 @@ Lisp_Object callback; Lisp_Object lisp_user_data; - VOID_TO_LISP (callback, user_data); + callback = VOID_TO_LISP (user_data); lisp_user_data = XCAR (callback); callback = XCDR (callback); @@ -582,7 +582,7 @@ { Lisp_Object closure; - VOID_TO_LISP (closure, user_data); + closure = VOID_TO_LISP (user_data); call3 (XCAR (closure), build_gtk_object (GTK_OBJECT (ctree)),
--- a/src/ui-gtk.c Thu May 02 14:35:32 2002 +0000 +++ b/src/ui-gtk.c Sun May 05 11:33:57 2002 +0000 @@ -771,11 +771,11 @@ if (print_readably) printing_unreadable_object ("#<GtkObject %p>", XGTK_OBJECT (obj)->object); - write_c_string ("#<GtkObject (", printcharfun); + write_c_string (printcharfun, "#<GtkObject ("); if (XGTK_OBJECT (obj)->alive_p) - write_c_string (gtk_type_name (GTK_OBJECT_TYPE (XGTK_OBJECT (obj)->object)), printcharfun); + write_c_string (printcharfun, gtk_type_name (GTK_OBJECT_TYPE (XGTK_OBJECT (obj)->object))); else - write_c_string ("dead", printcharfun); + write_c_string (printcharfun, "dead"); write_fmt_string (printcharfun, ") %p>", (void *) XGTK_OBJECT (obj)->object); } @@ -984,7 +984,7 @@ { Lisp_Object lisp_data; - VOID_TO_LISP (lisp_data, data); + lisp_data = VOID_TO_LISP (data); ungcpro_popup_callbacks (XINT (XCAR (lisp_data))); } @@ -1000,7 +1000,7 @@ struct gcpro gcpro1; int i; - VOID_TO_LISP (callback_fn, data); + callback_fn = VOID_TO_LISP (data); /* Nuke the GUI_ID off the front */ callback_fn = XCDR (callback_fn); @@ -1079,8 +1079,8 @@ if (print_readably) printing_unreadable_object ("#<GtkBoxed %p>", XGTK_BOXED (obj)->object); - write_c_string ("#<GtkBoxed (", printcharfun); - write_c_string (gtk_type_name (XGTK_BOXED (obj)->object_type), printcharfun); + write_c_string (printcharfun, "#<GtkBoxed ("); + write_c_string (printcharfun, gtk_type_name (XGTK_BOXED (obj)->object_type)); write_fmt_string (printcharfun, ") %p>", (void *) XGTK_BOXED (obj)->object); } @@ -1479,7 +1479,7 @@ { Lisp_Object rval; - VOID_TO_LISP (rval, GTK_VALUE_POINTER (*arg)); + rval = VOID_TO_LISP (GTK_VALUE_POINTER (*arg)); return (rval); } else @@ -1494,7 +1494,7 @@ { Lisp_Object rval; - VOID_TO_LISP (rval, GTK_VALUE_CALLBACK (*arg).data); + rval = VOID_TO_LISP (GTK_VALUE_CALLBACK (*arg).data); return (rval); }
--- a/src/unicode.c Thu May 02 14:35:32 2002 +0000 +++ b/src/unicode.c Sun May 05 11:33:57 2002 +0000 @@ -586,8 +586,8 @@ Lisp_Object char_charset; int c1, c2; - assert (valid_char_p (tab[i])); - BREAKUP_CHAR (tab[i], char_charset, c1, c2); + assert (valid_emchar_p (tab[i])); + BREAKUP_EMCHAR (tab[i], char_charset, c1, c2); assert (EQ (charset, char_charset)); if (XCHARSET_DIMENSION (charset) == 1) { @@ -675,9 +675,9 @@ void *frtab = XCHARSET_FROM_UNICODE_TABLE (charset); if (XCHARSET_DIMENSION (charset) == 1) - this_ch = MAKE_CHAR (charset, i + 32, 0); + this_ch = make_emchar (charset, i + 32, 0); else - this_ch = MAKE_CHAR (charset, codetop + 32, i + 32); + this_ch = make_emchar (charset, codetop + 32, i + 32); assert (tab[i] >= 0); BREAKUP_UNICODE_CODE (tab[i], u4, u3, u2, u1, levels); @@ -692,7 +692,7 @@ default: abort (); } - ch = MAKE_CHAR (charset, val >> 8, val & 0xFF); + ch = make_emchar (charset, val >> 8, val & 0xFF); assert (ch == this_ch); switch (XCHARSET_FROM_UNICODE_LEVELS (charset)) @@ -781,7 +781,7 @@ Lisp_Object charset; int c1, c2; - BREAKUP_CHAR (chr, charset, c1, c2); + BREAKUP_EMCHAR (chr, charset, c1, c2); assert (!EQ (charset, Vcharset_ascii)); assert (!EQ (charset, Vcharset_control_1)); @@ -913,16 +913,16 @@ } int -char_to_unicode (Emchar chr) +emchar_to_unicode (Emchar chr) { Lisp_Object charset; int c1, c2; - type_checking_assert (valid_char_p (chr)); + type_checking_assert (valid_emchar_p (chr)); if (chr < 256) return (int) chr; - BREAKUP_CHAR (chr, charset, c1, c2); + BREAKUP_EMCHAR (chr, charset, c1, c2); if (EQ (charset, Vcharset_composite)) return -1; /* #### don't know how to handle */ else if (XCHARSET_DIMENSION (charset) == 1) @@ -964,7 +964,7 @@ } if (retval != -1) - return MAKE_CHAR (charset, retval >> 8, retval & 0xFF); + return make_emchar (charset, retval >> 8, retval & 0xFF); } } @@ -1009,7 +1009,7 @@ { if (lbs[i] == 0) { - Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i + MIN_LEADING_BYTE); + Lisp_Object charset = charset_by_leading_byte (i + MIN_LEADING_BYTE); if (!NILP (charset)) Dynarr_add (unicode_precedence_dynarr, charset); } @@ -1100,7 +1100,7 @@ CHECK_CHAR (character); CHECK_NATNUM (code); - charset = CHAR_CHARSET (XCHAR (character)); + charset = emchar_charset (XCHAR (character)); if (EQ (charset, Vcharset_ascii) || EQ (charset, Vcharset_control_1) || EQ (charset, Vcharset_composite)) @@ -1122,7 +1122,7 @@ { CHECK_CHAR (character); #ifdef MULE - return make_int (char_to_unicode (XCHAR (character))); + return make_int (emchar_to_unicode (XCHAR (character))); #else return Fchar_to_int (character); #endif /* MULE */ @@ -1352,8 +1352,8 @@ if (cp1high < l2 || cp1high > h2 || cp1low < l1 || cp1low > h1) goto out_of_range; - emch = (cp1high == 0 ? MAKE_CHAR (charset, cp1low, 0) : - MAKE_CHAR (charset, cp1high, cp1low)); + emch = (cp1high == 0 ? make_emchar (charset, cp1low, 0) : + make_emchar (charset, cp1high, cp1low)); set_unicode_conversion (emch, cp2); } } @@ -1548,7 +1548,7 @@ int little_endian) { #ifdef MULE - int code = char_to_unicode (MAKE_CHAR (charset, h & 127, l & 127)); + int code = emchar_to_unicode (make_emchar (charset, h & 127, l & 127)); if (code == -1) { @@ -1714,7 +1714,7 @@ Intbyte c = *src++; #ifdef MULE - if (BYTE_ASCII_P (c)) + if (byte_ascii_p (c)) #endif /* MULE */ { /* Processing ASCII character */ ch = 0; @@ -1724,11 +1724,11 @@ char_boundary = 1; } #ifdef MULE - else if (INTBYTE_LEADING_BYTE_P (c) || INTBYTE_LEADING_BYTE_P (ch)) + else if (intbyte_leading_byte_p (c) || intbyte_leading_byte_p (ch)) { /* Processing Leading Byte */ ch = 0; - charset = CHARSET_BY_LEADING_BYTE (c); - if (LEADING_BYTE_PREFIX_P(c)) + charset = charset_by_leading_byte (c); + if (leading_byte_prefix_p(c)) ch = c; char_boundary = 0; } @@ -1768,7 +1768,7 @@ } else { - Emchar emch = MAKE_CHAR (Vcharset_composite, + Emchar emch = make_emchar (Vcharset_composite, ch & 0x7F, c & 0x7F); Lisp_Object lstr = @@ -2114,10 +2114,10 @@ { write_fmt_string_lisp (printcharfun, "(%s", 1, unicode_getprop (cs, Qtype)); if (XCODING_SYSTEM_UNICODE_LITTLE_ENDIAN (cs)) - write_c_string (", little-endian", printcharfun); + write_c_string (printcharfun, ", little-endian"); if (XCODING_SYSTEM_UNICODE_NEED_BOM (cs)) - write_c_string (", need-bom", printcharfun); - write_c_string (")", printcharfun); + write_c_string (printcharfun, ", need-bom"); + write_c_string (printcharfun, ")"); } int
--- a/src/win32.c Thu May 02 14:35:32 2002 +0000 +++ b/src/win32.c Sun May 05 11:33:57 2002 +0000 @@ -66,12 +66,15 @@ return pseudo_url; } +/* Convert a Win32 file name in tstr format into a local-format file name + in internal format. */ + Lisp_Object -tstr_to_local_file_format (Extbyte *pathout) +tstr_to_local_file_format (Extbyte *path) { Intbyte *ttlff; - TSTR_TO_C_STRING (pathout, ttlff); + TSTR_TO_C_STRING (path, ttlff); WIN32_TO_LOCAL_FILE_FORMAT (ttlff, ttlff); return build_intstring (ttlff); @@ -253,7 +256,7 @@ TSTR_TO_C_STRING (lpMsgBuf, inres); len = qxestrlen (inres); /* Messages tend to end with a period and newline */ - if (len >= 3 && !intbyte_strcmp (inres + len - 3, ".\r\n")) + if (len >= 3 && !qxestrcmp_c (inres + len - 3, ".\r\n")) len -= 3; result = make_string (inres, len); @@ -329,46 +332,14 @@ LISP_STRING_TO_TSTR (parameters, parmext); if (STRINGP (current_dir)) LOCAL_FILE_FORMAT_TO_TSTR (current_dir, path); - if (STRINGP (document)) - { -#ifdef CYGWIN - Extbyte *fname1; - Extbyte *fname2; - int pos, sz; - LISP_STRING_TO_TSTR (document, doc); - - if ((fname1 = strchr (doc, ':')) != NULL - && *++fname1 == '/' && *++fname1 == '/') - { - /* If URL style file, the innards may have Cygwin mount points and - the like. so separate out the innards, process them, and put back - together. */ - if (qxestrncasecmp (doc, "file://", 7) == 0) - { - fname1++; - pos = fname1 - doc; - if (!(isalpha (fname1[0]) && (IS_DEVICE_SEP (fname1[1])))) - { - sz = cygwin_posix_to_win32_path_list_buf_size (fname1); - fname2 = alloca (sz + pos); - qxestrncpy (fname2, doc, pos); - doc = fname2; - fname2 += pos; - cygwin_posix_to_win32_path_list (fname1, fname2); - } - } - } - else { - /* Not URL-style, must be a straight filename. */ - LOCAL_FILE_FORMAT_TO_TSTR (document, doc); - } -#endif - - } + if (STRINGP (document)) + LOCAL_FILE_FORMAT_MAYBE_URL_TO_TSTR (document, doc); ret = (int) qxeShellExecute (NULL, opext, doc, parmext, path, (INTP (show_flag) ? XINT (show_flag) : SW_SHOWDEFAULT)); + + xfree (doc); } if (ret <= 32)
--- a/src/window.c Thu May 02 14:35:32 2002 +0000 +++ b/src/window.c Sun May 05 11:33:57 2002 +0000 @@ -168,7 +168,7 @@ if (print_readably) printing_unreadable_object ("#<window 0x%x>", XWINDOW (obj)->header.uid); - write_c_string ("#<window", printcharfun); + write_c_string (printcharfun, "#<window"); if (!NILP (XWINDOW (obj)->buffer)) { Lisp_Object name = XBUFFER (XWINDOW (obj)->buffer)->name; @@ -1601,7 +1601,7 @@ #if 0 /* bogus FSF crock */ -xxDEFUN ("window-redisplay-end-trigger", +DEFUN ("window-redisplay-end-trigger", Fwindow_redisplay_end_trigger, 0, 1, 0, /* Return WINDOW's redisplay end trigger value. See `set-window-redisplay-end-trigger' for more information. @@ -1611,7 +1611,7 @@ return decode_window (window)->redisplay_end_trigger; } -xxDEFUN ("set-window-redisplay-end-trigger", +DEFUN ("set-window-redisplay-end-trigger", Fset_window_redisplay_end_trigger, 2, 2, 0, /* Set WINDOW's redisplay end trigger value to VALUE. VALUE should be a buffer position (typically a marker) or nil. @@ -5158,7 +5158,7 @@ if (print_readably) printing_unreadable_object ("#<window-configuration 0x%x>", config->header.uid); - write_c_string ("#<window-configuration ", printcharfun); + write_c_string (printcharfun, "#<window-configuration "); write_fmt_string (printcharfun, "0x%x>", config->header.uid); } @@ -6049,20 +6049,20 @@ { dl = Dynarr_atp (dla, i); /* find the vertical location first */ - if (point >= dl->charbpos && point <= dl->end_charbpos) + if (point >= dl->charpos && point <= dl->end_charpos) { db = get_display_block_from_line (dl, TEXT); for (i = 0; i < Dynarr_length (db->runes); i++) { rb = Dynarr_atp (db->runes, i); - if (point <= rb->charbpos) - goto found_charbpos; + if (point <= rb->charpos) + goto found_charpos; } return Qnil; } } return Qnil; - found_charbpos: + found_charpos: ; } else
--- a/tests/ChangeLog Thu May 02 14:35:32 2002 +0000 +++ b/tests/ChangeLog Sun May 05 11:33:57 2002 +0000 @@ -1,3 +1,15 @@ +2002-05-05 Ben Wing <ben@xemacs.org> + + * automated/lisp-tests.el: + * automated/symbol-tests.el: + * automated/test-harness.el: + * automated/test-harness.el (test-harness-from-buffer): + Fix test harness to output FAIL messages to stderr when in + batch mode. + + Fix up some problems in lisp-tests/symbol-tests that were + causing spurious failures. + 2002-04-05 Stephen J. Turnbull <stephen@xemacs.org> * XEmacs 21.5.6 "bok choi" is released.
--- a/tests/automated/lisp-tests.el Thu May 02 14:35:32 2002 +0000 +++ b/tests/automated/lisp-tests.el Sun May 05 11:33:57 2002 +0000 @@ -997,18 +997,27 @@ (Assert (string= (format "%o" 8) "10")) (Assert (string= (format "%x" 31) "1f")) (Assert (string= (format "%X" 31) "1F")) -(Assert (string= (format "%e" 100) "1.000000e+02")) -(Assert (string= (format "%E" 100) "1.000000E+02")) +;; MS-Windows uses +002 in its floating-point numbers. #### We should +;; perhaps fix this, but writing our own floating-point support in doprnt.c +;; is very hard. +(Assert (or (string= (format "%e" 100) "1.000000e+02") + (string= (format "%e" 100) "1.000000e+002"))) +(Assert (or (string= (format "%E" 100) "1.000000E+02") + (string= (format "%E" 100) "1.000000E+002"))) +(Assert (or (string= (format "%E" 100) "1.000000E+02") + (string= (format "%E" 100) "1.000000E+002"))) (Assert (string= (format "%f" 100) "100.000000")) (Assert (string= (format "%7.3f" 12.12345) " 12.123")) (Assert (string= (format "%07.3f" 12.12345) "012.123")) (Assert (string= (format "%-7.3f" 12.12345) "12.123 ")) (Assert (string= (format "%-07.3f" 12.12345) "12.123 ")) (Assert (string= (format "%g" 100.0) "100")) -(Assert (string= (format "%g" 0.000001) "1e-06")) +(Assert (or (string= (format "%g" 0.000001) "1e-06") + (string= (format "%g" 0.000001) "1e-006"))) (Assert (string= (format "%g" 0.0001) "0.0001")) (Assert (string= (format "%G" 100.0) "100")) -(Assert (string= (format "%G" 0.000001) "1E-06")) +(Assert (or (string= (format "%G" 0.000001) "1E-06") + (string= (format "%G" 0.000001) "1E-006"))) (Assert (string= (format "%G" 0.0001) "0.0001")) (Assert (string= (format "%2$d%1$d" 10 20) "2010")) @@ -1033,14 +1042,18 @@ (Assert (string= (format "%#d" 10) "10")) (Assert (string= (format "%#o" 8) "010")) (Assert (string= (format "%#x" 16) "0x10")) -(Assert (string= (format "%#e" 100) "1.000000e+02")) -(Assert (string= (format "%#E" 100) "1.000000E+02")) +(Assert (or (string= (format "%#e" 100) "1.000000e+02") + (string= (format "%#e" 100) "1.000000e+002"))) +(Assert (or (string= (format "%#E" 100) "1.000000E+02") + (string= (format "%#E" 100) "1.000000E+002"))) (Assert (string= (format "%#f" 100) "100.000000")) (Assert (string= (format "%#g" 100.0) "100.000")) -(Assert (string= (format "%#g" 0.000001) "1.00000e-06")) +(Assert (or (string= (format "%#g" 0.000001) "1.00000e-06") + (string= (format "%#g" 0.000001) "1.00000e-006"))) (Assert (string= (format "%#g" 0.0001) "0.000100000")) (Assert (string= (format "%#G" 100.0) "100.000")) -(Assert (string= (format "%#G" 0.000001) "1.00000E-06")) +(Assert (or (string= (format "%#G" 0.000001) "1.00000E-06") + (string= (format "%#G" 0.000001) "1.00000E-006"))) (Assert (string= (format "%#G" 0.0001) "0.000100000")) (Assert (string= (format "%.1d" 10) "10")) (Assert (string= (format "%.4d" 10) "0010"))
--- a/tests/automated/symbol-tests.el Thu May 02 14:35:32 2002 +0000 +++ b/tests/automated/symbol-tests.el Sun May 05 11:33:57 2002 +0000 @@ -299,20 +299,21 @@ (Assert (eq save 'makunbound)) ) -(when (featurep 'file-coding) - (Assert (eq pathname-coding-system file-name-coding-system)) - (let ((val1 file-name-coding-system) - (val2 pathname-coding-system)) - (Assert (eq val1 val2)) - (let ((file-name-coding-system 'no-conversion-dos)) - (Assert (eq file-name-coding-system 'no-conversion-dos)) - (Assert (eq pathname-coding-system file-name-coding-system))) - (let ((pathname-coding-system 'no-conversion-mac)) - (Assert (eq file-name-coding-system 'no-conversion-mac)) - (Assert (eq pathname-coding-system file-name-coding-system))) - (Assert (eq file-name-coding-system pathname-coding-system)) - (Assert (eq val1 file-name-coding-system))) - (Assert (eq pathname-coding-system file-name-coding-system))) +;; pathname-coding-system is no more. +; (when (featurep 'file-coding) +; (Assert (eq pathname-coding-system file-name-coding-system)) +; (let ((val1 file-name-coding-system) +; (val2 pathname-coding-system)) +; (Assert (eq val1 val2)) +; (let ((file-name-coding-system 'no-conversion-dos)) +; (Assert (eq file-name-coding-system 'no-conversion-dos)) +; (Assert (eq pathname-coding-system file-name-coding-system))) +; (let ((pathname-coding-system 'no-conversion-mac)) +; (Assert (eq file-name-coding-system 'no-conversion-mac)) +; (Assert (eq pathname-coding-system file-name-coding-system))) +; (Assert (eq file-name-coding-system pathname-coding-system)) +; (Assert (eq val1 file-name-coding-system))) +; (Assert (eq pathname-coding-system file-name-coding-system))) ;(let ((mysym (make-symbol "test-symbol")))
--- a/tests/automated/test-harness.el Thu May 02 14:35:32 2002 +0000 +++ b/tests/automated/test-harness.el Sun May 05 11:33:57 2002 +0000 @@ -1,6 +1,7 @@ ;; test-harness.el --- Run Emacs Lisp test suites. ;;; Copyright (C) 1998 Free Software Foundation, Inc. +;;; Copyright (C) 2002 Ben Wing. ;; Author: Martin Buchholz ;; Keywords: testing @@ -125,20 +126,32 @@ (trick-optimizer nil) (unexpected-test-suite-failure nil) - (debug-on-error t)) + (debug-on-error t) + (pass-stream nil)) (with-output-to-temp-buffer "*Test-Log*" + (princ (format "Testing %s...\n\n" filename)) + + (defun Print-Failure (fmt &rest args) + (setq fmt (concat "FAIL: " fmt)) + (if (noninteractive) (apply #'message fmt args)) + (princ (concat (apply #'format fmt args) "\n"))) + + (defun Print-Pass (fmt &rest args) + (setq fmt (concat "PASS: " fmt)) + (and test-harness-verbose + (princ (concat (apply #'format fmt args) "\n")))) + (defmacro Assert (assertion) `(condition-case error-info (progn (assert ,assertion) - (princ (format "PASS: %S" (quote ,assertion))) - (terpri) + (Print-Pass "%S" (quote ,assertion)) (incf passes)) (cl-assertion-failed - (princ (format "FAIL: Assertion failed: %S\n" (quote ,assertion))) + (Print-Failure "Assertion failed: %S" (quote ,assertion)) (incf assertion-failures)) - (t (princ (format "FAIL: %S ==> error: %S\n" (quote ,assertion) error-info)) + (t (Print-Failure "%S ==> error: %S" (quote ,assertion) error-info) (incf other-failures) ))) @@ -148,42 +161,42 @@ `(condition-case error-info (progn (setq trick-optimizer (progn ,@body)) - (princ (format "FAIL: %S executed successfully, but expected error %S\n" + (Print-Failure "%S executed successfully, but expected error %S" ,quoted-body - ',expected-error)) + ',expected-error) (incf no-error-failures)) (,expected-error - (princ (format "PASS: %S ==> error %S, as expected\n" - ,quoted-body ',expected-error)) + (Print-Pass "%S ==> error %S, as expected" + ,quoted-body ',expected-error) (incf passes)) (error - (princ (format "FAIL: %S ==> expected error %S, got error %S instead\n" - ,quoted-body ',expected-error error-info)) + (Print-Failure "%S ==> expected error %S, got error %S instead" + ,quoted-body ',expected-error error-info) (incf wrong-error-failures))))) - (defmacro Check-Error-Message (expected-error expected-error-regexp &rest body) + (defmacro Check-Error-Message (expected-error expected-error-regexp + &rest body) (let ((quoted-body (if (= 1 (length body)) `(quote ,(car body)) `(quote (progn ,@body))))) `(condition-case error-info (progn (setq trick-optimizer (progn ,@body)) - (princ (format "FAIL: %S executed successfully, but expected error %S\n" - ,quoted-body - ',expected-error)) + (Print-Failure "%S executed successfully, but expected error %S" + ,quoted-body ',expected-error) (incf no-error-failures)) (,expected-error (let ((error-message (second error-info))) (if (string-match ,expected-error-regexp error-message) (progn - (princ (format "PASS: %S ==> error %S %S, as expected\n" - ,quoted-body error-message ',expected-error)) + (Print-Pass "%S ==> error %S %S, as expected" + ,quoted-body error-message ',expected-error) (incf passes)) - (princ (format "FAIL: %S ==> got error %S as expected, but error message %S did not match regexp %S\n" - ,quoted-body ',expected-error error-message ,expected-error-regexp)) + (Print-Failure "%S ==> got error %S as expected, but error message %S did not match regexp %S" + ,quoted-body ',expected-error error-message ,expected-error-regexp) (incf wrong-error-failures)))) (error - (princ (format "FAIL: %S ==> expected error %S, got error %S instead\n" - ,quoted-body ',expected-error error-info)) + (Print-Failure "%S ==> expected error %S, got error %S instead" + ,quoted-body ',expected-error error-info) (incf wrong-error-failures))))) @@ -201,15 +214,16 @@ (setq trick-optimizer (progn ,@body)) (if (string-match ,expected-message-regexp messages) (progn - (princ (format "PASS: %S ==> value %S, message %S, matching %S, as expected\n" - ,quoted-body trick-optimizer messages ',expected-message-regexp)) + (Print-Pass "%S ==> value %S, message %S, matching %S, as expected" + ,quoted-body trick-optimizer messages ',expected-message-regexp) (incf passes)) - (princ (format "FAIL: %S ==> value %S, message %S, NOT matching expected %S\n" - ,quoted-body trick-optimizer messages ',expected-message-regexp)) + (Print-Failure "%S ==> value %S, message %S, NOT matching expected %S" + ,quoted-body trick-optimizer messages + ',expected-message-regexp) (incf missing-message-failures))) (error - (princ (format "FAIL: %S ==> unexpected error %S\n" - ,quoted-body error-info)) + (Print-Failure "%S ==> unexpected error %S" + ,quoted-body error-info) (incf other-failures))) (ad-unadvise 'message)))) @@ -252,7 +266,7 @@ (message "Unexpected error %S while executing byte-compiled code." error-info) (message "Test suite execution aborted." error-info) ))) - (princ "\nSUMMARY:\n") + (princ (format "\nSUMMARY for %s:\n" filename)) (princ (format "\t%5d passes\n" passes)) (princ (format "\t%5d assertion failures\n" assertion-failures)) (princ (format "\t%5d errors that should have been generated, but weren't\n" no-error-failures))