February 2005 - XEmacs-Patches - XEmacs Mailing List Archives

[ACp (prog-modes)] Verilog mode sync 20 years, 3 months

Norbert Koch

APPROVE COMMIT packages Hi! I've just committed a synced version of verilog-mode.el in prog-modes. norbert.

1 participants
0 comments

[AC21.5] etags update to 17.11 20 years, 3 months

Jerry James

APPROVE COMMIT 21.5 This is the latest etags release from Francesco. lib-src/ChangeLog addition: 2005-02-03 Jerry James <james(a)xemacs.org> * etags.c: Update to author version 17.11. etc/ChangeLog addition: 2005-02-03 Jerry James <james(a)xemacs.org> * ETAGS.EBNF: Update to author version 17.11. xemacs-21.5 source patch: Diff command: cvs -q diff -uN Files affected: etc/ETAGS.EBNF lib-src/etags.c Index: lib-src/etags.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lib-src/etags.c,v retrieving revision 1.32 diff -d -u-r1.32 etags.c --- lib-src/etags.c 2004/10/07 14:51:19 1.32 +++ lib-src/etags.c 2005/02/03 18:02:49 ＠＠ -1,5 +1,5 ＠＠ /* Tags file maker to go with GNU Emacs -*- coding: latin-1 -*- - Copyright (C) 1984, 1987-1989, 1993-1995, 1998-2001, 2002 + Copyright (C) 1984, 1987-1989, 1993-1995, 1998-2004 Free Software Foundation, Inc. and Ken Arnold This file is not considered part of GNU Emacs. ＠＠ -40,7 +40,7 ＠＠ * configuration file containing regexp definitions for etags. */ -char pot_etags_version[] = "＠(#) pot revision number is 17.6"; +char pot_etags_version[] = "＠(#) pot revision number is 17.11"; #define TRUE 1 #define FALSE 0 ＠＠ -342,6 +342,7 ＠＠ static void Cplusplus_entries __P((FILE *)); static void Cstar_entries __P((FILE *)); static void Erlang_functions __P((FILE *)); +static void Forth_words __P((FILE *)); static void Fortran_functions __P((FILE *)); static void HTML_labels __P((FILE *)); static void Lisp_functions __P((FILE *)); ＠＠ -630,6 +631,12 ＠＠ "In Erlang code, the tags are the functions, records and macros\n\ defined in the file."; +char *Forth_suffixes [] = + { "fth", "tok", NULL }; +static char Forth_help [] = +"In Forth code, tags are words defined by `:',\n\ +constant, code, create, defer, value, variable, buffer:, field."; + static char *Fortran_suffixes [] = { "F", "f", "f90", "for", NULL }; static char Fortran_help [] = ＠＠ -777,6 +784,7 ＠＠ { "c*", no_lang_help, Cstar_entries, Cstar_suffixes }, { "cobol", Cobol_help, Cobol_paragraphs, Cobol_suffixes }, { "erlang", Erlang_help, Erlang_functions, Erlang_suffixes }, + { "forth", Forth_help, Forth_words, Forth_suffixes }, { "fortran", Fortran_help, Fortran_functions, Fortran_suffixes }, { "html", HTML_help, HTML_labels, HTML_suffixes }, { "java", Cjava_help, Cjava_entries, Cjava_suffixes }, ＠＠ -1179,12 +1187,14 ＠＠ globals = TRUE; } + /* When the optstring begins with a '-' getopt_long does not rearrange the + non-options arguments to be at the end, but leaves them alone. */ optstring = "-"; #ifdef ETAGS_REGEXPS optstring = "-r:Rc:"; #endif /* ETAGS_REGEXPS */ - if (LONG_OPTIONS) - optstring += 1; + if (!LONG_OPTIONS) + optstring += 1; /* remove the initial '-' */ optstring = concat (optstring, "Cf:Il:o:SVhH", (CTAGS) ? "BxdtTuvw" : "aDi:"); ＠＠ -1284,6 +1294,7 ＠＠ /* NOTREACHED */ } + /* No more options. Store the rest of arguments. */ for (; optind < argc; optind++) { argbuffer[current_arg].arg_type = at_filename; ＠＠ -4074,11 +4085,19 ＠＠ char_pointer = line_buffer.buffer, \ TRUE); \ ) -#define LOOKING_AT(cp, keyword) /* keyword is a constant string */ \ - (strneq ((cp), keyword, sizeof(keyword)-1) /* cp points at keyword */ \ - && notinname ((cp)[sizeof(keyword)-1]) /* end of keyword */ \ - && ((cp) = skip_spaces((cp)+sizeof(keyword)-1))) /* skip spaces */ +#define LOOKING_AT(cp, kw) /* kw is the keyword, a literal string */ \ + ((assert("" kw), TRUE) /* syntax error if not a literal string */ \ + && strneq ((cp), kw, sizeof(kw)-1) /* cp points at kw */ \ + && notinname ((cp)[sizeof(kw)-1]) /* end of kw */ \ + && ((cp) = skip_spaces((cp)+sizeof(kw)-1))) /* skip spaces */ + +/* Similar to LOOKING_AT but does not use notinname, does not skip */ +#define LOOKING_AT_NOCASE(cp, kw) /* the keyword is a literal string */ \ + ((assert("" kw), TRUE) /* syntax error if not a literal string */ \ + && strncaseeq ((cp), kw, sizeof(kw)-1) /* cp points at kw */ \ + && ((cp) += sizeof(kw)-1)) /* skip spaces */ + /* * Read a file, but do no processing. This is used to do regexp * matching on files that have no language defined. ＠＠ -4955,7 +4974,7 ＠＠ /* - * Postscript tag functions + * Postscript tags * Just look for lines where the first character is '/' * Also look at "defineps" for PSWrap * Ideas by: ＠＠ -4986,6 +5005,43 ＠＠ /* + * Forth tags + * Ignore anything after \ followed by space or in ( ) + * Look for words defined by : + * Look for constant, code, create, defer, value, and variable + * OBP extensions: Look for buffer:, field, + * Ideas by Eduardo Horvath <eeh(a)netbsd.org> (2004) + */ +static void +Forth_words (inf) + FILE *inf; +{ + register char *bp; + + LOOP_ON_INPUT_LINES (inf, lb, bp) + while ((bp = skip_spaces (bp))[0] != '\0') + if (bp[0] == '\\' && iswhite(bp[1])) + break; /* read next line */ + else if (bp[0] == '(' && iswhite(bp[1])) + do /* skip to ) or eol */ + bp++; + while (*bp != ')' && *bp != '\0'); + else if ((bp[0] == ':' && iswhite(bp[1]) && bp++) + || LOOKING_AT_NOCASE (bp, "constant") + || LOOKING_AT_NOCASE (bp, "code") + || LOOKING_AT_NOCASE (bp, "create") + || LOOKING_AT_NOCASE (bp, "defer") + || LOOKING_AT_NOCASE (bp, "value") + || LOOKING_AT_NOCASE (bp, "variable") + || LOOKING_AT_NOCASE (bp, "buffer:") + || LOOKING_AT_NOCASE (bp, "field")) + get_tag (skip_spaces (bp), NULL); /* Yay! A definition! */ + else + bp = skip_non_spaces (bp); +} + + +/* * Scheme tag functions * look for (def... xyzzy * (def... (xyzzy ＠＠ -4993,7 +5049,6 ＠＠ * (set! xyzzy * Original code by Ken Haase (1985?) */ - static void Scheme_functions (inf) FILE *inf; ＠＠ -5212,11 +5267,6 ＠＠ } -/* Similar to LOOKING_AT but does not use notinname, does not skip */ -#define LOOKING_AT_NOCASE(cp, kw) /* kw is a constant string */ \ - (strncaseeq ((cp), kw, sizeof(kw)-1) /* cp points at kw */ \ - && ((cp) += sizeof(kw)-1)) /* skip spaces */ - /* * HTML support. * Contents of <title>, <h1>, <h2>, <h3> are tags. ＠＠ -6501,7 +6551,7 ＠＠ : *s1 - *s2); } -/* Skip spaces, return new pointer. */ +/* Skip spaces (end of string is not space), return new pointer. */ static char * skip_spaces (cp) char *cp; ＠＠ -6511,7 +6561,7 ＠＠ return cp; } -/* Skip non spaces, return new pointer. */ +/* Skip non spaces, except end of string, return new pointer. */ static char * skip_non_spaces (cp) char *cp; Index: etc/ETAGS.EBNF =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/etc/ETAGS.EBNF,v retrieving revision 1.2 diff -d -u-r1.2 ETAGS.EBNF --- etc/ETAGS.EBNF 2004/10/07 14:51:11 1.2 +++ etc/ETAGS.EBNF 2005/02/03 18:02:49 ＠＠ -2,7 +2,7 ＠＠ This file contains two sections: -1) An EBNF (Extended Backus Normal Form) description of the format of +1) An EBNF (Extended Backus-Naur Form) description of the format of the tags file created by etags.c and interpreted by etags.el; 2) A discussion of tag names and implicit tag names. -- Jerry James http://www.ittc.ku.edu/~james/

1 participants
0 comments

[AC21.5] More C++ build fixes 20 years, 3 months

Jerry James

APPROVE COMMIT 21.5 My last two patches worked well in isolation, but left a few problems when combined. This patch cleans up a few remaining issues with the C++ build. I know that we should work on configure.ac in preference to configure.in, but I would like to have this problem fixed while we still have configure.in. I'll see that it gets transmitted to configure.ac. ChangeLog addition: 2005-02-03 Jerry James <james(a)xemacs.org> * configure.in: g++ 3.4.2 doesn't like -Wmissing-prototypes or -Wstrict-prototypes. lisp/ChangeLog addition: 2005-02-03 Jerry James <james(a)xemacs.org> * paragraphs.el: Require easy-mmode, due to its move in core. * paragraphs.el (sentence-end): Fix a typo. src/ChangeLog addition: 2005-02-03 Jerry James <james(a)xemacs.org> * dumper.c (pdump_load_finish): Cast to Rawbyte * instead of char *. xemacs-21.5 source patch: Diff command: cvs -q diff -uN Files affected: src/dumper.c lisp/paragraphs.el configure.in Index: configure.in =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/configure.in,v retrieving revision 1.237 diff -d -u -r1.237 configure.in --- configure.in 2005/01/26 10:02:12 1.237 +++ configure.in 2005/02/03 17:14:09 ＠＠ -2103,7 +2103,7 ＠＠ elif test "$CC" = "xlc"; then cflags_warning="-qinfo" elif test "$GCC" = "yes"; then - cflags_warning="-Wall -Wno-switch -Wmissing-prototypes" + cflags_warning="-Wall -Wno-switch -Wundef" dnl This is not very useful, as it issues warnings that may appear dnl or disappear rather randomly, cannot easily be fixed, and are dnl not a big deal. If you want it, add it yourself. ＠＠ -2113,7 +2113,6 ＠＠ dnl Warnings about char subscripts are pretty pointless, though, dnl and we use them in various places. cflags_warning="$cflags_warning -Wsign-compare -Wno-char-subscripts" - cflags_warning="$cflags_warning -Wundef -Wstrict-prototypes" test "$__GCC3" = "yes" && cflags_warning="$cflags_warning -Wpacked" dnl glibc is intentionally not `-Wpointer-arith'-clean. dnl Ulrich Drepper has rejected patches to fix the glibc header files. ＠＠ -2134,6 +2133,7 ＠＠ xe_cflags_warning="$cflags_warning -Wunused-parameter" fi cflags_warning="$cflags_warning -Wshadow -Wmissing-declarations" + cflags_warning="$cflags_warning -Wmissing-prototypes -Wstrict-prototypes" dnl **** If more gcc/g++ flags are added, from here on must handle dnl **** cflags_warning and xe_cflags_warning in parallel elif test "$__ICC" = "yes"; then Index: lisp/paragraphs.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/paragraphs.el,v retrieving revision 1.8 diff -d -u -r1.8 paragraphs.el --- lisp/paragraphs.el 2005/02/03 07:15:56 1.8 +++ lisp/paragraphs.el 2005/02/03 17:14:09 ＠＠ -37,6 +37,8 ＠＠ ;;; Code: +(require 'easy-mmode) + (defgroup paragraphs nil "Paragraph and sentence parsing." :group 'editing) ＠＠ -147,7 +149,7 ＠＠ (defcustom sentence-end (purecopy ;; This is a bit stupid since it's not auto-updated when the - ;; other variables are changes, but it's still useful info. + ;; other variables are changed, but it's still useful info. (concat (if sentence-end-without-period "\\w \\|") "[.?!。．？！。．？！。．？！ $(G!$!%!)!*(B][]\"')}]*" (if sentence-end-double-space Index: src/dumper.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/dumper.c,v retrieving revision 1.23 diff -d -u -r1.23 dumper.c --- src/dumper.c 2005/02/03 16:14:05 1.23 +++ src/dumper.c 2005/02/03 17:14:10 ＠＠ -1819,12 +1819,12 ＠＠ p = pdump_start + header->stab_offset; /* Get the cv_data array */ - p = (char *) ALIGN_PTR (p, pdump_cv_data_dump_info); + p = (Rawbyte *) ALIGN_PTR (p, pdump_cv_data_dump_info); pdump_loaded_cv_data = (pdump_cv_data_dump_info *)p; p += header->nb_cv_data*sizeof(pdump_cv_data_dump_info); /* Build the cv_ptr array */ - p = (char *) ALIGN_PTR (p, pdump_cv_ptr_dump_info); + p = (Rawbyte *) ALIGN_PTR (p, pdump_cv_ptr_dump_info); pdump_loaded_cv_ptr = alloca_array (pdump_cv_ptr_load_info, header->nb_cv_ptr); for (i = 0; i < header->nb_cv_ptr; i++) -- Jerry James http://www.ittc.ku.edu/~james/

1 participants
0 comments

[AC21.5] Remove c_this 20 years, 3 months

Jerry James

APPROVE COMMIT 21.5 This unbreaks the C++ build for me. Please report any breakage caused by this patch to me. I don't think there will be any, though, since I examined every single instance of the word "this" in the sources ... and there were a lot of them! Fortunately, almost all were in comments. src/ChangeLog addition: 2005-02-03 Jerry James <james(a)xemacs.org> * config.h.in: Remove #define this c_this. * device-x.c (construct_name_list): Rename this -> this_widget. * eval.c (wants_debugger): Rename this -> curr. * frame.c (delete_frame_internal): Rename this -> this_frame. * gui-gtk.c (ungcpro_popup_callbacks): Rename this -> this_callback. * gui-gtk.c (get_gcpro_popup_callbacks): Ditto. * gui-x.c (gcpro_popup_callbacks): Ditto. * gui-x.c (ungcpro_popup_callbacks): Ditto. * lisp.h: Remove #undef this and #defin this c_this. * redisplay.c (generate_fstring_runes): Rename this -> this_str. xemacs-21.5 source patch: Diff command: cvs -q diff -uN Files affected: src/redisplay.c src/lisp.h src/gui-x.c src/gui-gtk.c src/frame.c src/eval.c src/device-x.c src/config.h.in Index: src/config.h.in =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/config.h.in,v retrieving revision 1.95 diff -d -u -r1.95 config.h.in --- src/config.h.in 2004/11/04 23:06:17 1.95 +++ src/config.h.in 2005/02/03 16:20:39 ＠＠ -1018,7 +1018,6 ＠＠ # if defined (__cplusplus) /* Avoid C++ keywords used as ordinary C identifiers */ # define new c_new -# define this c_this # define catch c_catch # define EXTERN_C extern "C" Index: src/device-x.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/device-x.c,v retrieving revision 1.60 diff -d -u -r1.60 device-x.c --- src/device-x.c 2005/01/24 23:33:50 1.60 +++ src/device-x.c 2005/02/03 16:20:39 ＠＠ -1238,16 +1238,17 ＠＠ char *fake_class, char *name, char *class_) { char *stack [100][2]; - Widget this; + Widget this_widget; int count = 0; char *name_tail, *class_tail; if (widget) { - for (this = widget; this; this = XtParent (this)) + for (this_widget = widget; this_widget; + this_widget = XtParent (this_widget)) { - stack [count][0] = this->core.name; - stack [count][1] = XtClass (this)->core_class.class_name; + stack [count][0] = this_widget->core.name; + stack [count][1] = XtClass (this_widget)->core_class.class_name; count++; } count--; Index: src/eval.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/eval.c,v retrieving revision 1.87 diff -d -u -r1.87 eval.c --- src/eval.c 2005/02/03 16:14:05 1.87 +++ src/eval.c 2005/02/03 16:20:40 ＠＠ -587,10 +587,10 ＠＠ while (CONSP (conditions)) { - Lisp_Object this, tail; - this = XCAR (conditions); + Lisp_Object curr, tail; + curr = XCAR (conditions); for (tail = list; CONSP (tail); tail = XCDR (tail)) - if (EQ (XCAR (tail), this)) + if (EQ (XCAR (tail), curr)) return 1; conditions = XCDR (conditions); } Index: src/frame.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/frame.c,v retrieving revision 1.67 diff -d -u -r1.67 frame.c --- src/frame.c 2005/02/03 16:14:06 1.67 +++ src/frame.c 2005/02/03 16:20:40 ＠＠ -1445,12 +1445,12 ＠＠ FRAME_LOOP_NO_BREAK (frmcons, devcons, concons) { - Lisp_Object this = XCAR (frmcons); + Lisp_Object this_frame = XCAR (frmcons); - if (! EQ (this, frame) + if (! EQ (this_frame, frame) && EQ (frame, (WINDOW_FRAME (XWINDOW - (FRAME_MINIBUF_WINDOW (XFRAME (this))))))) + (FRAME_MINIBUF_WINDOW (XFRAME (this_frame))))))) { /* We've found another frame whose minibuffer is on this frame. */ ＠＠ -1467,14 +1467,14 ＠＠ FRAME_LOOP_NO_BREAK (frmcons, devcons, concons) { - Lisp_Object this = XCAR (frmcons); + Lisp_Object this_frame = XCAR (frmcons); - if (! EQ (this, frame)) + if (! EQ (this_frame, frame)) { struct device *devcons_d = XDEVICE (XCAR (devcons)); if (EQ (frame, DEVMETH_OR_GIVEN (devcons_d, get_frame_parent, - (XFRAME (this)), + (XFRAME (this_frame)), Qnil))) /* We've found a popup frame whose parent is this frame. */ gui_error ＠＠ -1715,22 +1715,22 ＠＠ CONSOLE_FRAME_LOOP_NO_BREAK (frmcons, devcons, con) { - Lisp_Object this; + Lisp_Object this_frame; struct frame *f1; - this = XCAR (frmcons); - f1 = XFRAME (this); + this_frame = XCAR (frmcons); + f1 = XFRAME (this_frame); /* Consider only frames on the same console and only those with minibuffers. */ if (FRAME_HAS_MINIBUF_P (f1)) { - frame_with_minibuf = this; + frame_with_minibuf = this_frame; if (FRAME_MINIBUF_ONLY_P (f1)) goto double_break_2; } - frame_on_same_console = this; + frame_on_same_console = this_frame; } double_break_2: Index: src/gui-gtk.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/gui-gtk.c,v retrieving revision 1.7 diff -d -u -r1.7 gui-gtk.c --- src/gui-gtk.c 2004/07/07 12:01:07 1.7 +++ src/gui-gtk.c 2005/02/03 16:20:40 ＠＠ -57,19 +57,19 ＠＠ ungcpro_popup_callbacks (GUI_ID id) { Lisp_Object lid = make_int (id); - Lisp_Object this = assq_no_quit (lid, Vpopup_callbacks); - Vpopup_callbacks = delq_no_quit (this, Vpopup_callbacks); + Lisp_Object this_callback = assq_no_quit (lid, Vpopup_callbacks); + Vpopup_callbacks = delq_no_quit (this_callback, Vpopup_callbacks); } Lisp_Object get_gcpro_popup_callbacks (GUI_ID id) { Lisp_Object lid = make_int (id); - Lisp_Object this = assq_no_quit (lid, Vpopup_callbacks); + Lisp_Object this_callback = assq_no_quit (lid, Vpopup_callbacks); - if (!NILP (this)) + if (!NILP (this_callback)) { - return (XCDR (this)); + return (XCDR (this_callback)); } return (Qnil); } Index: src/gui-x.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/gui-x.c,v retrieving revision 1.38 diff -d -u -r1.38 gui-x.c --- src/gui-x.c 2004/11/04 23:06:35 1.38 +++ src/gui-x.c 2005/02/03 16:20:40 ＠＠ -111,12 +111,12 ＠＠ gcpro_popup_callbacks (LWLIB_ID id) { Lisp_Object lid = make_int (id); - Lisp_Object this = assq_no_quit (lid, Vpopup_callbacks); + Lisp_Object this_callback = assq_no_quit (lid, Vpopup_callbacks); - if (!NILP (this)) + if (!NILP (this_callback)) { - free_list (XCDR (this)); - XCDR (this) = snarf_widget_values_for_gcpro (id); + free_list (XCDR (this_callback)); + XCDR (this_callback) = snarf_widget_values_for_gcpro (id); } else Vpopup_callbacks = Fcons (Fcons (lid, snarf_widget_values_for_gcpro (id)), ＠＠ -130,11 +130,11 ＠＠ ungcpro_popup_callbacks (LWLIB_ID id) { Lisp_Object lid = make_int (id); - Lisp_Object this = assq_no_quit (lid, Vpopup_callbacks); + Lisp_Object this_callback = assq_no_quit (lid, Vpopup_callbacks); - assert (!NILP (this)); - free_list (XCDR (this)); - Vpopup_callbacks = delq_no_quit (this, Vpopup_callbacks); + assert (!NILP (this_callback)); + free_list (XCDR (this_callback)); + Vpopup_callbacks = delq_no_quit (this_callback, Vpopup_callbacks); } int Index: src/lisp.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/lisp.h,v retrieving revision 1.123 diff -d -u -r1.123 lisp.h --- src/lisp.h 2005/02/03 07:11:28 1.123 +++ src/lisp.h 2005/02/03 16:20:40 ＠＠ -516,8 +516,6 ＠＠ we don't want by creating overloaded versions of them and declaring them private. */ -#undef this - class Bytecount; class Bytebpos; class Bytexpos; ＠＠ -942,8 +940,6 ＠＠ { return Bytecount (x - y); } #endif -#define this c_this - #endif /* __cplusplus */ /* Counts of elements */ ＠＠ -3235,9 +3231,7 ＠＠ gcpro (const gcpro& g) : next (g.next), var (g.var), nvars (g.nvars) { } gcpro& operator= (const gcpro& g) { next = g.next; var = g.var; nvars = g.nvars; -#undef this return *this;} -#define this c_this ~gcpro () { assert (!next); } #endif /* defined (__cplusplus) && defined (ERROR_CHECK_GC) */ }; Index: src/redisplay.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/redisplay.c,v retrieving revision 1.95 diff -d -u -r1.95 redisplay.c --- src/redisplay.c 2005/02/03 16:14:08 1.95 +++ src/redisplay.c 2005/02/03 16:20:41 ＠＠ -4106,20 +4106,20 ＠＠ /* A string. Add to the display line and check for %-constructs within it. */ - Ibyte *this = XSTRING_DATA (elt); + Ibyte *this_str = XSTRING_DATA (elt); - while ((pos < max_pos || max_pos == -1) && *this) + while ((pos < max_pos || max_pos == -1) && *this_str) { - Ibyte *last = this; + Ibyte *last = this_str; - while (*this && *this != '%') - this++; + while (*this_str && *this_str != '%') + this_str++; - if (this != last) + if (this_str != last) { /* No %-construct */ Charcount size = - bytecount_to_charcount (last, this - last); + bytecount_to_charcount (last, this_str - last); if (size <= *offset) *offset -= size; ＠＠ -4134,32 +4134,32 ＠＠ *offset = 0; } } - else /* *this == '%' */ + else /* *this_str == '%' */ { Charcount spec_width = 0; - this++; /* skip over '%' */ + this_str++; /* skip over '%' */ /* We can't allow -ve args due to the "%-" construct. * Argument specifies minwidth but not maxwidth * (maxwidth can be specified by * (<negative-number> . <stuff>) modeline elements) */ - while (isdigit (*this)) + while (isdigit (*this_str)) { - spec_width = spec_width * 10 + (*this - '0'); - this++; + spec_width = spec_width * 10 + (*this_str - '0'); + this_str++; } spec_width += pos; - if (*this == 'M') + if (*this_str == 'M') { pos = generate_fstring_runes (w, data, pos, spec_width, max_pos, Vglobal_mode_string, depth, max_pixsize, findex, type, offset, cur_ext); } - else if (*this == '-') + else if (*this_str == '-') { Charcount num_to_add; ＠＠ -4186,9 +4186,9 ＠＠ pos = add_string_to_fstring_db_runes (data, (const Ibyte *) "-", pos, pos, max_pos); } - else if (*this != 0) + else if (*this_str != 0) { - Ichar ch = itext_ichar (this); + Ichar ch = itext_ichar (this_str); Ibyte *str; Charcount size; ＠＠ -4215,9 +4215,9 ＠＠ } } - /* NOT this++. There could be any sort of character at + /* NOT this_str++. There could be any sort of character at the current position. */ - INC_IBYTEPTR (this); + INC_IBYTEPTR (this_str); } if (max_pixsize > 0) -- Jerry James http://www.ittc.ku.edu/~james/

1 participants
0 comments

[PATCH 21.5] Dump bignums (OG workspace) 20 years, 3 months

Jerry James

This is a modified version of OG's bignum dumping workspace. I have altered his original patch in several ways: (1) Some updates were necessary due to Ben Wing's name changes; (2) I removed a comma operator that was used for typechecking because it was not valid C++ code (this became unnecessary anyway due to change #4 below); (3) I added code that uses the dumping capability to initialize bigfloat-max-prec in a saner way than is currently possible; and (4) His patch included some unclean typecasts that triggered alias analysis warnings from gcc. I fixed those with a union. It is this last point that prompts me to make this a patch rather than a commit. Making the 4th element of memory_description a union means that all initializers have to put {} around that element. Does anybody object to this and, if so, can you propose an alternative approach? src/ChangeLog addition: 2005-02-01 Jerry James <james(a)xemacs.org> * dumper.c: Olivier Galibert's changes to enable dumping data via a Java-like serialization/deserialization process. * number.c: OG's bignum conversion functions. Also, use the dumping capability to initialize bigfloat-max-prec sanely. * alloc.c: * buffer.c: * bytecode.c: * console.c: * data.c: * device.c: * elhash.c: * eval.c: * events.c: * extents.c: * file-coding.c: * frame.c: * glyphs.c: * lstream.c: * marker.c: * mule-charset.c: * mule-coding.c: * objects.c: * profile.c: * rangetab.c: * redisplay.c: * specifier.c: * unicode.c: * window.c: Add curly braces to the data2 arg of each memory_description initializer. Add a union member name to each reference to data2. * lrecord.h: Ditto. OG changes to add and document XD_OPAQUE_PTR_CONVERTIBLE and XD_OPAQUE_DATA_CONVERTIBLE. Add memory_contents_description to solve pointer aliasing problems. xemacs-21.5 source patch: Diff command: cvs -q diff -uN Files affected: src/window.c src/unicode.c src/specifier.c src/redisplay.c src/rangetab.c src/profile.c src/objects.c src/number.c src/number-gmp.h src/mule-coding.c src/mule-charset.c src/marker.c src/lstream.c src/lrecord.h src/glyphs.c src/frame.c src/file-coding.c src/extents.c src/events.c src/eval.c src/elhash.c src/dumper.c src/device.c src/data.c src/console.c src/bytecode.c src/buffer.c src/alloc.c Index: src/alloc.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/alloc.c,v retrieving revision 1.105 diff -d -u -r1.105 alloc.c --- src/alloc.c 2005/01/29 09:15:58 1.105 +++ src/alloc.c 2005/02/01 18:43:07 ＠＠ -2662,7 +2662,7 ＠＠ */ const struct memory_description free_description[] = { - { XD_LISP_OBJECT, offsetof (struct free_lcrecord_header, chain), 0, 0, + { XD_LISP_OBJECT, offsetof (struct free_lcrecord_header, chain), 0, { 0 }, XD_FLAG_FREE_LISP_OBJECT }, { XD_END } }; ＠＠ -2674,7 +2674,7 ＠＠ struct free_lcrecord_header); const struct memory_description lcrecord_list_description[] = { - { XD_LISP_OBJECT, offsetof (struct lcrecord_list, free), 0, 0, + { XD_LISP_OBJECT, offsetof (struct lcrecord_list, free), 0, { 0 }, XD_FLAG_FREE_LISP_OBJECT }, { XD_END } }; ＠＠ -3152,7 +3152,8 ＠＠ return (val * lispdesc_block_size - (rdata, lispdesc_indirect_description (obj, desc1->data2))); + (rdata, + lispdesc_indirect_description (obj, desc1->data2.descr))); } case XD_OPAQUE_DATA_PTR: return sizeof (void *); ＠＠ -3162,7 +3163,7 ＠＠ description, use it; else compute size based on current union constant. */ const struct sized_memory_description *sdesc = - lispdesc_indirect_description (obj, desc1->data2); + lispdesc_indirect_description (obj, desc1->data2.descr); if (sdesc->size) return sdesc->size; else ＠＠ -3179,7 +3180,7 ＠＠ description, use it; else compute size based on maximum of all possible structures. */ const struct sized_memory_description *sdesc = - lispdesc_indirect_description (obj, desc1->data2); + lispdesc_indirect_description (obj, desc1->data2.descr); if (sdesc->size) return sdesc->size; else ＠＠ -3520,7 +3521,7 ＠＠ EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc, data); const struct sized_memory_description *sdesc = - lispdesc_indirect_description (data, desc1->data2); + lispdesc_indirect_description (data, desc1->data2.descr); const char *dobj = * (const char **) rdata; if (dobj) mark_struct_contents (dobj, sdesc, count); ＠＠ -3531,7 +3532,7 ＠＠ EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc, data); const struct sized_memory_description *sdesc = - lispdesc_indirect_description (data, desc1->data2); + lispdesc_indirect_description (data, desc1->data2.descr); mark_struct_contents (rdata, sdesc, count); break; Index: src/buffer.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/buffer.c,v retrieving revision 1.69 diff -d -u -r1.69 buffer.c --- src/buffer.c 2005/01/24 23:33:47 1.69 +++ src/buffer.c 2005/02/01 18:43:07 ＠＠ -245,9 +245,9 ＠＠ { XD_LISP_OBJECT, offsetof (struct buffer, extent_info) }, { XD_BLOCK_PTR, offsetof (struct buffer, text), - 1, &buffer_text_description }, + 1, { &buffer_text_description } }, { XD_BLOCK_PTR, offsetof (struct buffer, syntax_cache), - 1, &syntax_cache_description }, + 1, { &syntax_cache_description } }, { XD_LISP_OBJECT, offsetof (struct buffer, indirect_children) }, { XD_LISP_OBJECT, offsetof (struct buffer, base_buffer) }, Index: src/bytecode.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/bytecode.c,v retrieving revision 1.45 diff -d -u -r1.45 bytecode.c --- src/bytecode.c 2005/01/29 09:15:59 1.45 +++ src/bytecode.c 2005/02/01 18:43:07 ＠＠ -2180,7 +2180,7 ＠＠ static const struct memory_description compiled_function_description[] = { { XD_INT, offsetof (Lisp_Compiled_Function, args_in_array) }, { XD_BLOCK_PTR, offsetof (Lisp_Compiled_Function, args), - XD_INDIRECT (0, 0), &lisp_object_description }, + XD_INDIRECT (0, 0), { &lisp_object_description } }, { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, instructions) }, { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, constants) }, { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, arglist) }, Index: src/console.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console.c,v retrieving revision 1.39 diff -d -u -r1.39 console.c --- src/console.c 2005/01/24 23:33:48 1.39 +++ src/console.c 2005/02/01 18:43:07 ＠＠ -115,9 +115,9 ＠＠ static const struct memory_description console_data_description_1 []= { #ifdef HAVE_TTY - { XD_BLOCK_PTR, tty_console, 1, &tty_console_data_description}, + { XD_BLOCK_PTR, tty_console, 1, { &tty_console_data_description} }, #endif - { XD_BLOCK_PTR, stream_console, 1, &stream_console_data_description}, + { XD_BLOCK_PTR, stream_console, 1, { &stream_console_data_description} }, { XD_END } }; ＠＠ -130,9 +130,9 ＠＠ #define MARKED_SLOT(x) { XD_LISP_OBJECT, offsetof (struct console, x) }, #include "conslots.h" { XD_BLOCK_PTR, offsetof (struct console, conmeths), 1, - &console_methods_description }, + { &console_methods_description } }, { XD_UNION, offsetof (struct console, console_data), - XD_INDIRECT (0, 0), &console_data_description }, + XD_INDIRECT (0, 0), { &console_data_description } }, { XD_END } }; ＠＠ -1227,7 +1227,8 ＠＠ static const struct memory_description cte_description_1[] = { { XD_LISP_OBJECT, offsetof (console_type_entry, symbol) }, - { XD_BLOCK_PTR, offsetof (console_type_entry, meths), 1, &console_methods_description }, + { XD_BLOCK_PTR, offsetof (console_type_entry, meths), 1, + { &console_methods_description } }, { XD_END } }; Index: src/data.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/data.c,v retrieving revision 1.61 diff -d -u -r1.61 data.c --- src/data.c 2005/01/24 23:33:49 1.61 +++ src/data.c 2005/02/01 18:43:07 ＠＠ -2589,9 +2589,9 ＠＠ static const struct memory_description weak_list_description[] = { { XD_LISP_OBJECT, offsetof (struct weak_list, list), - 0, 0, XD_FLAG_NO_KKCC }, + 0, { 0 }, XD_FLAG_NO_KKCC }, { XD_LO_LINK, offsetof (struct weak_list, next_weak), - 0, 0, XD_FLAG_NO_KKCC }, + 0, { 0 }, XD_FLAG_NO_KKCC }, { XD_END } }; ＠＠ -3299,11 +3299,11 ＠＠ is marked here. */ static const struct memory_description ephemeron_description[] = { { XD_LISP_OBJECT, offsetof(struct ephemeron, key), - 0, 0, XD_FLAG_NO_KKCC }, + 0, { 0 }, XD_FLAG_NO_KKCC }, { XD_LISP_OBJECT, offsetof(struct ephemeron, cons_chain), - 0, 0, XD_FLAG_NO_KKCC }, + 0, { 0 }, XD_FLAG_NO_KKCC }, { XD_LISP_OBJECT, offsetof(struct ephemeron, value), - 0, 0, XD_FLAG_NO_KKCC }, + 0, { 0 }, XD_FLAG_NO_KKCC }, { XD_END } }; Index: src/device.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/device.c,v retrieving revision 1.32 diff -d -u -r1.32 device.c --- src/device.c 2004/11/04 23:06:20 1.32 +++ src/device.c 2005/02/01 18:43:07 ＠＠ -93,14 +93,14 ＠＠ static const struct memory_description device_data_description_1 []= { #ifdef HAVE_GTK - { XD_BLOCK_PTR, gtk_console, 1, &gtk_device_data_description}, + { XD_BLOCK_PTR, gtk_console, 1, { &gtk_device_data_description} }, #endif #ifdef HAVE_MS_WINDOWS - { XD_BLOCK_PTR, mswindows_console, 1, &mswindows_device_data_description}, - { XD_BLOCK_PTR, msprinter_console, 1, &msprinter_device_data_description}, + { XD_BLOCK_PTR, mswindows_console, 1, { &mswindows_device_data_description} }, + { XD_BLOCK_PTR, msprinter_console, 1, { &msprinter_device_data_description} }, #endif #ifdef HAVE_X_WINDOWS - { XD_BLOCK_PTR, x_console, 1, &x_device_data_description}, + { XD_BLOCK_PTR, x_console, 1, { &x_device_data_description} }, #endif { XD_END } }; ＠＠ -115,9 +115,9 ＠＠ #include "devslots.h" { XD_BLOCK_PTR, offsetof (struct device, devmeths), 1, - &console_methods_description }, + { &console_methods_description } }, { XD_UNION, offsetof (struct device, device_data), - XD_INDIRECT (0, 0), &device_data_description }, + XD_INDIRECT (0, 0), { &device_data_description } }, { XD_END } }; Index: src/dumper.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/dumper.c,v retrieving revision 1.22 diff -d -u -r1.22 dumper.c --- src/dumper.c 2005/01/24 23:33:50 1.22 +++ src/dumper.c 2005/02/01 18:43:08 ＠＠ -1,5 +1,5 ＠＠ /* Portable data dumper for XEmacs. - Copyright (C) 1999-2000 Olivier Galibert + Copyright (C) 1999-2000,2004 Olivier Galibert Copyright (C) 2001 Martin Buchholz Copyright (C) 2001, 2002, 2003, 2004 Ben Wing. ＠＠ -78,6 +78,57 ＠＠ typedef struct { + const void *object; + void *data; + Bytecount size; + EMACS_INT offset; + EMACS_INT dest_offset; + EMACS_INT save_offset; + const struct opaque_convert_functions *fcts; +} pdump_cv_data_info; + +typedef struct +{ + Dynarr_declare (pdump_cv_data_info); +} pdump_cv_data_info_dynarr; + +typedef struct +{ + EMACS_INT dest_offset; + EMACS_INT save_offset; + Bytecount size; +} pdump_cv_data_dump_info; + +typedef struct +{ + const void *object; + void *data; + Bytecount size; + EMACS_INT index; + EMACS_INT save_offset; + const struct opaque_convert_functions *fcts; +} pdump_cv_ptr_info; + +typedef struct +{ + Dynarr_declare (pdump_cv_ptr_info); +} pdump_cv_ptr_info_dynarr; + +typedef struct +{ + EMACS_INT save_offset; + Bytecount size; +} pdump_cv_ptr_dump_info; + +typedef struct +{ + EMACS_INT save_offset; + Bytecount size; + void *adr; +} pdump_cv_ptr_load_info; + +typedef struct +{ Lisp_Object *address; Lisp_Object value; } pdump_static_Lisp_Object; ＠＠ -92,6 +143,8 ＠＠ static pdump_root_block_ptr_dynarr *pdump_root_block_ptrs; static Lisp_Object_ptr_dynarr *pdump_root_lisp_objects; static Lisp_Object_ptr_dynarr *pdump_weak_object_chains; +static pdump_cv_data_info_dynarr *pdump_cv_data; +static pdump_cv_ptr_info_dynarr *pdump_cv_ptr; /* Mark SIZE bytes at non-heap address BLOCKADDR for dumping, described by DESC. Called by outside callers during XEmacs initialization. */ ＠＠ -210,7 +263,10 ＠＠ /* The structure of the dump file looks like this: 0 - header - dumped objects - stab_offset - nb_root_block_ptrs*struct(void *, adr) + stab_offset - nb_cv_data*struct(dest, adr) for in-object externally + represented data + - nb_cv_ptr*(adr) for pointed-to externally represented data + - nb_root_block_ptrs*struct(void *, adr) for global pointers to heap blocks - nb_root_blocks*struct(void *, size, info) for global data-segment blocks to restore ＠＠ -231,12 +287,17 ＠＠ EMACS_UINT reloc_address; int nb_root_block_ptrs; int nb_root_blocks; + int nb_cv_data; + int nb_cv_ptr; } pdump_header; Rawbyte *pdump_start; Rawbyte *pdump_end; static Bytecount pdump_length; +static pdump_cv_data_dump_info *pdump_loaded_cv_data; +static pdump_cv_ptr_load_info *pdump_loaded_cv_ptr; + #ifdef WIN32_NATIVE /* Handle for the dump file */ static HANDLE pdump_hFile = INVALID_HANDLE_VALUE; ＠＠ -449,6 +510,16 ＠＠ return &pdump_desc_table.list[pdump_desc_table.count++].list; } +static pdump_cv_ptr_info * +pdump_find_in_cv_ptr_dynarr(const void *object) +{ + int i; + for (i = 0; i < Dynarr_length (pdump_cv_ptr); i++) + if (Dynarr_at (pdump_cv_ptr, i).object == object) + return Dynarr_atp (pdump_cv_ptr, i); + return 0; +} + static struct { struct lrecord_header *obj; ＠＠ -608,7 +679,7 ＠＠ EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc, data); const struct sized_memory_description *sdesc = - lispdesc_indirect_description (data, desc1->data2); + lispdesc_indirect_description (data, desc1->data2.descr); const Rawbyte *dobj = *(const Rawbyte **)rdata; if (dobj) pdump_register_block (dobj, sdesc->size, sdesc->description, ＠＠ -620,7 +691,7 ＠＠ EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc, data); const struct sized_memory_description *sdesc = - lispdesc_indirect_description (data, desc1->data2); + lispdesc_indirect_description (data, desc1->data2.descr); pdump_register_block_contents (rdata, sdesc->size, sdesc->description, count); ＠＠ -632,6 +703,29 ＠＠ if (desc1) goto union_switcheroo; break; + case XD_OPAQUE_PTR_CONVERTIBLE: + { + pdump_cv_ptr_info info; + info.object = *(void **)rdata; + info.fcts = desc1->data2.funcs; + if (!pdump_find_in_cv_ptr_dynarr (info.object)) + { + info.fcts->convert(info.object, &info.data, &info.size); + Dynarr_add (pdump_cv_ptr, info); + } + break; + } + case XD_OPAQUE_DATA_CONVERTIBLE: + { + pdump_cv_data_info info; + info.object = data; + info.offset = offset; + info.fcts = desc1->data2.funcs; + + info.fcts->convert(rdata, &info.data, &info.size); + Dynarr_add (pdump_cv_data, info); + break; + } default: pdump_unsupported_dump_type (desc1->type, 1); ＠＠ -726,6 +820,7 ＠＠ } } + /* Store the already-calculated new pointer offsets for all pointers in the COUNT contiguous blocks of memory, each described by DESC and of size SIZE, whose original is located at ORIG_DATA and the modifiable copy at ＠＠ -876,7 +971,7 ＠＠ EMACS_INT num = lispdesc_indirect_count (desc1->data1, desc, orig_data); const struct sized_memory_description *sdesc = - lispdesc_indirect_description (orig_data, desc1->data2); + lispdesc_indirect_description (orig_data, desc1->data2.descr); pdump_store_new_pointer_offsets (num, rdata, ＠＠ -895,6 +990,14 ＠＠ goto union_switcheroo; break; + case XD_OPAQUE_PTR_CONVERTIBLE: + *(EMACS_INT *)rdata = pdump_find_in_cv_ptr_dynarr (*(void **)rdata)->index; + break; + + case XD_OPAQUE_DATA_CONVERTIBLE: + /* in-object, nothing to do */ + break; + default: pdump_unsupported_dump_type (desc1->type, 0); } ＠＠ -1015,7 +1118,7 ＠＠ data); int j; const struct sized_memory_description *sdesc = - lispdesc_indirect_description (data, desc1->data2); + lispdesc_indirect_description (data, desc1->data2.descr); Bytecount size = lispdesc_block_size (rdata, sdesc); /* Note: We are recursing over data in the block itself */ ＠＠ -1032,6 +1135,28 ＠＠ goto union_switcheroo; break; + case XD_OPAQUE_PTR_CONVERTIBLE: + { + pdump_cv_ptr_load_info *p = pdump_loaded_cv_ptr + *(EMACS_INT *)rdata; + if (!p->adr) + p->adr = desc1->data2.funcs->deconvert(0, pdump_start + + p->save_offset, p->size); + *(void **)rdata = p->adr; + break; + } + + case XD_OPAQUE_DATA_CONVERTIBLE: + { + EMACS_INT dest_offset = (Rawbyte *)rdata - pdump_start; + pdump_cv_data_dump_info *p; + + for(p = pdump_loaded_cv_data; p->dest_offset != dest_offset; p++); + + desc1->data2.funcs->deconvert(rdata, pdump_start + p->save_offset, + p->size); + break; + } + default: pdump_unsupported_dump_type (desc1->type, 0); } ＠＠ -1049,6 +1174,39 ＠＠ cur_offset += size; } +/* Write out to global file descriptor PDUMP_OUT the result of an + external element. It's just opaque data. */ + +static void +pdump_dump_cv_data (pdump_cv_data_info *elt) +{ + retry_fwrite (elt->data, elt->size, 1, pdump_out); +} + +static void +pdump_dump_cv_ptr (pdump_cv_ptr_info *elt) +{ + retry_fwrite (elt->data, elt->size, 1, pdump_out); +} + +static void +pdump_allocate_offset_cv_data (pdump_cv_data_info *elt) +{ + elt->save_offset = cur_offset; + if (elt->size>max_size) + max_size = elt->size; + cur_offset += elt->size; +} + +static void +pdump_allocate_offset_cv_ptr (pdump_cv_ptr_info *elt) +{ + elt->save_offset = cur_offset; + if (elt->size>max_size) + max_size = elt->size; + cur_offset += elt->size; +} + /* Traverse through all the heap blocks, once the "register" stage of dumping has finished. To compress space as much as possible, we logically sort all blocks by alignment, hitting all blocks with ＠＠ -1081,7 +1239,9 ＠＠ static void pdump_scan_by_alignment (void (*f)(pdump_block_list_elt *, - const struct memory_description *)) + const struct memory_description *), + void (*g)(pdump_cv_data_info *), + void (*h)(pdump_cv_ptr_info *)) { int align; ＠＠ -1106,15 +1266,56 ＠＠ for (elt = pdump_opaque_data_list.first; elt; elt = elt->next) if (pdump_size_to_align (elt->size) == align) f (elt, 0); + + for (i=0; i < Dynarr_length (pdump_cv_data); i++) + if (pdump_size_to_align (Dynarr_atp (pdump_cv_data, i)->size) == align) + g (Dynarr_atp (pdump_cv_data, i)); + + for (i=0; i < Dynarr_length (pdump_cv_ptr); i++) + if (pdump_size_to_align (Dynarr_atp (pdump_cv_ptr, i)->size) == align) + h (Dynarr_atp (pdump_cv_ptr, i)); } } +static void +pdump_dump_cv_data_info (void) +{ + int i; + Elemcount count = Dynarr_length (pdump_cv_data); + pdump_cv_data_dump_info *data = alloca_array (pdump_cv_data_dump_info, count); + for (i = 0; i < count; i++) + { + data[i].dest_offset = Dynarr_at (pdump_cv_data, i).dest_offset; + data[i].save_offset = Dynarr_at (pdump_cv_data, i).save_offset; + data[i].size = Dynarr_at (pdump_cv_data, i).size; + } + + PDUMP_ALIGN_OUTPUT (pdump_cv_data_dump_info); + retry_fwrite (data, sizeof (pdump_cv_data_dump_info), count, pdump_out); +} + /* Dump out the root block pointers, part of stage 3 (the "WRITE" stage) of dumping. For each pointer we dump out a structure containing the location of the pointer and its value, replaced by the appropriate offset into the dumped data. */ static void +pdump_dump_cv_ptr_info (void) +{ + int i; + Elemcount count = Dynarr_length (pdump_cv_ptr); + pdump_cv_ptr_dump_info *data = alloca_array (pdump_cv_ptr_dump_info, count); + for (i = 0; i < count; i++) + { + data[i].save_offset = Dynarr_at (pdump_cv_ptr, i).save_offset; + data[i].size = Dynarr_at (pdump_cv_ptr, i).size; + } + + PDUMP_ALIGN_OUTPUT (pdump_cv_ptr_dump_info); + retry_fwrite (data, sizeof (pdump_cv_ptr_dump_info), count, pdump_out); +} + +static void pdump_dump_root_block_ptrs (void) { int i; ＠＠ -1436,6 +1637,9 ＠＠ pdump_opaque_data_list.count = 0; pdump_depth = 0; + pdump_cv_data = Dynarr_new2 (pdump_cv_data_info_dynarr, pdump_cv_data_info); + pdump_cv_ptr = Dynarr_new2 (pdump_cv_ptr_info_dynarr, pdump_cv_ptr_info); + /* (I) The "register" stage: Note all heap memory blocks to be relocated */ ＠＠ -1495,13 +1699,17 ＠＠ header.reloc_address = 0; header.nb_root_block_ptrs = Dynarr_length (pdump_root_block_ptrs); header.nb_root_blocks = Dynarr_length (pdump_root_blocks); + header.nb_cv_data = Dynarr_length (pdump_cv_data); + header.nb_cv_ptr = Dynarr_length (pdump_cv_ptr); cur_offset = MAX_ALIGN_SIZE (sizeof (header)); max_size = 0; /* (2) Traverse all heap blocks and compute their offsets; keep track of maximum block size seen */ - pdump_scan_by_alignment (pdump_allocate_offset); + pdump_scan_by_alignment (pdump_allocate_offset, + pdump_allocate_offset_cv_data, + pdump_allocate_offset_cv_ptr); cur_offset = MAX_ALIGN_SIZE (cur_offset); header.stab_offset = cur_offset; ＠＠ -1537,10 +1745,36 ＠＠ retry_fwrite (&header, sizeof (header), 1, pdump_out); PDUMP_ALIGN_OUTPUT (max_align_t); - pdump_scan_by_alignment (pdump_dump_data); + for (i = 0; i < Dynarr_length (pdump_cv_data); i++) + { + pdump_cv_data_info *elt = Dynarr_atp (pdump_cv_data, i); + elt->dest_offset = + pdump_get_block (elt->object)->save_offset + elt->offset; + } + + for (i = 0; i < Dynarr_length (pdump_cv_ptr); i++) + Dynarr_at (pdump_cv_ptr, i).index = i; + + pdump_scan_by_alignment (pdump_dump_data, pdump_dump_cv_data, pdump_dump_cv_ptr); + for (i = 0; i < Dynarr_length (pdump_cv_data); i++) + { + pdump_cv_data_info *elt = Dynarr_atp (pdump_cv_data, i); + if(elt->fcts->convert_free) + elt->fcts->convert_free(elt->object, elt->data, elt->size); + } + + for (i = 0; i < Dynarr_length (pdump_cv_ptr); i++) + { + pdump_cv_ptr_info *elt = Dynarr_atp (pdump_cv_ptr, i); + if(elt->fcts->convert_free) + elt->fcts->convert_free(elt->object, elt->data, elt->size); + } + fseek (pdump_out, header.stab_offset, SEEK_SET); + pdump_dump_cv_data_info (); + pdump_dump_cv_ptr_info (); pdump_dump_root_block_ptrs (); pdump_dump_root_blocks (); pdump_dump_rtables (); ＠＠ -1583,6 +1817,23 ＠＠ delta = ((EMACS_INT) pdump_start) - header->reloc_address; p = pdump_start + header->stab_offset; + + /* Get the cv_data array */ + p = (char *) ALIGN_PTR (p, pdump_cv_data_dump_info); + pdump_loaded_cv_data = (pdump_cv_data_dump_info *)p; + p += header->nb_cv_data*sizeof(pdump_cv_data_dump_info); + + /* Build the cv_ptr array */ + p = (char *) ALIGN_PTR (p, pdump_cv_ptr_dump_info); + pdump_loaded_cv_ptr = + alloca_array (pdump_cv_ptr_load_info, header->nb_cv_ptr); + for (i = 0; i < header->nb_cv_ptr; i++) + { + pdump_cv_ptr_dump_info info = PDUMP_READ (p, pdump_cv_ptr_dump_info); + pdump_loaded_cv_ptr[i].save_offset = info.save_offset; + pdump_loaded_cv_ptr[i].size = info.size; + pdump_loaded_cv_ptr[i].adr = 0; + } /* Put back the pdump_root_block_ptrs */ p = (Rawbyte *) ALIGN_PTR (p, pdump_static_pointer); Index: src/elhash.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/elhash.c,v retrieving revision 1.39 diff -d -u -r1.39 elhash.c --- src/elhash.c 2005/01/24 23:33:51 1.39 +++ src/elhash.c 2005/02/01 18:43:08 ＠＠ -452,8 +452,8 ＠＠ /* Note: XD_INDIRECT in this table refers to the surrounding table, and so this will work. */ { XD_BLOCK_PTR, HASH_TABLE_NON_WEAK, XD_INDIRECT (0, 1), - &htentry_description }, - { XD_BLOCK_PTR, 0, XD_INDIRECT (0, 1), &htentry_description, + { &htentry_description } }, + { XD_BLOCK_PTR, 0, XD_INDIRECT (0, 1), { &htentry_description }, XD_FLAG_UNION_DEFAULT_ENTRY | XD_FLAG_NO_KKCC }, { XD_END } }; ＠＠ -467,7 +467,7 ＠＠ { XD_ELEMCOUNT, offsetof (Lisp_Hash_Table, size) }, { XD_INT, offsetof (Lisp_Hash_Table, weakness) }, { XD_UNION, offsetof (Lisp_Hash_Table, hentries), XD_INDIRECT (1, 0), - &htentry_union_description }, + { &htentry_union_description } }, { XD_LO_LINK, offsetof (Lisp_Hash_Table, next_weak) }, { XD_END } }; Index: src/eval.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/eval.c,v retrieving revision 1.86 diff -d -u -r1.86 eval.c --- src/eval.c 2005/01/29 09:15:59 1.86 +++ src/eval.c 2005/02/01 18:43:08 ＠＠ -429,7 +429,7 ＠＠ } static const struct memory_description subr_description[] = { - { XD_DOC_STRING, offsetof (Lisp_Subr, doc), 0, 0, XD_FLAG_NO_KKCC }, + { XD_DOC_STRING, offsetof (Lisp_Subr, doc), 0, { 0 }, XD_FLAG_NO_KKCC }, { XD_END } }; Index: src/events.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/events.c,v retrieving revision 1.64 diff -d -u -r1.64 events.c --- src/events.c 2005/01/24 23:33:53 1.64 +++ src/events.c 2005/02/01 18:43:08 ＠＠ -189,16 +189,16 ＠＠ }; static const struct memory_description event_data_description_1 [] = { - { XD_BLOCK_ARRAY, key_press_event, 1, &key_data_description }, - { XD_BLOCK_ARRAY, button_press_event, 1, &button_data_description }, - { XD_BLOCK_ARRAY, button_release_event, 1, &button_data_description }, - { XD_BLOCK_ARRAY, pointer_motion_event, 1, &motion_data_description }, - { XD_BLOCK_ARRAY, process_event, 1, &process_data_description }, - { XD_BLOCK_ARRAY, timeout_event, 1, &timeout_data_description }, - { XD_BLOCK_ARRAY, magic_event, 1, &magic_data_description }, - { XD_BLOCK_ARRAY, magic_eval_event, 1, &magic_eval_data_description }, - { XD_BLOCK_ARRAY, eval_event, 1, &eval_data_description }, - { XD_BLOCK_ARRAY, misc_user_event, 1, &misc_user_data_description }, + { XD_BLOCK_ARRAY, key_press_event, 1, { &key_data_description } }, + { XD_BLOCK_ARRAY, button_press_event, 1, { &button_data_description } }, + { XD_BLOCK_ARRAY, button_release_event, 1, { &button_data_description } }, + { XD_BLOCK_ARRAY, pointer_motion_event, 1, { &motion_data_description } }, + { XD_BLOCK_ARRAY, process_event, 1, { &process_data_description } }, + { XD_BLOCK_ARRAY, timeout_event, 1, { &timeout_data_description } }, + { XD_BLOCK_ARRAY, magic_event, 1, { &magic_data_description } }, + { XD_BLOCK_ARRAY, magic_eval_event, 1, { &magic_eval_data_description } }, + { XD_BLOCK_ARRAY, eval_event, 1, { &eval_data_description } }, + { XD_BLOCK_ARRAY, misc_user_event, 1, { &misc_user_data_description } }, { XD_END } }; ＠＠ -211,7 +211,7 ＠＠ { XD_LISP_OBJECT, offsetof (struct Lisp_Event, next) }, { XD_LISP_OBJECT, offsetof (struct Lisp_Event, channel) }, { XD_UNION, offsetof (struct Lisp_Event, event), - XD_INDIRECT (0, 0), &event_data_description }, + XD_INDIRECT (0, 0), { &event_data_description } }, { XD_END } }; Index: src/extents.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/extents.c,v retrieving revision 1.55 diff -d -u -r1.55 extents.c --- src/extents.c 2005/01/26 05:11:11 1.55 +++ src/extents.c 2005/02/01 18:43:08 ＠＠ -1029,7 +1029,7 ＠＠ static const struct memory_description gap_array_marker_description_1[] = { { XD_BLOCK_PTR, offsetof (Gap_Array_Marker, next), 1, - &gap_array_marker_description }, + { &gap_array_marker_description } }, { XD_END } }; ＠＠ -1043,11 +1043,11 ＠＠ { XD_INT, offsetof (Gap_Array, offset_past_gap) }, { XD_INT, offsetof (Gap_Array, els_past_gap) }, { XD_BLOCK_PTR, offsetof (Gap_Array, markers), 1, - &gap_array_marker_description, XD_FLAG_NO_KKCC }, + { &gap_array_marker_description }, XD_FLAG_NO_KKCC }, { XD_BLOCK_ARRAY, offsetof (Gap_Array, array), XD_INDIRECT (0, 0), - &lisp_object_description }, + { &lisp_object_description } }, { XD_BLOCK_ARRAY, XD_INDIRECT (1, offsetof (Gap_Array, array)), - XD_INDIRECT (2, 0), &lisp_object_description }, + XD_INDIRECT (2, 0), { &lisp_object_description } }, { XD_END } }; ＠＠ -1060,9 +1060,9 ＠＠ static const struct memory_description extent_list_marker_description_1[] = { { XD_BLOCK_PTR, offsetof (Extent_List_Marker, m), 1, - &gap_array_marker_description }, + { &gap_array_marker_description } }, { XD_BLOCK_PTR, offsetof (Extent_List_Marker, next), 1, - &extent_list_marker_description }, + { &extent_list_marker_description } }, { XD_END } }; ＠＠ -1072,9 +1072,12 ＠＠ }; static const struct memory_description extent_list_description_1[] = { - { XD_BLOCK_PTR, offsetof (Extent_List, start), 1, &lispobj_gap_array_description }, - { XD_BLOCK_PTR, offsetof (Extent_List, end), 1, &lispobj_gap_array_description, XD_FLAG_NO_KKCC }, - { XD_BLOCK_PTR, offsetof (Extent_List, markers), 1, &extent_list_marker_description, XD_FLAG_NO_KKCC }, + { XD_BLOCK_PTR, offsetof (Extent_List, start), 1, + { &lispobj_gap_array_description } }, + { XD_BLOCK_PTR, offsetof (Extent_List, end), 1, + { &lispobj_gap_array_description }, XD_FLAG_NO_KKCC }, + { XD_BLOCK_PTR, offsetof (Extent_List, markers), 1, + { &extent_list_marker_description }, XD_FLAG_NO_KKCC }, { XD_END } }; ＠＠ -1084,7 +1087,8 ＠＠ }; static const struct memory_description stack_of_extents_description_1[] = { - { XD_BLOCK_PTR, offsetof (Stack_Of_Extents, extents), 1, &extent_list_description }, + { XD_BLOCK_PTR, offsetof (Stack_Of_Extents, extents), 1, + { &extent_list_description } }, { XD_END } }; ＠＠ -1095,9 +1099,9 ＠＠ static const struct memory_description extent_info_description [] = { { XD_BLOCK_PTR, offsetof (struct extent_info, extents), 1, - &extent_list_description }, + { &extent_list_description } }, { XD_BLOCK_PTR, offsetof (struct extent_info, soe), 1, - &stack_of_extents_description, XD_FLAG_NO_KKCC }, + { &stack_of_extents_description }, XD_FLAG_NO_KKCC }, { XD_END } }; Index: src/file-coding.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/file-coding.c,v retrieving revision 1.43 diff -d -u -r1.43 file-coding.c --- src/file-coding.c 2005/01/29 09:06:40 1.43 +++ src/file-coding.c 2005/02/01 18:43:09 ＠＠ -106,7 +106,8 ＠＠ static coding_system_type_entry_dynarr *the_coding_system_type_entry_dynarr; static const struct memory_description cste_description_1[] = { - { XD_BLOCK_PTR, offsetof (coding_system_type_entry, meths), 1, &coding_system_methods_description }, + { XD_BLOCK_PTR, offsetof (coding_system_type_entry, meths), 1, + { &coding_system_methods_description } }, { XD_END } }; ＠＠ -171,7 +172,7 ＠＠ = { { XD_BLOCK_PTR, offsetof (struct detector, cats), 1, - &detector_category_dynarr_description }, + { &detector_category_dynarr_description } }, { XD_END } }; ＠＠ -346,13 +347,13 ＠＠ static const struct memory_description coding_system_description[] = { { XD_BLOCK_PTR, offsetof (Lisp_Coding_System, methods), 1, - &coding_system_methods_description }, + { &coding_system_methods_description } }, #define MARKED_SLOT(x) { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, x) }, #define MARKED_SLOT_ARRAY(slot, size) \ { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Coding_System, slot), size }, #include "coding-system-slots.h" { XD_BLOCK_ARRAY, offsetof (Lisp_Coding_System, data), 1, - coding_system_extra_description_map }, + { coding_system_extra_description_map } }, { XD_END } }; ＠＠ -1727,8 +1728,10 ＠＠ extern const struct sized_memory_description undecided_coding_stream_description; static const struct memory_description coding_stream_data_description_1 []= { - { XD_BLOCK_PTR, chain_coding_system, 1, &chain_coding_stream_description}, - { XD_BLOCK_PTR, undecided_coding_system, 1, &undecided_coding_stream_description}, + { XD_BLOCK_PTR, chain_coding_system, 1, + { &chain_coding_stream_description } }, + { XD_BLOCK_PTR, undecided_coding_system, 1, + { &undecided_coding_stream_description } }, { XD_END } }; ＠＠ -1742,7 +1745,7 ＠＠ { XD_LISP_OBJECT, offsetof (struct coding_stream, codesys) }, { XD_LISP_OBJECT, offsetof (struct coding_stream, other_end) }, { XD_UNION, offsetof (struct coding_stream, data), - XD_INDIRECT (0, 0), &coding_stream_data_description }, + XD_INDIRECT (0, 0), { &coding_stream_data_description } }, { XD_END } }; ＠＠ -2330,7 +2333,7 ＠＠ static const struct memory_description chain_coding_system_description[] = { { XD_INT, offsetof (struct chain_coding_system, count) }, { XD_BLOCK_PTR, offsetof (struct chain_coding_system, chain), - XD_INDIRECT (0, 0), &lisp_object_description }, + XD_INDIRECT (0, 0), { &lisp_object_description } }, { XD_LISP_OBJECT, offsetof (struct chain_coding_system, canonicalize_after_coding) }, { XD_END } ＠＠ -2339,7 +2342,7 ＠＠ static const struct memory_description chain_coding_stream_description_1 [] = { { XD_INT, offsetof (struct chain_coding_stream, lstream_count) }, { XD_BLOCK_PTR, offsetof (struct chain_coding_stream, lstreams), - XD_INDIRECT (0, 0), &lisp_object_description }, + XD_INDIRECT (0, 0), { &lisp_object_description } }, { XD_END } }; ＠＠ -3085,7 +3088,7 ＠＠ static const struct memory_description undecided_coding_stream_description_1 [] = { { XD_LISP_OBJECT, offsetof (struct undecided_coding_stream, actual) }, { XD_BLOCK_ARRAY, offsetof (struct undecided_coding_stream, c), - 1, &chain_coding_stream_description }, + 1, { &chain_coding_stream_description } }, { XD_END } }; Index: src/frame.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/frame.c,v retrieving revision 1.66 diff -d -u -r1.66 frame.c --- src/frame.c 2005/01/24 23:33:56 1.66 +++ src/frame.c 2005/02/01 18:43:09 ＠＠ -144,13 +144,13 ＠＠ static const struct memory_description frame_data_description_1 []= { #ifdef HAVE_GTK - { XD_BLOCK_PTR, gtk_console, 1, &gtk_frame_data_description}, + { XD_BLOCK_PTR, gtk_console, 1, { &gtk_frame_data_description} }, #endif #ifdef HAVE_MS_WINDOWS - { XD_BLOCK_PTR, mswindows_console, 1, &mswindows_frame_data_description}, + { XD_BLOCK_PTR, mswindows_console, 1, { &mswindows_frame_data_description} }, #endif #ifdef HAVE_X_WINDOWS - { XD_BLOCK_PTR, x_console, 1, &x_frame_data_description}, + { XD_BLOCK_PTR, x_console, 1, { &x_frame_data_description} }, #endif { XD_END } }; ＠＠ -163,7 +163,7 ＠＠ static const struct memory_description expose_ignore_description_1 [] = { { XD_BLOCK_PTR, offsetof (struct expose_ignore, next), - 1, &expose_ignore_description }, + 1, { &expose_ignore_description } }, { XD_END } }; ＠＠ -173,7 +173,7 ＠＠ }; static const struct memory_description display_line_dynarr_pointer_description_1 []= { - { XD_BLOCK_PTR, 0, 1, &display_line_dynarr_description}, + { XD_BLOCK_PTR, 0, 1, { &display_line_dynarr_description} }, { XD_END } }; ＠＠ -189,9 +189,9 ＠＠ #include "frameslots.h" { XD_BLOCK_PTR, offsetof (struct frame, subwindow_exposures), - 1, &expose_ignore_description }, + 1, { &expose_ignore_description } }, { XD_BLOCK_PTR, offsetof (struct frame, subwindow_exposures_tail), - 1, &expose_ignore_description }, + 1, { &expose_ignore_description } }, #ifdef HAVE_SCROLLBARS { XD_LISP_OBJECT, offsetof (struct frame, sb_vcache) }, ＠＠ -199,14 +199,14 ＠＠ #endif /* HAVE_SCROLLBARS */ { XD_BLOCK_ARRAY, offsetof (struct frame, current_display_lines), - 4, &display_line_dynarr_pointer_description }, + 4, { &display_line_dynarr_pointer_description } }, { XD_BLOCK_ARRAY, offsetof (struct frame, desired_display_lines), - 4, &display_line_dynarr_pointer_description }, + 4, { &display_line_dynarr_pointer_description } }, { XD_BLOCK_PTR, offsetof (struct frame, framemeths), 1, - &console_methods_description }, + { &console_methods_description } }, { XD_UNION, offsetof (struct frame, frame_data), - XD_INDIRECT (0, 0), &frame_data_description }, + XD_INDIRECT (0, 0), { &frame_data_description } }, { XD_END } }; Index: src/glyphs.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/glyphs.c,v retrieving revision 1.50 diff -d -u -r1.50 glyphs.c --- src/glyphs.c 2005/01/28 02:36:25 1.50 +++ src/glyphs.c 2005/02/01 18:43:09 ＠＠ -876,13 +876,13 ＠＠ static const struct memory_description image_instance_data_description_1 [] = { { XD_BLOCK_ARRAY, IMAGE_TEXT, - 1, &text_image_instance_description }, + 1, { &text_image_instance_description } }, { XD_BLOCK_ARRAY, IMAGE_MONO_PIXMAP, - 1, &pixmap_image_instance_description }, + 1, { &pixmap_image_instance_description } }, { XD_BLOCK_ARRAY, IMAGE_COLOR_PIXMAP, - 1, &pixmap_image_instance_description }, + 1, { &pixmap_image_instance_description } }, { XD_BLOCK_ARRAY, IMAGE_WIDGET, - 1, &subwindow_image_instance_description }, + 1, { &subwindow_image_instance_description } }, { XD_END } }; ＠＠ -898,7 +898,7 ＠＠ { XD_LISP_OBJECT, offsetof (Lisp_Image_Instance, parent) }, { XD_LISP_OBJECT, offsetof (Lisp_Image_Instance, instantiator) }, { XD_UNION, offsetof (struct Lisp_Image_Instance, u), - XD_INDIRECT (0, 0), &image_instance_data_description }, + XD_INDIRECT (0, 0), { &image_instance_data_description } }, { XD_END } }; ＠＠ -5264,7 +5264,8 ＠＠ static const struct memory_description iife_description_1[] = { { XD_LISP_OBJECT, offsetof (image_instantiator_format_entry, symbol) }, { XD_LISP_OBJECT, offsetof (image_instantiator_format_entry, device) }, - { XD_BLOCK_PTR, offsetof (image_instantiator_format_entry, meths), 1, &iim_description }, + { XD_BLOCK_PTR, offsetof (image_instantiator_format_entry, meths), 1, + { &iim_description } }, { XD_END } }; ＠＠ -5286,8 +5287,10 ＠＠ static const struct memory_description iim_description_1[] = { { XD_LISP_OBJECT, offsetof (struct image_instantiator_methods, symbol) }, { XD_LISP_OBJECT, offsetof (struct image_instantiator_methods, device) }, - { XD_BLOCK_PTR, offsetof (struct image_instantiator_methods, keywords), 1, &iiked_description }, - { XD_BLOCK_PTR, offsetof (struct image_instantiator_methods, consoles), 1, &cted_description }, + { XD_BLOCK_PTR, offsetof (struct image_instantiator_methods, keywords), 1, + { &iiked_description } }, + { XD_BLOCK_PTR, offsetof (struct image_instantiator_methods, consoles), 1, + { &cted_description } }, { XD_END } }; Index: src/lrecord.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/lrecord.h,v retrieving revision 1.35 diff -d -u -r1.35 lrecord.h --- src/lrecord.h 2005/01/26 10:22:26 1.35 +++ src/lrecord.h 2005/02/01 18:43:09 ＠＠ -505,7 +505,7 ＠＠ ... { XD_INT, offsetof (Lisp_Foo, count) }, { XD_BLOCK_PTR, offsetof (Lisp_Foo, objects), - XD_INDIRECT (0, 0), &lisp_object_description }, + XD_INDIRECT (0, 0), { &lisp_object_description } }, ... }; ＠＠ -560,7 +560,7 ＠＠ const struct memory_description hash_table_description[] = { { XD_ELEMCOUNT, offsetof (Lisp_Hash_Table, size) }, { XD_BLOCK_PTR, offsetof (Lisp_Hash_Table, hentries), XD_INDIRECT (0, 1), - &htentry_description }, + { &htentry_description } }, { XD_LO_LINK, offsetof (Lisp_Hash_Table, next_weak) }, { XD_END } }; ＠＠ -580,7 +580,7 ＠＠ const struct memory_description specifier_description[] = { ... { XD_BLOCK_ARRAY, offset (Lisp_Specifier, data), 1, - specifier_extra_description_map }, + { specifier_extra_description_map } }, ... { XD_END } }; ＠＠ -648,6 +648,18 ＠＠ Pointer to undumpable data. Must be NULL when dumping. + XD_OPAQUE_PTR_CONVERTIBLE + + Pointer to data which is not directly dumpable but can be converted + to a dumpable, opaque external representation. The parameter is + a pointer to an opaque_convert_functions struct. + + XD_OPAQUE_DATA_CONVERTIBLE + + Data which is not directly dumpable but can be converted to a + dumpable, opaque external representation. The parameter is a + pointer to an opaque_convert_functions struct. + XD_BLOCK_PTR Pointer to block of described memory. (This is misnamed: It is NOT ＠＠ -786,9 +798,11 ＠＠ XD_LISP_OBJECT, XD_LO_LINK, XD_OPAQUE_PTR, + XD_OPAQUE_PTR_CONVERTIBLE, + XD_OPAQUE_DATA_CONVERTIBLE, + XD_OPAQUE_DATA_PTR, XD_BLOCK_PTR, XD_BLOCK_ARRAY, - XD_OPAQUE_DATA_PTR, XD_UNION, XD_UNION_DYNAMIC_SIZE, XD_ASCII_STRING, ＠＠ -847,12 +861,21 ＠＠ #endif }; +union memory_contents_description +{ + /* The first element is used by static initializers only. We always read + from one of the other two pointers. */ + const void *write_only; + const struct sized_memory_description *descr; + const struct opaque_convert_functions *funcs; +}; + struct memory_description { enum memory_description_type type; Bytecount offset; EMACS_INT data1; - const struct sized_memory_description *data2; + union memory_contents_description data2; /* Indicates which subsystems process this entry, plus (potentially) other flags that apply to this entry. */ int flags; ＠＠ -864,6 +887,36 ＠＠ const struct memory_description *description; }; + +struct opaque_convert_functions +{ + /* Used by XD_OPAQUE_PTR_CONVERTIBLE and + XD_OPAQUE_DATA_CONVERTIBLE */ + + /* Converter to external representation, for those objects from + external libraries that can't be directly dumped as opaque data + because they contain pointers. This is called at dump time to + convert to an opaque, pointer-less representation. + + This function must put a pointer to the opaque result in *data + and its size in *size. */ + void (*convert)(const void *object, void **data, Bytecount *size); + + /* Post-conversion cleanup. Optional (null if not provided). + + When provided it will be called post-dumping to free any storage + allocated for the conversion results. */ + void (*convert_free)(const void *object, void *data, Bytecount size); + + /* De-conversion. + + At reload time, rebuilds the object from the converted form. + "object" is 0 for the PTR case, return is ignored in the DATA + case. */ + void *(*deconvert)(void *object, void *data, Bytecount size); + +}; + extern const struct sized_memory_description lisp_object_description; #define XD_INDIRECT(val, delta) (-1 - (Bytecount) ((val) | ((delta) << 8))) ＠＠ -873,11 +926,10 ＠＠ #define XD_INDIRECT_DELTA(code) ((-1 - (code)) >> 8) #define XD_DYNARR_DESC(base_type, sub_desc) \ - { XD_BLOCK_PTR, offsetof (base_type, base), XD_INDIRECT(1, 0), sub_desc }, \ + { XD_BLOCK_PTR, offsetof (base_type, base), XD_INDIRECT(1, 0), {sub_desc} },\ { XD_INT, offsetof (base_type, cur) }, \ { XD_INT_RESET, offsetof (base_type, max), XD_INDIRECT(1, 0) } \ - /* DEFINE_LRECORD_IMPLEMENTATION is for objects with constant size. DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION is for objects whose size varies. */ ＠＠ -1605,7 +1657,7 ＠＠ EMACS_INT variant = lispdesc_indirect_count (desc1->data1, desc, data); desc1 = - lispdesc_indirect_description (data, desc1->data2)->description; + lispdesc_indirect_description (data, desc1->data2.descr)->description; for (count = 0; desc1[count].type != XD_END; count++) { Index: src/lstream.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/lstream.c,v retrieving revision 1.32 diff -d -u -r1.32 lstream.c --- src/lstream.c 2005/01/24 23:34:02 1.32 +++ src/lstream.c 2005/02/01 18:43:09 ＠＠ -135,9 +135,9 ＠＠ static const struct memory_description lstream_description[] = { { XD_BLOCK_PTR, offsetof (Lstream, imp), 1, - &lstream_implementation_description }, + { &lstream_implementation_description } }, { XD_BLOCK_ARRAY, offsetof (Lstream, data), 1, - lstream_extra_description_map }, + { lstream_extra_description_map } }, { XD_END } }; Index: src/marker.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/marker.c,v retrieving revision 1.15 diff -d -u -r1.15 marker.c --- src/marker.c 2005/01/26 10:22:26 1.15 +++ src/marker.c 2005/02/01 18:43:09 ＠＠ -98,8 +98,8 ＠＠ } static const struct memory_description marker_description[] = { - { XD_LISP_OBJECT, offsetof (Lisp_Marker, next), 0, 0, XD_FLAG_NO_KKCC }, - { XD_LISP_OBJECT, offsetof (Lisp_Marker, prev), 0, 0, XD_FLAG_NO_KKCC }, + { XD_LISP_OBJECT, offsetof (Lisp_Marker, next), 0, { 0 }, XD_FLAG_NO_KKCC }, + { XD_LISP_OBJECT, offsetof (Lisp_Marker, prev), 0, { 0 }, XD_FLAG_NO_KKCC }, { XD_LISP_OBJECT, offsetof (Lisp_Marker, buffer) }, { XD_END } }; Index: src/mule-charset.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/mule-charset.c,v retrieving revision 1.40 diff -d -u -r1.40 mule-charset.c --- src/mule-charset.c 2004/11/04 23:06:42 1.40 +++ src/mule-charset.c 2005/02/01 18:43:09 ＠＠ -173,9 +173,9 ＠＠ { XD_LISP_OBJECT, offsetof (Lisp_Charset, reverse_direction_charset) }, { XD_LISP_OBJECT, offsetof (Lisp_Charset, ccl_program) }, { XD_UNION, offsetof (Lisp_Charset, to_unicode_table), - XD_INDIRECT (0, 0), &to_unicode_description }, + XD_INDIRECT (0, 0), { &to_unicode_description } }, { XD_UNION, offsetof (Lisp_Charset, from_unicode_table), - XD_INDIRECT (1, 0), &from_unicode_description }, + XD_INDIRECT (1, 0), { &from_unicode_description } }, { XD_END } }; Index: src/mule-coding.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/mule-coding.c,v retrieving revision 1.33 diff -d -u -r1.33 mule-coding.c --- src/mule-coding.c 2005/01/24 23:34:04 1.33 +++ src/mule-coding.c 2005/02/01 18:43:09 ＠＠ -953,9 +953,9 ＠＠ { XD_LISP_OBJECT_ARRAY, offsetof (struct iso2022_coding_system, initial_charset), 4 }, { XD_BLOCK_PTR, offsetof (struct iso2022_coding_system, input_conv), - 1, &ccsd_description }, + 1, { &ccsd_description } }, { XD_BLOCK_PTR, offsetof (struct iso2022_coding_system, output_conv), - 1, &ccsd_description }, + 1, { &ccsd_description } }, { XD_END } }; Index: src/number.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/number.c,v retrieving revision 1.13 diff -d -u -r1.13 number.c --- src/number.c 2005/01/24 23:34:04 1.13 +++ src/number.c 2005/02/01 18:43:09 ＠＠ -64,12 +64,43 ＠＠ return bignum_hashcode (XBIGNUM_DATA (obj)); } +static void +bignum_convert (const void *object, void **data, Bytecount *size) +{ + CIbyte *bstr = bignum_to_string (*(bignum *)object, 10); + *data = bstr; + *size = strlen(bstr)+1; +} + +static void +bignum_convfree (const void * UNUSED (object), void *data, + Bytecount UNUSED (size)) +{ + xfree (data, void *); +} + +static void * +bignum_deconvert (void *object, void *data, Bytecount UNUSED (size)) +{ + bignum *b = (bignum *) object; + bignum_init(*b); + bignum_set_string(*b, (const char *) data, 10); + return object; +} + +static const struct opaque_convert_functions bignum_opc = { + bignum_convert, + bignum_convfree, + bignum_deconvert +}; + static const struct memory_description bignum_description[] = { - { XD_OPAQUE_PTR, offsetof (Lisp_Bignum, data) }, + { XD_OPAQUE_DATA_CONVERTIBLE, offsetof (Lisp_Bignum, data), + 0, { &bignum_opc }, XD_FLAG_NO_KKCC }, { XD_END } }; -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("bignum", bignum, 0, 0, bignum_print, +DEFINE_BASIC_LRECORD_IMPLEMENTATION ("bignum", bignum, 1, 0, bignum_print, 0, bignum_equal, bignum_hash, bignum_description, Lisp_Bignum); ＠＠ -770,13 +801,8 ＠＠ #ifdef HAVE_BIGFLOAT #ifdef HAVE_BIGNUM - /* Uncomment the next two lines and remove the line below them when dumping - bignums becomes possible. */ - /* Vbigfloat_max_prec = make_bignum (0L); bignum_set_ulong (XBIGNUM_DATA (Vbigfloat_max_prec), ULONG_MAX); - */ - Vbigfloat_max_prec = make_int (EMACS_INT_MAX); #else Vbigfloat_max_prec = make_int (EMACS_INT_MAX); #endif Index: src/objects.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects.c,v retrieving revision 1.26 diff -d -u -r1.26 objects.c --- src/objects.c 2005/01/28 02:58:52 1.26 +++ src/objects.c 2005/02/01 18:43:10 ＠＠ -63,7 +63,7 ＠＠ static const struct memory_description color_instance_data_description_1 []= { #ifdef HAVE_TTY - { XD_BLOCK_PTR, tty_console, 1, &tty_color_instance_data_description}, + { XD_BLOCK_PTR, tty_console, 1, { &tty_color_instance_data_description } }, #endif { XD_END } }; ＠＠ -77,7 +77,7 ＠＠ { XD_LISP_OBJECT, offsetof (Lisp_Color_Instance, name)}, { XD_LISP_OBJECT, offsetof (Lisp_Color_Instance, device)}, { XD_UNION, offsetof (Lisp_Color_Instance, data), - XD_INDIRECT (0, 0), &color_instance_data_description }, + XD_INDIRECT (0, 0), { &color_instance_data_description } }, {XD_END} }; ＠＠ -272,7 +272,7 ＠＠ static const struct memory_description font_instance_data_description_1 []= { #ifdef HAVE_TTY - { XD_BLOCK_PTR, tty_console, 1, &tty_font_instance_data_description}, + { XD_BLOCK_PTR, tty_console, 1, { &tty_font_instance_data_description} }, #endif { XD_END } }; ＠＠ -287,7 +287,7 ＠＠ { XD_LISP_OBJECT, offsetof (Lisp_Font_Instance, truename)}, { XD_LISP_OBJECT, offsetof (Lisp_Font_Instance, device)}, { XD_UNION, offsetof (Lisp_Font_Instance, data), - XD_INDIRECT (0, 0), &font_instance_data_description }, + XD_INDIRECT (0, 0), { &font_instance_data_description } }, { XD_END } }; Index: src/profile.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/profile.c,v retrieving revision 1.23 diff -d -u -r1.23 profile.c --- src/profile.c 2005/01/26 10:09:20 1.23 +++ src/profile.c 2005/02/01 18:43:10 ＠＠ -109,7 +109,7 ＠＠ static const struct memory_description plain_hash_table_description_1[] = { { XD_ELEMCOUNT, offsetof (struct hash_table, size) }, { XD_BLOCK_PTR, offsetof (struct hash_table, harray), XD_INDIRECT (0, 0), - &hentry_description }, + { &hentry_description } }, { XD_END } }; Index: src/rangetab.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/rangetab.c,v retrieving revision 1.21 diff -d -u -r1.21 rangetab.c --- src/rangetab.c 2005/01/26 10:22:28 1.21 +++ src/rangetab.c 2005/02/01 18:43:10 ＠＠ -214,7 +214,8 ＠＠ }; static const struct memory_description range_table_description[] = { - { XD_BLOCK_PTR, offsetof (Lisp_Range_Table, entries), 1, &rted_description }, + { XD_BLOCK_PTR, offsetof (Lisp_Range_Table, entries), 1, + { &rted_description } }, { XD_END } }; Index: src/redisplay.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/redisplay.c,v retrieving revision 1.94 diff -d -u -r1.94 redisplay.c --- src/redisplay.c 2005/01/26 10:33:41 1.94 +++ src/redisplay.c 2005/02/01 18:43:10 ＠＠ -522,7 +522,7 ＠＠ }; static const struct memory_description rune_object_description_1[] = { - { XD_BLOCK_ARRAY, RUNE_DGLYPH, 1, &rune_dglyph_description }, + { XD_BLOCK_ARRAY, RUNE_DGLYPH, 1, { &rune_dglyph_description } }, { XD_END } }; ＠＠ -533,7 +533,7 ＠＠ static const struct memory_description rune_description_1[] = { { XD_INT, offsetof (rune, type) }, { XD_UNION, offsetof (rune, object), - XD_INDIRECT (0, 0), &rune_object_description }, + XD_INDIRECT (0, 0), { &rune_object_description } }, { XD_END } }; ＠＠ -554,7 +554,7 ＠＠ static const struct memory_description display_block_description_1[] = { { XD_BLOCK_PTR, offsetof (display_block, runes), - 1, &rune_dynarr_description }, + 1, { &rune_dynarr_description } }, { XD_END } }; ＠＠ -596,11 +596,11 ＠＠ static const struct memory_description display_line_description_1[] = { { XD_BLOCK_PTR, offsetof (display_line, display_blocks), - 1, &display_block_dynarr_description }, + 1, { &display_block_dynarr_description } }, { XD_BLOCK_PTR, offsetof (display_line, left_glyphs), - 1, &glyph_block_dynarr_description }, + 1, { &glyph_block_dynarr_description } }, { XD_BLOCK_PTR, offsetof (display_line, right_glyphs), - 1, &glyph_block_dynarr_description }, + 1, { &glyph_block_dynarr_description } }, { XD_END } }; Index: src/specifier.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/specifier.c,v retrieving revision 1.38 diff -d -u -r1.38 specifier.c --- src/specifier.c 2005/01/26 10:22:28 1.38 +++ src/specifier.c 2005/02/01 18:43:10 ＠＠ -66,7 +66,7 ＠＠ static const struct memory_description ste_description_1[] = { { XD_LISP_OBJECT, offsetof (specifier_type_entry, symbol) }, { XD_BLOCK_PTR, offsetof (specifier_type_entry, meths), 1, - &specifier_methods_description }, + { &specifier_methods_description } }, { XD_END } }; ＠＠ -397,7 +397,7 ＠＠ const struct memory_description specifier_description[] = { { XD_BLOCK_PTR, offsetof (Lisp_Specifier, methods), 1, - &specifier_methods_description }, + { &specifier_methods_description } }, { XD_LO_LINK, offsetof (Lisp_Specifier, next_specifier) }, { XD_LISP_OBJECT, offsetof (Lisp_Specifier, global_specs) }, { XD_LISP_OBJECT, offsetof (Lisp_Specifier, device_specs) }, ＠＠ -405,11 +405,11 ＠＠ { XD_LISP_OBJECT, offsetof (Lisp_Specifier, window_specs) }, { XD_LISP_OBJECT, offsetof (Lisp_Specifier, buffer_specs) }, { XD_BLOCK_PTR, offsetof (Lisp_Specifier, caching), 1, - &specifier_caching_description }, + { &specifier_caching_description } }, { XD_LISP_OBJECT, offsetof (Lisp_Specifier, magic_parent) }, { XD_LISP_OBJECT, offsetof (Lisp_Specifier, fallback) }, { XD_BLOCK_ARRAY, offsetof (Lisp_Specifier, data), 1, - specifier_extra_description_map }, + { specifier_extra_description_map } }, { XD_END } }; Index: src/unicode.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/unicode.c,v retrieving revision 1.24 diff -d -u -r1.24 unicode.c --- src/unicode.c 2005/01/24 23:34:13 1.24 +++ src/unicode.c 2005/02/01 18:43:10 ＠＠ -224,7 +224,7 ＠＠ }; static const struct memory_description to_unicode_level_1_desc_1[] = { - { XD_BLOCK_PTR, 0, 96, &to_unicode_level_0_desc }, + { XD_BLOCK_PTR, 0, 96, { &to_unicode_level_0_desc } }, { XD_END } }; ＠＠ -233,8 +233,8 ＠＠ }; static const struct memory_description to_unicode_description_1[] = { - { XD_BLOCK_PTR, 1, 96, &to_unicode_level_0_desc }, - { XD_BLOCK_PTR, 2, 96, &to_unicode_level_1_desc }, + { XD_BLOCK_PTR, 1, 96, { &to_unicode_level_0_desc } }, + { XD_BLOCK_PTR, 2, 96, { &to_unicode_level_1_desc } }, { XD_END } }; ＠＠ -246,7 +246,7 ＠＠ /* Used only for to_unicode_blank_2 */ static const struct memory_description to_unicode_level_2_desc_1[] = { - { XD_BLOCK_PTR, 0, 96, &to_unicode_level_1_desc }, + { XD_BLOCK_PTR, 0, 96, { &to_unicode_level_1_desc } }, { XD_END } }; ＠＠ -259,7 +259,7 ＠＠ }; static const struct memory_description from_unicode_level_1_desc_1[] = { - { XD_BLOCK_PTR, 0, 256, &from_unicode_level_0_desc }, + { XD_BLOCK_PTR, 0, 256, { &from_unicode_level_0_desc } }, { XD_END } }; ＠＠ -268,7 +268,7 ＠＠ }; static const struct memory_description from_unicode_level_2_desc_1[] = { - { XD_BLOCK_PTR, 0, 256, &from_unicode_level_1_desc }, + { XD_BLOCK_PTR, 0, 256, { &from_unicode_level_1_desc } }, { XD_END } }; ＠＠ -277,7 +277,7 ＠＠ }; static const struct memory_description from_unicode_level_3_desc_1[] = { - { XD_BLOCK_PTR, 0, 256, &from_unicode_level_2_desc }, + { XD_BLOCK_PTR, 0, 256, { &from_unicode_level_2_desc } }, { XD_END } }; ＠＠ -286,10 +286,10 ＠＠ }; static const struct memory_description from_unicode_description_1[] = { - { XD_BLOCK_PTR, 1, 256, &from_unicode_level_0_desc }, - { XD_BLOCK_PTR, 2, 256, &from_unicode_level_1_desc }, - { XD_BLOCK_PTR, 3, 256, &from_unicode_level_2_desc }, - { XD_BLOCK_PTR, 4, 256, &from_unicode_level_3_desc }, + { XD_BLOCK_PTR, 1, 256, { &from_unicode_level_0_desc } }, + { XD_BLOCK_PTR, 2, 256, { &from_unicode_level_1_desc } }, + { XD_BLOCK_PTR, 3, 256, { &from_unicode_level_2_desc } }, + { XD_BLOCK_PTR, 4, 256, { &from_unicode_level_3_desc } }, { XD_END } }; ＠＠ -301,7 +301,7 ＠＠ /* Used only for from_unicode_blank_4 */ static const struct memory_description from_unicode_level_4_desc_1[] = { - { XD_BLOCK_PTR, 0, 256, &from_unicode_level_3_desc }, + { XD_BLOCK_PTR, 0, 256, { &from_unicode_level_3_desc } }, { XD_END } }; Index: src/window.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/window.c,v retrieving revision 1.82 diff -d -u -r1.82 window.c --- src/window.c 2005/01/24 23:34:13 1.82 +++ src/window.c 2005/02/01 18:43:11 ＠＠ -171,7 +171,7 ＠＠ static const struct memory_description face_cachel_description_1[] = { { XD_BLOCK_PTR, offsetof (face_cachel, merged_faces), - 1, &int_dynarr_description }, + 1, { &int_dynarr_description } }, { XD_LISP_OBJECT, offsetof (face_cachel, face) }, { XD_LISP_OBJECT, offsetof (face_cachel, foreground) }, { XD_LISP_OBJECT, offsetof (face_cachel, background) }, ＠＠ -242,11 +242,11 ＠＠ #include "winslots.h" { XD_BLOCK_PTR, offsetof (struct window, face_cachels), - 1, &face_cachel_dynarr_description }, + 1, { &face_cachel_dynarr_description } }, { XD_BLOCK_PTR, offsetof (struct window, glyph_cachels), - 1, &glyph_cachel_dynarr_description }, + 1, { &glyph_cachel_dynarr_description } }, { XD_BLOCK_PTR, offsetof (struct window, line_start_cache), - 1, &line_start_cache_dynarr_description }, + 1, { &line_start_cache_dynarr_description } }, { XD_END } }; ＠＠ -423,9 +423,9 ＠＠ { XD_LISP_OBJECT, offsetof (struct window_mirror, vchild) }, { XD_BLOCK_PTR, offsetof (struct window_mirror, current_display_lines), - 1, &display_line_dynarr_description }, + 1, { &display_line_dynarr_description } }, { XD_BLOCK_PTR, offsetof (struct window_mirror, desired_display_lines), - 1, &display_line_dynarr_description }, + 1, { &display_line_dynarr_description } }, { XD_LISP_OBJECT, offsetof (struct window_mirror, buffer) }, -- Jerry James http://www.ittc.ku.edu/~james/

2 participants
2 comments

[COMMIT] Fix autoload problems in package smoketest 20 years, 3 months

Ben Wing

NOTE: This patch has been committed. Mats, please try this on your smoketest and let me know. ChangeLog addition: 2005-02-03 Ben Wing <ben(a)xemacs.org> * XEmacs.rules: * XEmacs.rules (XEMACS_BATCH_PREPARE_FOR_TEXINFO): * XEmacs.rules (FORMAT_INFO_USING_XEMACS_ARGS): * XEmacs.rules (FORMAT_INFO_USING_XEMACS): * XEmacs.rules (FORMAT_MULE_INFO_USING_XEMACS): * XEmacs.rules (BOOT_XEMACS): * XEmacs.rules (elcclean): * XEmacs.rules ($(AUTOLOAD_PATH)/auto-autoloads.el): * XEmacs.rules ($(AUTOLOAD_PATH)/custom-defines.el): * XEmacs.rules ($(AUTOLOAD_PATH)/custom-load.el): * XEmacs.rules (package-info): * XEmacs.rules (setup-info): Rearrange things so that we forcibly disable all interactions with any external package references compiled into XEmacs, and turn off all autoloads at startup, then manually set up a clean load-path pointing to what we need, and load the autoloads. This ensures that we *really* have no dependency on any external packages and that we always have a known environment in which we work. #### A few places still seem to depend on having external packages. It should be easy to remove them but I don't understand the code in question (for building package-info, setup-info). packages source patch: Diff command: bash -ci "cvs-diff --show-c-function -no-changelog " Files affected: XEmacs.rules Index: XEmacs.rules =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/XEmacs.rules,v retrieving revision 1.53 diff -u -p -r1.53 XEmacs.rules --- XEmacs.rules 2004/12/07 01:58:38 1.53 +++ XEmacs.rules 2005/02/03 08:34:17 ＠＠ -1,6 +1,6 ＠＠ # Common Makefile material for package Makefiles # Copyright (C) 1997 Free Software Foundation Inc. -# Copyright (C) 2002, 2003 Ben Wing. +# Copyright (C) 2002, 2003, 2005 Ben Wing. # This file is part of XEmacs. ＠＠ -154,6 +154,22 ＠＠ STAGING:= $(NONMULE_INSTALLED_PACKAGES_R endif endif +# We should strive to use XEMACS_BATCH_CLEAN as much as possible, so we have +# no possible contamination from outside packages. We should rewrite the +# others to load the appropriate autoloads from our own built package tree. + +ifeq ($(BUILD_WITHOUT_MULE),t) +LISP_DIRECTORIES= (list lisp-directory) +else +LISP_DIRECTORIES= (list (expand-file-name "mule" lisp-directory) lisp-directory) +endif +XEMACS_BATCH_CLEAN = $(XEMACS) -no-autoloads $(BATCH) -eval '(setq load-path $(LISP_DIRECTORIES))' +# The following works more or less the same and with less fuss, but only in +# 21.5 and above +# XEMACS_BATCH_CLEAN = $(XEMACS) -no-autoloads $(BATCH) -no-packages +XEMACS_BATCH_DIRTY = $(XEMACS) $(BATCH) +LOAD_AUTOLOADS= -eval '(packages-load-package-auto-autoloads load-path)' + ##################################### # Handle docs # ##################################### ＠＠ -259,18 +275,19 ＠＠ endif html: $(HTML_DEP) -FORMAT_INFO_USING_XEMACS_NO_SAVE_ARGS = -eval '(setq load-path (append (list "$(XEMACS_PACKAGES_BASE)/xemacs-packages/texinfo" "$(XEMACS_PACKAGES_BASE)/xemacs-packages/text-modes" "$(XEMACS_PACKAGES_BASE)/xemacs-packages/xemacs-base") load-path))' -l informat -l texinfmt -f texinfo-format-buffer +XEMACS_BATCH_PREPARE_FOR_TEXINFO = $(XEMACS_BATCH_CLEAN) -eval '(setq load-path (append (list "$(XEMACS_PACKAGES_BASE)/xemacs-packages/texinfo" "$(XEMACS_PACKAGES_BASE)/xemacs-packages/text-modes" "$(XEMACS_PACKAGES_BASE)/xemacs-packages/xemacs-base") load-path))' $(LOAD_AUTOLOADS) -FORMAT_INFO_USING_XEMACS_ARGS = $(FORMAT_INFO_USING_XEMACS_NO_SAVE_ARGS) -f save-buffer +FORMAT_INFO_USING_XEMACS_ARGS = -l informat -l texinfmt -f texinfo-format-buffer FORMAT_INFO_USING_XEMACS = \ - $(XEMACS) $(BATCH) -insert $< $(FORMAT_INFO_USING_XEMACS_ARGS) + $(XEMACS_BATCH_PREPARE_FOR_TEXINFO) -insert $< \ + $(FORMAT_INFO_USING_XEMACS_ARGS) -f save-buffer FORMAT_MULE_INFO_USING_XEMACS = \ - $(XEMACS) $(BATCH) -insert $< \ + $(XEMACS_BATCH_PREPARE_FOR_TEXINFO) -insert $< \ -eval '(unless (featurep (quote mule)) (kill-emacs 0))' \ -eval '(cd "$(<D)")' \ - $(FORMAT_INFO_USING_XEMACS_NO_SAVE_ARGS) \ + $(FORMAT_INFO_USING_XEMACS_ARGS) \ -eval '(setq file-coding-system (quote iso-2022-7))' \ -eval '(save-buffer 0)' ＠＠ -364,7 +381,7 ＠＠ PACKAGE_STAGING = $(STAGING) endif # Behaves like an XEmacs with the required packages set up -BOOT_XEMACS= $(XEMACS) -no-autoloads $(BATCH) -l $(PACKAGE_COMPILE) -- $(REQUIRES) -- $(PRELOADS) +BOOT_XEMACS= $(XEMACS_BATCH_CLEAN) -l $(PACKAGE_COMPILE) -- $(REQUIRES) -- $(PRELOADS) %.elc: %.el $(BOOT_XEMACS) -f batch-byte-compile $< ＠＠ -433,7 +450,7 ＠＠ extraclean: distclean # This is less of an issue now that we ignore out-of-date .elc files. --ben elcclean: - $(XEMACS) $(BATCH) -l $(PACKAGE_CLEAN) + $(XEMACS_BATCH_CLEAN) -l $(PACKAGE_CLEAN) GENERATED_ELC_DEPENDENCIES = $(ELCS:.elc=.el) $(ELCS_1:.elc=.el) ＠＠ -446,14 +463,14 ＠＠ $(AUTOLOAD_PATH)/auto-autoloads.el :: $( ifeq ($(XEMACS_21_5),t) $(AUTOLOAD_PATH)/auto-autoloads.el :: $(GENERATED_ELC_DEPENDENCIES) - $(XEMACS) $(BATCH) -no-autoloads \ + $(XEMACS_BATCH_CLEAN) $(LOAD_AUTOLOADS) \ -l autoload -f batch-update-directory-autoloads \ $(PACKAGE) $(AUTOLOAD_PATH) # The equivalent of `touch' is done automatically ＠rm -f $(AUTOLOAD_PATH)/auto-autoloads.el~ $(AUTOLOAD_PATH)/custom-defines.el : $(GENERATED_ELC_DEPENDENCIES) - $(XEMACS) $(BATCH) -no-autoloads \ + $(XEMACS_BATCH_CLEAN) $(LOAD_AUTOLOADS) \ -l autoload -f batch-update-directory-custom-defines \ $(PACKAGE) $(AUTOLOAD_PATH) ＠rm -f $(AUTOLOAD_PATH)/custom-defines.el~ ＠＠ -464,7 +481,7 ＠＠ AUTOLOAD_FILE = (setq generated-autoload \"$(AUTOLOAD_PATH)/auto-autoloads.el\") $(AUTOLOAD_PATH)/auto-autoloads.el :: $(GENERATED_ELC_DEPENDENCIES) - $(XEMACS) $(BATCH) -no-autoloads \ + $(XEMACS_BATCH_CLEAN) $(LOAD_AUTOLOADS) \ -eval "$(AUTOLOAD_PACKAGE_NAME)" \ -eval "$(AUTOLOAD_FILE)" \ -l autoload -f batch-update-autoloads $^ ＠＠ -473,7 +490,7 ＠＠ $(AUTOLOAD_PATH)/auto-autoloads.el :: $( endif $(AUTOLOAD_PATH)/custom-load.el : $(GENERATED_ELC_DEPENDENCIES) - $(XEMACS) $(BATCH) -no-autoloads -l cus-dep \ + $(XEMACS_BATCH_CLEAN) $(LOAD_AUTOLOADS) -l cus-dep \ -f Custom-make-dependencies $(AUTOLOAD_PATH) ＠touch $(AUTOLOAD_PATH)/custom-load.el ＠rm -f $(AUTOLOAD_PATH)/custom-load.el~ ＠＠ -493,12 +510,12 ＠＠ endif # Make the $(pkg_tar).gz first, then the $(pkg_tar).bz2 package-info : package-info.in Makefile $(AUTOLOAD_PATH)/_pkg.el \ $(pkg_tar).gz $(pkg_tar).bz2 - $(XEMACS) $(BATCH) \ + $(XEMACS_BATCH_DIRTY) \ # #### See if we can't CLEAN this up -l package-info.elc -f batch-update-package-info \ '$(VERSION)' $(PKG_TAR_GZ) \ '$(REQUIRES)' \ '$(AUTHOR_VERSION)' '$(MAINTAINER)' '$(CATEGORY)' - $(XEMACS) $(BATCH) \ + $(XEMACS_BATCH_DIRTY) \ # #### See if we can't CLEAN this up -l ../../hack-package-index.el -f batch-hack-package-index \ $(PACKAGE) package-info $(PACKAGE_INFO) $(CATEGORY) ＠＠ -556,8 +573,8 ＠＠ ifneq ($(PACKAGE_SUPPRESS),) ＠echo ")" >> $(AUTOLOAD_PATH)/_pkg.el endif -setup-info: - $(XEMACS) $(BATCH) -l $(PACKAGE_NET_PACKAGES) \ +setup-info: # #### See if we can't CLEAN this up + $(XEMACS_BATCH_DIRTY) -l $(PACKAGE_NET_PACKAGES) \ -l $(PACKAGE_INFO) \ -f package-net-packages-batch-convert-index-to-ini $(PACKAGE_STAGING) $(CATEGORY)

2 participants
1 comments

Re: [PATCH] Time to consider pending-del default 20 years, 3 months

Aidan Kehoe

Ar an chéad lá de mí Feabhra, scríobh Steven E. Harris: > Do you map a key for delete-region, then, or maybe use kill-region > (mapped to C-w here) instead? Personally, I use kill-region. But I think defaulting to pending-delete is the right thing--it is _much_ more compatible with peoples’ expectations when they come from other apps. -- “Ah come on now Ted, a Volkswagen with a mind of its own, driving all over the place and going mad, if that’s not scary I don’t know what is.”

1 participants
0 comments

[COMMIT] Update regexp-opt 20 years, 3 months

Ben Wing

NOTE: This patch has been committed.

1 participants
0 comments

[COMMIT] behavior ws #5: paragraphs.el sync to 21.3 20 years, 3 months

Ben Wing

NOTE: This patch has been committed. Last patch of the behavior ws. This one depends on the presence of easy-mmode in core, i.e. it depends on behavior patch #4. lisp/ChangeLog addition: 2005-02-03 Ben Wing <ben(a)xemacs.org> * paragraphs.el: * paragraphs.el (paragraphs): New. * paragraphs.el (use-hard-newlines): Removed. * paragraphs.el (paragraph-start): * paragraphs.el (paragraph-separate): * paragraphs.el (sentence-end-double-space): New. * paragraphs.el (sentence-end-without-period): New. * paragraphs.el (sentence-end): * paragraphs.el (forward-paragraph): * paragraphs.el (backward-paragraph): * paragraphs.el (mark-paragraph): * paragraphs.el (forward-sentence): * paragraphs.el (mark-end-of-sentence): * paragraphs.el (transpose-sentences): Sync to 21.3. Depends on easy-mmode in core. behavior source patch: Diff command: bash -ci "cvs-diff --show-c-function -no-changelog " Files affected: lisp/paragraphs.el Index: lisp/paragraphs.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/paragraphs.el,v retrieving revision 1.7 diff -u -p -r1.7 paragraphs.el --- lisp/paragraphs.el 2001/12/05 04:09:25 1.7 +++ lisp/paragraphs.el 2005/02/03 07:14:25 ＠＠ -1,7 +1,7 ＠＠ -;;; paragraphs.el --- paragraph and sentence parsing. +;;; paragraphs.el --- paragraph and sentence parsing -;; Copyright (C) 1985, 86, 87, 91, 94, 95, 97, 2001 -;; Free Software Foundation, Inc. +;; Copyright (C) 1985, 86, 87, 91, 94, 95, 96, 1997, 1999, 2000, 2001 +;; Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: wp, dumped ＠＠ -23,7 +23,7 ＠＠ ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ;; 02111-1307, USA. -;;; Synched up with: FSF 19.34. +;;; Synched up with: FSF 21.3. ;;; Commentary: ＠＠ -37,19 +37,11 ＠＠ ;;; Code: -(defvar use-hard-newlines nil - "Non-nil means to distinguish hard and soft newlines. -When this is non-nil, the functions `newline' and `open-line' add the -text-property `hard' to newlines that they insert. Also, a line is -only considered as a candidate to match `paragraph-start' or -`paragraph-separate' if it follows a hard newline. Newlines not -marked hard are called \"soft\", and are always internal to -paragraphs. The fill functions always insert soft newlines. - -Each buffer has its own value of this variable.") -(make-variable-buffer-local 'use-hard-newlines) +(defgroup paragraphs nil + "Paragraph and sentence parsing." +:group 'editing) -(defun use-hard-newlines (&optional arg insert) +(define-minor-mode use-hard-newlines "Minor mode to distinguish hard and soft newlines. When active, the functions `newline' and `open-line' add the text-property `hard' to newlines that they insert, and a line is ＠＠ -58,25 +50,22 ＠＠ only considered as a candidate to match Prefix argument says to turn mode on if positive, off if negative. When the mode is turned on, if there are newlines in the buffer but no hard -newlines, ask the user whether to mark as hard any newlines preceding a +newlines, ask the user whether to mark as hard any newlines preceeding a `paragraph-start' line. From a program, second arg INSERT specifies whether to do this; it can be `never' to change nothing, t or `always' to force -marking, `guess' to try to do the right thing with no questions, nil +marking, `guess' to try to do the right thing with no questions, nil or anything else to ask the user. Newlines not marked hard are called \"soft\", and are always internal to paragraphs. The fill functions insert and delete only soft newlines." - (interactive (list current-prefix-arg nil)) - (if (or (<= (prefix-numeric-value arg) 0) - (and use-hard-newlines (null arg))) - ;; Turn mode off - (setq use-hard-newlines nil) +:group 'paragraphs +:extra-args (insert) + (when use-hard-newlines ;; Turn mode on ;; Intuit hard newlines -- ;; mark as hard any newlines preceding a paragraph-start line. (if (or (eq insert t) (eq insert 'always) (and (not (eq 'never insert)) - (not use-hard-newlines) (not (text-property-any (point-min) (point-max) 'hard t)) (save-excursion (goto-char (point-min)) ＠＠ -88,19 +77,16 ＠＠ to paragraphs. The fill functions inser (while (search-forward "\n" nil t) (let ((pos (point))) (move-to-left-margin) - (if (looking-at paragraph-start) - (progn - (set-hard-newline-properties (1- pos) pos) - ;; If paragraph-separate, newline after it is hard too. - (if (looking-at paragraph-separate) - (progn - (end-of-line) - (if (not (eobp)) - (set-hard-newline-properties - (point) (1+ (point)))))))))))) - (setq use-hard-newlines t))) + (when (looking-at paragraph-start) + (set-hard-newline-properties (1- pos) pos)) + ;; If paragraph-separate, newline after it is hard too. + (when (looking-at paragraph-separate) + (set-hard-newline-properties (1- pos) pos) + (end-of-line) + (unless (eobp) + (set-hard-newline-properties (point) (1+ (point))))))))))) -(defconst paragraph-start "[ \t\n\f]" "\ +(defcustom paragraph-start "\f\\|[ \t]*$" "\ *Regexp for beginning of a line that starts OR separates paragraphs. This regexp should match lines that separate paragraphs and should also match lines that start a paragraph ＠＠ -115,7 +101,9 ＠＠ The variable `paragraph-separate' specif lines that start paragraphs from lines that separate them. If the variable `use-hard-newlines' is non-nil, then only lines following a -hard newline are considered to match.") +hard newline are considered to match." +:group 'paragraphs +:type 'regexp) ;; paragraph-start requires a hard newline, but paragraph-separate does not: ;; It is assumed that paragraph-separate is distinctive enough to be believed ＠＠ -123,8 +111,8 ＠＠ hard newline are considered to match.") ;; something very minimal, even including "." (which makes every hard newline ;; start a new paragraph). -(defconst paragraph-separate "[ \t\f]*$" "\ -*Regexp for beginning of a line that separates paragraphs. +(defcustom paragraph-separate "[ \t\f]*$" + "*Regexp for beginning of a line that separates paragraphs. If you change this, you may have to change `paragraph-start' also. A line matching this is not part of any paragraph. ＠＠ -132,34 +120,78 ＠＠ A line matching this is not part of any This is matched against the text at the left margin, which is not necessarily the beginning of the line, so it should not use \"^\" as an anchor. This ensures that the paragraph functions will work equally within a region of -text indented by a margin setting.") - -(defconst sentence-end "[.?!][]\"')}]*\$$\\| $\\|\t\\| \$[ \t\n]*" "\ -*Regexp describing the end of a sentence. +text indented by a margin setting." +:group 'paragraphs +:type 'regexp) + +(defcustom sentence-end-double-space t + "*Non-nil means a single space does not end a sentence. +This is relevant for filling. See also `sentence-end-without-period' +and `colon-double-space'. + +This variable applies only to filling, not motion commands. To +change the behavior of motion commands, see `sentence-end'. + +If you change this, you should also change `sentence-end'. See Info +node `Sentences'." +:type 'boolean +:group 'fill) + +(defcustom sentence-end-without-period nil + "*Non-nil means a sentence will end without a period. +For example, a sentence in Thai text ends with double space but +without a period." +:type 'boolean +:group 'fill) + +(defcustom sentence-end + (purecopy + ;; This is a bit stupid since it's not auto-updated when the + ;; other variables are changes, but it's still useful info. + (concat (if sentence-end-without-period "\\w \\|") + "[.?!$B!#!%!)!*$A!##.#?#!$(0!$!%!)!*$(G!$!%!)!*(B][]\"')}]*" + (if sentence-end-double-space + "\$$\\| $\\|\t\\| \$" "\$$\\|[\t ]\$") + "[ \t\n]*")) + "*Regexp describing the end of a sentence. +The value includes the whitespace following the sentence. All paragraph boundaries also end sentences, regardless. -In order to be recognized as the end of a sentence, the ending period, -question mark, or exclamation point must be followed by two spaces, -unless it's inside some sort of quotes or parenthesis.") - -(defconst page-delimiter "^\014" "\ -*Regexp describing line-beginnings that separate pages.") - -(defvar paragraph-ignore-fill-prefix nil "\ -Non-nil means the paragraph commands are not affected by `fill-prefix'. -This is desirable in modes where blank lines are the paragraph delimiters.") +The default value specifies that in order to be recognized as the end +of a sentence, the ending period, question mark, or exclamation point +must be followed by two spaces, unless it's inside some sort of quotes +or parenthesis. + +See also the variable `sentence-end-double-space', the variable +`sentence-end-without-period' and Info node `Sentences'." +:group 'paragraphs +:type 'regexp) + +(defcustom page-delimiter "^\014" + "*Regexp describing line-beginnings that separate pages." +:group 'paragraphs +:type 'regexp) + +(defcustom paragraph-ignore-fill-prefix nil + "*Non-nil means the paragraph commands are not affected by `fill-prefix'. +This is desirable in modes where blank lines are the paragraph delimiters." +:group 'paragraphs +:type 'boolean) (defun forward-paragraph (&optional arg) "Move forward to end of paragraph. -With arg N, do it N times; negative arg -N means move backward N paragraphs. +With argument ARG, do it ARG times; +a negative argument ARG = -N means move backward N paragraphs. A line which `paragraph-start' matches either separates paragraphs \(if `paragraph-separate' matches it also) or is the first line of a paragraph. A paragraph end is the beginning of a line which is not part of the paragraph -to which the end of the previous line belongs, or the end of the buffer." +to which the end of the previous line belongs, or the end of the buffer. +Returns the count of paragraphs left to move." (interactive "_p") ; XEmacs (or arg (setq arg 1)) - (let* ((fill-prefix-regexp + (let* ((opoint (point)) + (fill-prefix-regexp (and fill-prefix (not (equal fill-prefix "")) (not paragraph-ignore-fill-prefix) (regexp-quote fill-prefix))) ＠＠ -168,70 +200,74 ＠＠ to which the end of the previous line be ;; starting at the left-margin. This allows paragraph commands to ;; work normally with indented text. ;; This hack will not find problem cases like "whatever\\|^something". - (paragraph-start (if (and (not (equal "" paragraph-start)) - (equal ?^ (aref paragraph-start 0))) - (substring paragraph-start 1) - paragraph-start)) - (paragraph-separate (if (and (not (equal "" paragraph-start)) - (equal ?^ (aref paragraph-separate 0))) - (substring paragraph-separate 1) - paragraph-separate)) - (paragraph-separate + (parstart (if (and (not (equal "" paragraph-start)) + (equal ?^ (aref paragraph-start 0))) + (substring paragraph-start 1) + paragraph-start)) + (parsep (if (and (not (equal "" paragraph-separate)) + (equal ?^ (aref paragraph-separate 0))) + (substring paragraph-separate 1) + paragraph-separate)) + (parsep (if fill-prefix-regexp - (concat paragraph-separate "\\|" + (concat parsep "\\|" fill-prefix-regexp "[ \t]*$") - paragraph-separate)) + parsep)) ;; This is used for searching. - (sp-paragraph-start (concat "^[ \t]*\$" paragraph-start "\$")) - start) + (sp-parstart (concat "^[ \t]*\$?:" parstart "\\|" parsep "\$")) + start found-start) (while (and (< arg 0) (not (bobp))) - (if (and (not (looking-at paragraph-separate)) + (if (and (not (looking-at parsep)) (re-search-backward "^\n" (max (1- (point)) (point-min)) t) - (looking-at paragraph-separate)) - nil + (looking-at parsep)) + (setq arg (1+ arg)) (setq start (point)) ;; Move back over paragraph-separating lines. (backward-char 1) (beginning-of-line) (while (and (not (bobp)) (progn (move-to-left-margin) - (looking-at paragraph-separate))) - (forward-line -1)) + (looking-at parsep))) + (forward-line -1)) (if (bobp) nil + (setq arg (1+ arg)) ;; Go to end of the previous (non-separating) line. (end-of-line) ;; Search back for line that starts or separates paragraphs. (if (if fill-prefix-regexp - ;; There is a fill prefix; it overrides paragraph-start. + ;; There is a fill prefix; it overrides parstart. (let (multiple-lines) (while (and (progn (beginning-of-line) (not (bobp))) (progn (move-to-left-margin) - (not (looking-at paragraph-separate))) + (not (looking-at parsep))) (looking-at fill-prefix-regexp)) - (if (not (= (point) start)) - (setq multiple-lines t)) + (unless (= (point) start) + (setq multiple-lines t)) (forward-line -1)) (move-to-left-margin) - ;; Don't move back over a line before the paragraph - ;; which doesn't start with fill-prefix - ;; unless that is the only line we've moved over. - (and (not (looking-at fill-prefix-regexp)) - multiple-lines - (forward-line 1)) + ;; This deleted code caused a long hanging-indent line + ;; not to be filled together with the following lines. + ;; ;; Don't move back over a line before the paragraph + ;; ;; which doesn't start with fill-prefix + ;; ;; unless that is the only line we've moved over. + ;; (and (not (looking-at fill-prefix-regexp)) + ;; multiple-lines + ;; (forward-line 1)) (not (bobp))) - (while (and (re-search-backward sp-paragraph-start nil 1) + (while (and (re-search-backward sp-parstart nil 1) + (setq found-start t) ;; Found a candidate, but need to check if it is a - ;; REAL paragraph-start. - (not (bobp)) + ;; REAL parstart. (progn (setq start (point)) (move-to-left-margin) - (not (looking-at paragraph-separate))) - (or (not (looking-at paragraph-start)) - (and use-hard-newlines - (not (get-text-property (1- start) - 'hard))))) + (not (looking-at parsep))) + (not (and (looking-at parstart) + (or (not use-hard-newlines) + (get-text-property (1- start) 'hard) + (bobp))))) + (setq found-start nil) (goto-char start)) - (> (point) (point-min))) + found-start) ;; Found one. (progn ;; Move forward over paragraph separators. ＠＠ -239,7 +275,7 ＠＠ to which the end of the previous line be ;; because we know we moved back over a non-separator. (while (and (not (eobp)) (progn (move-to-left-margin) - (looking-at paragraph-separate))) + (looking-at parsep))) (forward-line 1)) ;; If line before paragraph is just margin, back up to there. (end-of-line 0) ＠＠ -249,38 +285,44 ＠＠ to which the end of the previous line be (if (not (bolp)) (forward-line 1)))) ;; No starter or separator line => use buffer beg. - (goto-char (point-min))))) - (setq arg (1+ arg))) + (goto-char (point-min)))))) + (while (and (> arg 0) (not (eobp))) - ;; Move forward over separator lines, and one more line. - (while (prog1 (and (not (eobp)) - (progn (move-to-left-margin) (not (eobp))) - (looking-at paragraph-separate)) - (forward-line 1))) + ;; Move forward over separator lines... + (while (and (not (eobp)) + (progn (move-to-left-margin) (not (eobp))) + (looking-at parsep)) + (forward-line 1)) + (unless (eobp) (setq arg (1- arg))) + ;; ... and one more line. + (forward-line 1) (if fill-prefix-regexp - ;; There is a fill prefix; it overrides paragraph-start. + ;; There is a fill prefix; it overrides parstart. (while (and (not (eobp)) (progn (move-to-left-margin) (not (eobp))) - (not (looking-at paragraph-separate)) + (not (looking-at parsep)) (looking-at fill-prefix-regexp)) (forward-line 1)) - (while (and (re-search-forward sp-paragraph-start nil 1) + (while (and (re-search-forward sp-parstart nil 1) (progn (setq start (match-beginning 0)) (goto-char start) (not (eobp))) (progn (move-to-left-margin) - (not (looking-at paragraph-separate))) - (or (not (looking-at paragraph-start)) + (not (looking-at parsep))) + (or (not (looking-at parstart)) (and use-hard-newlines (not (get-text-property (1- start) 'hard))))) (forward-char 1)) (if (< (point) (point-max)) - (goto-char start))) - (setq arg (1- arg))))) + (goto-char start)))) + (constrain-to-field nil opoint t) + ;; Return the number of steps that could not be done. + arg)) (defun backward-paragraph (&optional arg) "Move backward to start of paragraph. -With arg N, do it N times; negative arg -N means move forward N paragraphs. +With argument ARG, do it ARG times; +a negative argument ARG = -N means move forward N paragraphs. A paragraph start is the beginning of a line which is a `first-line-of-paragraph' or which is ordinary text and follows a ＠＠ -296,16 +338,29 ＠＠ See `forward-paragraph' for more informa (defun mark-paragraph (&optional arg) "Put point at beginning of this paragraph, mark at end. The paragraph marked is the one that contains point or follows point. -With arg N, puts mark at end of following N paragraphs; -negative arg -N means point is put at end of this paragraph, mark is put -at beginning of this or a previous paragraph." + +With argument ARG, puts mark at end of a following paragraph, so that +the number of paragraphs marked equals ARG. + +If ARG is negative, point is put at end of this paragraph, mark is put +at beginning of this or a previous paragraph. + +If this command is repeated, it marks the next ARG paragraphs after (or +before, if arg is negative) the ones already marked." (interactive "p") (unless arg (setq arg 1)) (when (zerop arg) (error "Cannot mark zero paragraphs")) - (forward-paragraph arg) - (push-mark nil t t) - (backward-paragraph arg)) + (cond ((and (eq last-command this-command) (mark t)) + (set-mark + (save-excursion + (goto-char (mark)) + (forward-paragraph arg) + (point)))) + (t + (forward-paragraph arg) + (push-mark nil t t) + (backward-paragraph arg)))) (defun kill-paragraph (arg) "Kill forward to end of paragraph. ＠＠ -359,18 +414,23 ＠＠ The variable `sentence-end' is a regular sentences. A paragraph boundary also terminates a sentence." (interactive "_p") ; XEmacs (or arg (setq arg 1)) - (while (< arg 0) - (let ((par-beg (save-excursion (start-of-paragraph-text) (point)))) - (if (re-search-backward (concat sentence-end "[^ \t\n]") par-beg t) - (goto-char (1- (match-end 0))) - (goto-char par-beg))) - (setq arg (1+ arg))) - (while (> arg 0) - (let ((par-end (save-excursion (end-of-paragraph-text) (point)))) - (if (re-search-forward sentence-end par-end t) - (skip-chars-backward " \t\n") - (goto-char par-end))) - (setq arg (1- arg)))) + (let ((opoint (point))) + (while (< arg 0) + (let ((pos (point)) + (par-beg (save-excursion (start-of-paragraph-text) (point)))) + (if (and (re-search-backward sentence-end par-beg t) + (or (< (match-end 0) pos) + (re-search-backward sentence-end par-beg t))) + (goto-char (match-end 0)) + (goto-char par-beg))) + (setq arg (1+ arg))) + (while (> arg 0) + (let ((par-end (save-excursion (end-of-paragraph-text) (point)))) + (if (re-search-forward sentence-end par-end t) + (skip-chars-backward " \t\n") + (goto-char par-end))) + (setq arg (1- arg))) + (constrain-to-field nil opoint t))) (defun backward-sentence (&optional arg) "Move backward to start of sentence. With arg, do it arg times. ＠＠ -392,14 +452,18 ＠＠ With arg, repeat, or kill forward to Nth (kill-region (point) (progn (backward-sentence arg) (point)))) (defun mark-end-of-sentence (arg) - "Put mark at end of sentence. Arg works as in `forward-sentence'." + "Put mark at end of sentence. Arg works as in `forward-sentence'. +If this command is repeated, it marks the next ARG sentences after the +ones already marked." (interactive "p") ;; FSF Version: -; (push-mark -; (save-excursion -; (forward-sentence arg) -; (point)) -; nil t)) +; (push-mark +; (save-excursion +; (if (and (eq last-command this-command) (mark t)) +; (goto-char (mark))) +; (forward-sentence arg) +; (point)) +; nil t)) (mark-something 'mark-end-of-sentence 'forward-sentence arg)) (defun mark-end-of-line (arg) ＠＠ -407,10 +471,13 ＠＠ With arg, repeat, or kill forward to Nth (interactive "p") (mark-something 'mark-end-of-line 'end-of-line arg)) - (defun transpose-sentences (arg) "Interchange this (next) and previous sentence." (interactive "*p") (transpose-subr 'forward-sentence arg)) + +;;; Local Variables: +;;; coding: iso-2022-7bit +;;; End: ;;; paragraphs.el ends here

1 participants
0 comments

[COMMIT] behavior ws #4: package-suppress, autoload update/sync, add easy-mmode/regexp-opt to core 20 years, 3 months

Ben Wing

NOTE: This patch has been committed. [Resend ... note that the patch has been committed; see previous posting]

1 participants
0 comments

2025

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

2003

XEmacs-Patches February 2005