January 2005 - XEmacs-Patches - XEmacs Mailing List Archives

[COMMIT] Hash table cleanups, part 1 of 2 20 years, 2 months

Ben Wing

NOTE: This patch has been committed. Part 2 will follow in a moment. src/ChangeLog addition: 2005-01-26 Ben Wing <ben(a)xemacs.org> * emacs-marshals.c: * emacs-marshals.c (initialize_marshaller_storage): * hash.c: * hash.c (string_equal): * hash.c (make_hash_table): * hash.h: * ui-gtk.c (type_already_imported_p): Clean up and generalize creation of string hash tables. * ui-gtk.c (emacs_gtk_boxed_hash): * elhash.h: * gccache-gtk.c (gc_cache_hash): * glyphs-gtk.c (gtk_image_instance_hash): * lrecord.h (struct lrecord_implementation): * marker.c (marker_hash): * objects-gtk.c (gtk_color_instance_hash): * objects-msw.c (mswindows_color_instance_hash): * objects-tty.c (tty_color_instance_hash): * objects-x.c (x_color_instance_hash): * objects.c (color_instance_hash): * objects.c (font_instance_hash): * opaque.c (hash_opaque): * opaque.c (hash_opaque_ptr): * rangetab.c (range_table_entry_hash): * rangetab.c (range_table_hash): * specifier.c (specifier_hash): * specifier.h (struct specifier_methods): * xgccache.c (gc_cache_hash): Use Hashcode rather than unsigned long. symlink source patch: Diff command: bash -ci "cvs-diff --show-c-function -no-changelog " Files affected: src/xgccache.c src/specifier.h src/specifier.c src/rangetab.c src/opaque.c src/objects.c src/objects-x.c src/objects-tty.c src/objects-msw.c src/objects-gtk.c src/marker.c src/lrecord.h src/glyphs-gtk.c src/gccache-gtk.c src/elhash.h src/emacs-marshals.c src/ui-gtk.c src/hash.h src/hash.c Index: src/hash.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/hash.c,v retrieving revision 1.12 diff -u -p -r1.12 hash.c --- src/hash.c 2003/09/30 15:26:50 1.12 +++ src/hash.c 2005/01/26 10:16:08 ＠＠ -1,6 +1,6 ＠＠ /* Hash tables. Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 2003 Ben Wing. + Copyright (C) 2003, 2004 Ben Wing. This file is part of XEmacs. ＠＠ -56,8 +56,19 ＠＠ memory_hash (const void *xv, Bytecount s return h; } -Hashcode -string_hash (const char *xv) +static int +string_equal (const void *st1, const void *st2) +{ + if (!st1) + return st2 ? 0 : 1; + else if (!st2) + return 0; + else + return !strcmp ((const char *) st1, (const char *) st2); +} + +static Hashcode +string_hash (const void *xv) { Hashcode h = 0; unsigned const char *x = (unsigned const char *) xv; ＠＠ -167,7 +178,7 ＠＠ free_hash_table (struct hash_table *hash xfree (hash_table, struct hash_table *); } -struct hash_table* +struct hash_table * make_hash_table (Elemcount size) { struct hash_table *hash_table = xnew_and_zero (struct hash_table); ＠＠ -175,6 +186,12 ＠＠ make_hash_table (Elemcount size) hash_table->harray = xnew_array (hentry, hash_table->size); clrhash (hash_table); return hash_table; +} + +struct hash_table * +make_string_hash_table (Elemcount size) +{ + return make_general_hash_table (size, string_hash, string_equal); } struct hash_table * Index: src/hash.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/hash.h,v retrieving revision 1.9 diff -u -p -r1.9 hash.h --- src/hash.h 2003/02/13 09:57:07 1.9 +++ src/hash.h 2005/01/26 10:16:10 ＠＠ -45,6 +45,8 ＠＠ struct hash_table automatically if the number of entries approaches the size */ struct hash_table *make_hash_table (Elemcount size); +struct hash_table *make_string_hash_table (Elemcount size); + struct hash_table *make_general_hash_table (Elemcount size, hash_table_hash_function hash_function, Index: src/ui-gtk.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/ui-gtk.c,v retrieving revision 1.21 diff -u -p -r1.21 ui-gtk.c --- src/ui-gtk.c 2005/01/24 23:34:13 1.21 +++ src/ui-gtk.c 2005/01/26 10:16:12 ＠＠ -107,18 +107,6 ＠＠ EXFUN (Fgtk_import_type, 1); static struct hash_table *internal_type_hash; static int -type_hash_equal(const void *arg1, const void *arg2) -{ - return ((GtkType) arg1 == (GtkType) arg2); -} - -static unsigned long -type_hash_hash(const void *arg) -{ - return ((unsigned long) arg); -} - -static int type_already_imported_p (GtkType t) { void *retval = NULL; ＠＠ -148,7 +136,7 ＠＠ type_already_imported_p (GtkType t) if (!internal_type_hash) { - internal_type_hash = make_general_hash_table (163, type_hash_hash, type_hash_equal); + internal_type_hash = make_hash_table (163); return (0); } ＠＠ -1128,11 +1116,11 ＠＠ emacs_gtk_boxed_equality (Lisp_Object o1 (data1->object_type == data2->object_type)); } -static unsigned long +static Hashcode emacs_gtk_boxed_hash (Lisp_Object obj, int UNUSED (depth)) { emacs_gtk_boxed_data *data = XGTK_BOXED(obj); - return (HASH2 ((unsigned long)data->object, data->object_type)); + return (HASH2 ((Hashcode) data->object, data->object_type)); } DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("GtkBoxed", emacs_gtk_boxed, Index: src/emacs-marshals.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/emacs-marshals.c,v retrieving revision 1.8 diff -u -p -r1.8 emacs-marshals.c --- src/emacs-marshals.c 2004/05/02 04:06:58 1.8 +++ src/emacs-marshals.c 2005/01/26 10:16:14 ＠＠ -1466,35 +1466,6 ＠＠ emacs_gtk_marshal_STRING__NONE (ffi_actu #include "hash.h" -static int -our_string_eq (const void *st1, const void *st2) -{ - if (!st1) - return st2 ? 0 : 1; - else if (!st2) - return 0; - else - return !strcmp ( (const char *) st1, (const char *) st2); -} - -static unsigned long -our_string_hash (const void *xv) -{ - unsigned int h = 0; - unsigned const char *x = (unsigned const char *) xv; - - if (!x) return 0; - - while (*x) - { - unsigned int g; - h = (h << 4) + *x++; - if ((g = h & 0xf0000000) != 0) - h = (h ^ (g >> 24)) ^ g; - } - - return h; -} static struct hash_table *marshaller_hashtable; ＠＠ -1502,7 +1473,7 ＠＠ static void initialize_marshaller_storag { if (!marshaller_hashtable) { - marshaller_hashtable = make_general_hash_table (100, our_string_hash, our_string_eq); + marshaller_hashtable = make_string_hash_table (100); puthash ("emacs_gtk_marshal_BOOL__OBJECT_INT", (void *) emacs_gtk_marshal_BOOL__OBJECT_INT, marshaller_hashtable); puthash ("emacs_gtk_marshal_BOOL__OBJECT_OBJECT_OBJECT", (void *) emacs_gtk_marshal_BOOL__OBJECT_OBJECT_OBJECT, marshaller_hashtable); puthash ("emacs_gtk_marshal_BOOL__OBJECT_OBJECT", (void *) emacs_gtk_marshal_BOOL__OBJECT_OBJECT, marshaller_hashtable); Index: src/elhash.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/elhash.h,v retrieving revision 1.14 diff -u -p -r1.14 elhash.h --- src/elhash.h 2004/12/06 03:52:04 1.14 +++ src/elhash.h 2005/01/26 10:16:15 ＠＠ -62,7 +62,7 ＠＠ EXFUN (Fremhash, 2); EXFUN (Fclrhash, 1); typedef int (*hash_table_test_function_t) (Lisp_Object obj1, Lisp_Object obj2); -typedef unsigned long (*hash_table_hash_function_t) (Lisp_Object obj); +typedef Hashcode (*hash_table_hash_function_t) (Lisp_Object obj); typedef int (*maphash_function_t) (Lisp_Object key, Lisp_Object value, void* extra_arg); Index: src/gccache-gtk.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/gccache-gtk.c,v retrieving revision 1.6 diff -u -p -r1.6 gccache-gtk.c --- src/gccache-gtk.c 2005/01/24 23:33:57 1.6 +++ src/gccache-gtk.c 2005/01/26 10:16:17 ＠＠ -91,12 +91,12 ＠＠ struct gc_cache { }; #ifdef GCCACHE_HASH -static unsigned long +static Hashcode gc_cache_hash (const void *arg) { const struct gcv_and_mask *gcvm = (const struct gcv_and_mask *) arg; unsigned long *longs = (unsigned long *) &gcvm->gcv; - unsigned long hash = gcvm->mask; + Hashcode hash = gcvm->mask; unsigned int i; /* This could look at the mask and only use the used slots in the hash code. That would win in that we wouldn't have to initialize ＠＠ -104,7 +104,7 ＠＠ gc_cache_hash (const void *arg) the hash function to be as fast as possible; some timings should be done. */ for (i = 0; i < (sizeof (GdkGCValues) / sizeof (unsigned long)); i++) - hash = (hash<<1) ^ *longs++; + hash = (hash << 1) ^ *longs++; return hash; } Index: src/glyphs-gtk.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/glyphs-gtk.c,v retrieving revision 1.29 diff -u -p -r1.29 glyphs-gtk.c --- src/glyphs-gtk.c 2005/01/24 23:33:57 1.29 +++ src/glyphs-gtk.c 2005/01/26 10:16:19 ＠＠ -482,7 +482,7 ＠＠ gtk_image_instance_equal (struct Lisp_Im return 1; } -static unsigned long +static Hashcode gtk_image_instance_hash (struct Lisp_Image_Instance *p, int UNUSED (depth)) { switch (IMAGE_INSTANCE_TYPE (p)) Index: src/lrecord.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/lrecord.h,v retrieving revision 1.34 diff -u -p -r1.34 lrecord.h --- src/lrecord.h 2004/11/04 23:06:40 1.34 +++ src/lrecord.h 2005/01/26 10:16:22 ＠＠ -276,7 +276,7 ＠＠ struct lrecord_implementation hash to the same value in order for hash tables to work properly. This means that `hash' can be NULL only if the `equal' method is also NULL. */ - unsigned long (*hash) (Lisp_Object, int); + Hashcode (*hash) (Lisp_Object, int); /* Data layout description for your object. See long comment below. */ const struct memory_description *description; Index: src/marker.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/marker.c,v retrieving revision 1.14 diff -u -p -r1.14 marker.c --- src/marker.c 2004/09/20 19:19:51 1.14 +++ src/marker.c 2005/01/26 10:16:23 ＠＠ -88,10 +88,10 ＠＠ marker_equal (Lisp_Object obj1, Lisp_Obj !marker1->buffer)); } -static unsigned long +static Hashcode marker_hash (Lisp_Object obj, int UNUSED (depth)) { - unsigned long hash = (unsigned long) XMARKER (obj)->buffer; + Hashcode hash = (Hashcode) XMARKER (obj)->buffer; if (hash) hash = HASH2 (hash, XMARKER (obj)->membpos); return hash; Index: src/objects-gtk.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-gtk.c,v retrieving revision 1.14 diff -u -p -r1.14 objects-gtk.c --- src/objects-gtk.c 2004/09/20 19:19:54 1.14 +++ src/objects-gtk.c 2005/01/26 10:16:25 ＠＠ -178,7 +178,7 ＠＠ gtk_color_instance_equal (struct Lisp_Co COLOR_INSTANCE_GTK_COLOR (c2))); } -static unsigned long +static Hashcode gtk_color_instance_hash (struct Lisp_Color_Instance *c, int UNUSED (depth)) { return (gdk_color_hash (COLOR_INSTANCE_GTK_COLOR (c), NULL)); Index: src/objects-msw.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-msw.c,v retrieving revision 1.45 diff -u -p -r1.45 objects-msw.c --- src/objects-msw.c 2005/01/24 23:34:05 1.45 +++ src/objects-msw.c 2005/01/26 10:16:27 ＠＠ -1390,7 +1390,7 ＠＠ mswindows_color_instance_equal (Lisp_Col COLOR_INSTANCE_MSWINDOWS_COLOR (c2)); } -static unsigned long +static Hashcode mswindows_color_instance_hash (Lisp_Color_Instance *c, int UNUSED (depth)) { return (unsigned long) COLOR_INSTANCE_MSWINDOWS_COLOR (c); Index: src/objects-tty.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-tty.c,v retrieving revision 1.14 diff -u -p -r1.14 objects-tty.c --- src/objects-tty.c 2004/11/04 23:06:45 1.14 +++ src/objects-tty.c 2005/01/26 10:16:29 ＠＠ -213,7 +213,7 ＠＠ tty_color_instance_equal (Lisp_Color_Ins COLOR_INSTANCE_TTY_SYMBOL (c2))); } -static unsigned long +static Hashcode tty_color_instance_hash (Lisp_Color_Instance *c, int UNUSED (depth)) { return LISP_HASH (COLOR_INSTANCE_TTY_SYMBOL (c)); Index: src/objects-x.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-x.c,v retrieving revision 1.26 diff -u -p -r1.26 objects-x.c --- src/objects-x.c 2004/11/04 23:06:45 1.26 +++ src/objects-x.c 2005/01/26 10:16:31 ＠＠ -326,7 +326,7 ＠＠ x_color_instance_equal (Lisp_Color_Insta (color1.blue == color2.blue)); } -static unsigned long +static Hashcode x_color_instance_hash (Lisp_Color_Instance *c, int UNUSED (depth)) { XColor color = COLOR_INSTANCE_X_COLOR (c); Index: src/objects.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects.c,v retrieving revision 1.24 diff -u -p -r1.24 objects.c --- src/objects.c 2005/01/24 23:34:05 1.24 +++ src/objects.c 2005/01/26 10:16:33 ＠＠ -133,13 +133,13 ＠＠ color_instance_equal (Lisp_Object obj1, DEVMETH (XDEVICE (c1->device), color_instance_equal, (c1, c2, depth))); } -static unsigned long +static Hashcode color_instance_hash (Lisp_Object obj, int depth) { Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); struct device *d = DEVICEP (c->device) ? XDEVICE (c->device) : 0; - return HASH2 ((unsigned long) d, + return HASH2 ((Hashcode) d, !d ? LISP_HASH (obj) : DEVMETH_OR_GIVEN (d, color_instance_hash, (c, depth), LISP_HASH (obj))); ＠＠ -334,7 +334,7 ＠＠ font_instance_equal (Lisp_Object obj1, L depth + 1); } -static unsigned long +static Hashcode font_instance_hash (Lisp_Object obj, int depth) { return internal_hash (font_instance_truename_internal Index: src/opaque.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/opaque.c,v retrieving revision 1.18 diff -u -p -r1.18 opaque.c --- src/opaque.c 2004/09/20 19:19:55 1.18 +++ src/opaque.c 2005/01/26 10:16:34 ＠＠ -100,11 +100,11 ＠＠ equal_opaque (Lisp_Object obj1, Lisp_Obj /* This will not work correctly for opaques with subobjects! */ -static unsigned long +static Hashcode hash_opaque (Lisp_Object obj, int UNUSED (depth)) { if (XOPAQUE_SIZE (obj) == sizeof (unsigned long)) - return *((unsigned long *) XOPAQUE_DATA (obj)); + return *((Hashcode *) XOPAQUE_DATA (obj)); else return memory_hash (XOPAQUE_DATA (obj), XOPAQUE_SIZE (obj)); } ＠＠ -141,10 +141,10 ＠＠ equal_opaque_ptr (Lisp_Object obj1, Lisp return (XOPAQUE_PTR (obj1)->ptr == XOPAQUE_PTR (obj2)->ptr); } -static unsigned long +static Hashcode hash_opaque_ptr (Lisp_Object obj, int UNUSED (depth)) { - return (unsigned long) XOPAQUE_PTR (obj)->ptr; + return (Hashcode) XOPAQUE_PTR (obj)->ptr; } static const struct memory_description opaque_ptr_description[] = { Index: src/rangetab.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/rangetab.c,v retrieving revision 1.20 diff -u -p -r1.20 rangetab.c --- src/rangetab.c 2005/01/24 23:34:06 1.20 +++ src/rangetab.c 2005/01/26 10:16:36 ＠＠ -159,19 +159,19 ＠＠ range_table_equal (Lisp_Object obj1, Lis return 1; } -static unsigned long +static Hashcode range_table_entry_hash (struct range_table_entry *rte, int depth) { return HASH3 (rte->first, rte->last, internal_hash (rte->val, depth + 1)); } -static unsigned long +static Hashcode range_table_hash (Lisp_Object obj, int depth) { Lisp_Range_Table *rt = XRANGE_TABLE (obj); int i; int size = Dynarr_length (rt->entries); - unsigned long hash = size; + Hashcode hash = size; /* approach based on internal_array_hash(). */ if (size <= 5) Index: src/specifier.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/specifier.c,v retrieving revision 1.37 diff -u -p -r1.37 specifier.c --- src/specifier.c 2005/01/24 23:34:10 1.37 +++ src/specifier.c 2005/01/26 10:16:38 ＠＠ -337,7 +337,7 ＠＠ specifier_equal (Lisp_Object obj1, Lisp_ return retval; } -static unsigned long +static Hashcode specifier_hash (Lisp_Object obj, int depth) { Lisp_Specifier *s = XSPECIFIER (obj); ＠＠ -347,7 +347,7 ＠＠ specifier_hash (Lisp_Object obj, int dep the most likely places where interesting stuff will be. */ return HASH5 ((HAS_SPECMETH_P (s, hash) ? SPECMETH (s, hash, (obj, depth)) : 0), - (unsigned long) s->methods, + (Hashcode) s->methods, internal_hash (s->global_specs, depth + 1), internal_hash (s->frame_specs, depth + 1), internal_hash (s->buffer_specs, depth + 1)); Index: src/specifier.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/specifier.h,v retrieving revision 1.15 diff -u -p -r1.15 specifier.h --- src/specifier.h 2005/01/24 23:34:10 1.15 +++ src/specifier.h 2005/01/26 10:16:40 ＠＠ -115,7 +115,7 ＠＠ struct specifier_methods If this function is not present, hashing behaves as if it returned zero. */ - unsigned long (*hash_method) (Lisp_Object specifier, int depth); + Hashcode (*hash_method) (Lisp_Object specifier, int depth); /* Validate method: Given an instantiator, verify that it's valid for this specifier type. If not, signal an error. Index: src/xgccache.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/xgccache.c,v retrieving revision 1.9 diff -u -p -r1.9 xgccache.c --- src/xgccache.c 2005/01/24 23:34:14 1.9 +++ src/xgccache.c 2005/01/26 10:16:42 ＠＠ -92,12 +92,12 ＠＠ struct gc_cache { }; #ifdef GCCACHE_HASH -static unsigned long +static Hashcode gc_cache_hash (const void *arg) { const struct gcv_and_mask *gcvm = (const struct gcv_and_mask *) arg; unsigned long *longs = (unsigned long *) &gcvm->gcv; - unsigned long hash = gcvm->mask; + Hashcode hash = gcvm->mask; int i; /* This could look at the mask and only use the used slots in the hash code. That would win in that we wouldn't have to initialize ＠＠ -105,7 +105,7 ＠＠ gc_cache_hash (const void *arg) the hash function to be as fast as possible; some timings should be done. */ for (i = 0; i < (int) (sizeof (XGCValues) / sizeof (unsigned long)); i++) - hash = (hash<<1) ^ *longs++; + hash = (hash << 1) ^ *longs++; return hash; }

2 participants
1 comments

[FOR 21.4?] [COMMIT] Fix some race conditions in redisplay/signal 20 years, 2 months

Ben Wing

NOTE: This patch has been committed. Undoubtedly, such race conditions exist in 21.4. However, I'm not sure what state the code is in, and thus how hard it would be to port this. Maybe someone else who has some time can investigate and see what would be involved in the porting. src/ChangeLog addition: 2005-01-26 Ben Wing <ben(a)xemacs.org> * redisplay.c: * redisplay.c (generate_displayable_area): * redisplay.c (regenerate_window): * redisplay.h: * signal.c: * signal.c (check_quit): Move backtraces to internals manual. Fix some race conditions leading to crashes due to incomplete protection of critical sections. In signal.c, be more aggressive in catching incomplete critical section protection -- we cannot even check for QUIT, *EVER*, in a critical section. symlink source patch: Diff command: bash -ci "cvs-diff --show-c-function -no-changelog " Files affected: src/redisplay.h src/signal.c src/redisplay.c Index: src/redisplay.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/redisplay.c,v retrieving revision 1.93 diff -u -p -r1.93 redisplay.c --- src/redisplay.c 2005/01/24 23:34:08 1.93 +++ src/redisplay.c 2005/01/26 10:31:52 ＠＠ -5285,112 +5285,11 ＠＠ generate_string_display_line (struct win return ret_charcount; } +/* -/* Tricky tricky tricky. generate_displayable_area() can (could) be called reentrantly, and redisplay is not prepared to handle this: +Info on Re-entrancy crashes, with backtraces given: -assert_failed(const char * 0x0129c8c8 `string', int 5328, const char * 0x01274068 `string') line 3620 -Dynarr_verify_mod_1(void * 0x0250f228, const char * 0x0129c8c8 `string', int 5328) line 1256 + 36 bytes -generate_displayable_area(window * 0x02480028, long 38776292, int 0, int 0, int 265, int 169, display_line_dynarr * 0x0250f228, long 0, int 2) line 5328 + 25 bytes -output_gutter(frame * 0x0228ad90, gutter_pos TOP_GUTTER, int 1) line 409 + 69 bytes -redraw_exposed_gutter(frame * 0x0228ad90, gutter_pos TOP_GUTTER, int 8, int 23, int 249, int 127) line 687 + 15 bytes -redraw_exposed_gutters(frame * 0x0228ad90, int 8, int 23, int 249, int 127) line 703 + 29 bytes -mswindows_redraw_exposed_area(frame * 0x0228ad90, int 8, int 23, int 249, int 127) line 862 + 25 bytes -mswindows_handle_paint(frame * 0x0228ad90) line 2176 + 25 bytes -mswindows_wnd_proc(HWND__ * 0x001003e2, unsigned int 15, unsigned int 0, long 0) line 3233 + 45 bytes -intercepted_wnd_proc(HWND__ * 0x001003e2, unsigned int 15, unsigned int 0, long 0) line 2488 -USER32! 77e3a244() -USER32! 77e14730() -USER32! 77e1558a() -NTDLL! KiUserCallbackDispatcher＠12 + 19 bytes -USER32! 77e14680() -USER32! 77e1a792() -qxeIsDialogMessage(HWND__ * 0x001003e2, tagMSG * 0x0082a93c {msg=0x0000000f wp=0x00000000 lp=0x00000000}) line 2298 + 14 bytes -mswindows_is_dialog_msg(tagMSG * 0x0082a93c {msg=0x0000000f wp=0x00000000 lp=0x00000000}) line 165 + 13 bytes -mswindows_drain_windows_queue(int 0) line 1282 + 9 bytes -emacs_mswindows_drain_queue() line 1326 + 7 bytes -event_stream_drain_queue() line 1887 -event_stream_quit_p() line 1992 -check_quit() line 993 -unbind_to_hairy(int 35) line 5963 -unbind_to_1(int 35, long 20888208) line 5945 + 200 bytes -specifier_instance_from_inst_list(long 21379344, long 38135616, long 36220304, long 20888208, _error_behavior_struct_ {...}, int 1, long 3) line 2522 + 16 bytes -specifier_instance(long 21379344, long 38135616, long 36220304, _error_behavior_struct_ {...}, int 1, int 0, long 3) line 2625 + 65 bytes -specifier_instance_no_quit(long 21379344, long 38135616, long 36220304, _error_behavior_struct_ {...}, int 0, long 1) line 2658 + 31 bytes -face_property_matching_instance(long 22612340, long 20860632, long 22530956, long 36220304, _error_behavior_struct_ {...}, int 0, long 1) line 565 + 48 bytes -ensure_face_cachel_contains_charset(face_cachel * 0x0082b014, long 36220304, long 22530956) line 1104 + 35 bytes -update_face_cachel_data(face_cachel * 0x0082b014, long 36220304, long 22612340) line 1304 + 19 bytes -query_string_geometry(long 21110576, long 22612340, int * 0x00000000, int * 0x0082b5b4, int * 0x00000000, long 38852960) line 2370 + 23 bytes -mswindows_widget_query_string_geometry(long 21110576, long 22612340, int * 0x0082b5b8, int * 0x0082b5b4, long 38852960) line 2914 + 25 bytes -widget_query_string_geometry(long 21110576, long 22612340, int * 0x0082b5b8, int * 0x0082b5b4, long 38852960) line 514 + 32 bytes -edit_field_query_geometry(long 38857648, int * 0x0082b7b4, int * 0x0082b7b8, image_instance_geometry IMAGE_DESIRED_GEOMETRY, long 38852960) line 920 + 390 bytes -widget_query_geometry(long 38857648, int * 0x0082b7b4, int * 0x0082b7b8, image_instance_geometry IMAGE_DESIRED_GEOMETRY, long 38852960) line 567 + 26 bytes -image_instance_query_geometry(long 38857648, int * 0x0082b7b4, int * 0x0082b7b8, image_instance_geometry IMAGE_DESIRED_GEOMETRY, long 38852960) line 2015 + 26 bytes -glyph_query_geometry(long 38853384, int * 0x0082b7b4, int * 0x0082b7b8, image_instance_geometry IMAGE_DESIRED_GEOMETRY, long 38852960) line 4197 + 25 bytes -layout_query_geometry(long 38852960, int * 0x0082b9cc, int * 0x0082b9d0, image_instance_geometry IMAGE_DESIRED_GEOMETRY, long 38404624) line 1351 + 25 bytes -widget_query_geometry(long 38852960, int * 0x0082b9cc, int * 0x0082b9d0, image_instance_geometry IMAGE_DESIRED_GEOMETRY, long 38404624) line 567 + 26 bytes -image_instance_query_geometry(long 38852960, int * 0x0082b9cc, int * 0x0082b9d0, image_instance_geometry IMAGE_DESIRED_GEOMETRY, long 38404624) line 2015 + 26 bytes -glyph_query_geometry(long 38537976, int * 0x0082b9cc, int * 0x0082b9d0, image_instance_geometry IMAGE_DESIRED_GEOMETRY, long 38404624) line 4197 + 25 bytes -layout_layout(long 38404624, int 265, int 156, int -2, int -2, long 38273064) line 1468 + 23 bytes -widget_layout(long 38404624, int 265, int 156, int -2, int -2, long 38273064) line 626 + 30 bytes -image_instance_layout(long 38404624, int 265, int 156, int -2, int -2, long 38273064) line 2102 + 51 bytes -glyph_ascent(long 38404624, long 38273064) line 4009 + 21 bytes -update_glyph_cachel_data(window * 0x02480028, long 36201168, glyph_cachel * 0x0248c3d8) line 4272 + 13 bytes -get_glyph_cachel_index(window * 0x02480028, long 36201168) line 4306 + 17 bytes -add_glyph_rune(position_redisplay_data_type * 0x0082bf2c, glyph_block * 0x024bd028, int 0, int 0, glyph_cachel * 0x00000000) line 1800 + 15 bytes -add_glyph_runes(position_redisplay_data_type * 0x0082bf2c, int 0) line 2085 + 31 bytes -create_string_text_block(window * 0x02480028, long 38776292, display_line * 0x02514500, long 0, prop_block_dynarr * * 0x0082c13c, int 2) line 4907 + 14 bytes -generate_string_display_line(window * 0x02480028, long 38776292, display_line * 0x02514500, long 0, prop_block_dynarr * * 0x0082c13c, int 2) line 5293 + 29 bytes -generate_displayable_area(window * 0x02480028, long 38776292, int 0, int 0, int 265, int 169, display_line_dynarr * 0x0250f228, long 0, int 2) line 5372 + 29 bytes -output_gutter(frame * 0x0228ad90, gutter_pos TOP_GUTTER, int 0) line 409 + 69 bytes -update_frame_gutters(frame * 0x0228ad90) line 639 + 15 bytes -redisplay_frame(frame * 0x0228ad90, int 1) line 6792 + 9 bytes -redisplay_device(device * 0x0171df00, int 1) line 6911 + 11 bytes -redisplay_without_hooks() line 6957 + 11 bytes -redisplay_no_pre_idle_hook() line 7029 -redisplay() line 7011 -mswindows_wnd_proc(HWND__ * 0x001003e2, unsigned int 5, unsigned int 0, long 10223881) line 3424 -intercepted_wnd_proc(HWND__ * 0x001003e2, unsigned int 5, unsigned int 0, long 10223881) line 2488 -USER32! 77e3a244() -USER32! 77e16362() -USER32! 77e14c1a() -USER32! 77e1dd30() -mswindows_wnd_proc(HWND__ * 0x001003e2, unsigned int 71, unsigned int 0, long 8578308) line 3926 + 21 bytes -intercepted_wnd_proc(HWND__ * 0x001003e2, unsigned int 71, unsigned int 0, long 8578308) line 2488 -USER32! 77e3a244() -USER32! 77e14730() -USER32! 77e174b4() -NTDLL! KiUserCallbackDispatcher＠12 + 19 bytes -mswindows_set_frame_size(frame * 0x0228ad90, int 265, int 156) line 355 -internal_set_frame_size(frame * 0x0228ad90, int 265, int 156, int 0) line 2754 + 24 bytes -Fset_frame_displayable_pixel_size(long 36220304, long 531, long 313, long 20888208) line 3004 + 32 bytes -Ffuncall(int 4, long * 0x0082e778) line 3844 + 168 bytes -execute_optimized_program(const unsigned char * 0x02286e48, int 40, long * 0x01529b80) line 609 + 16 bytes -funcall_compiled_function(long 22433308, int 0, long * 0x0082ec08) line 3452 + 85 bytes -Ffuncall(int 1, long * 0x0082ec04) line 3883 + 17 bytes -execute_optimized_program(const unsigned char * 0x02286d40, int 6, long * 0x01548ddc) line 609 + 16 bytes -funcall_compiled_function(long 22505864, int 11, long * 0x0082f00c) line 3452 + 85 bytes -Ffuncall(int 12, long * 0x0082f008) line 3883 + 17 bytes -execute_optimized_program(const unsigned char * 0x02503e38, int 47, long * 0x0152dc48) line 609 + 16 bytes -funcall_compiled_function(long 22436784, int 0, long * 0x0082f534) line 3452 + 85 bytes -Ffuncall(int 1, long * 0x0082f530) line 3883 + 17 bytes -apply1(long 22436784, long 20888208) line 4458 + 11 bytes -Fcall_interactively(long 20742816, long 20888208, long 20888208) line 460 + 13 bytes -Ffuncall(int 2, long * 0x0082f8ec) line 3844 + 127 bytes -call1(long 20854392, long 20742816) line 4489 + 11 bytes -execute_command_event(command_builder * 0x01798f98, long 24439276) line 4198 + 69 bytes -Fdispatch_event(long 24439276) line 4569 + 13 bytes -Fcommand_loop_1() line 569 + 9 bytes -command_loop_1(long 20888208) line 489 -condition_case_1(long 20886024, long (long)* 0x010955a0 command_loop_1(long), long 20888208, long (long, long)* 0x01095150 cmd_error(long, long), long 20888208) line 1917 + 7 bytes -command_loop_3() line 251 + 35 bytes -command_loop_2(long 20888208) line 264 -internal_catch(long 20650992, long (long)* 0x010952c0 command_loop_2(long), long 20888208, int * volatile 0x00000000, long * volatile 0x00000000) line 1527 + 7 bytes -initial_command_loop(long 20888208) line 300 + 28 bytes -xemacs_21_5_b10_i586_pc_win32(int 1, char * * 0x00e52620, char * * 0x00e52bb0, int 0) line 2356 -main(int 1, char * * 0x00e52620, char * * 0x00e52bb0) line 2733 -mainCRTStartup() line 338 + 17 bytes -KERNEL32! 77ea847c() - + (Info-goto-node "(internals)Nasty Bugs due to Reentrancy in Redisplay Structures handling QUIT") */ ＠＠ -5406,17 +5305,22 ＠＠ generate_displayable_area (struct window { int yend = ypos + height; Charcount s_zv; - prop_block_dynarr *prop = 0; layout_bounds bounds; - assert (dla); + int depth = -1; - Dynarr_reset (dla); /* if there's nothing to do then do nothing. code after this assumes there is something to do. */ if (NILP (disp_string)) return; + /* See comment in regenerate_window() */ + if (!in_display) + depth = enter_redisplay_critical_section (); + + assert (dla); + Dynarr_reset (dla); + s_zv = string_char_length (disp_string); bounds.left_out = xpos; ＠＠ -5496,6 +5400,9 ＠＠ generate_displayable_area (struct window if (prop) Dynarr_free (prop); + + if (depth >= 0) + exit_redisplay_critical_section (depth); } ＠＠ -5512,7 +5419,8 ＠＠ generate_displayable_area (struct window changed it to the echo area buffer. */ static void -regenerate_window (struct window *w, Charbpos start_pos, Charbpos point, int type) +regenerate_window (struct window *w, Charbpos start_pos, Charbpos point, + int type) { struct frame *f = XFRAME (w->frame); struct buffer *b = XBUFFER (w->buffer); ＠＠ -5520,6 +5428,7 ＠＠ regenerate_window (struct window *w, Cha int yend; /* set farther down */ int yclip = WINDOW_TEXT_TOP_CLIP (w); int force; + int depth = -1; prop_block_dynarr *prop; layout_bounds bounds; ＠＠ -5529,6 +5438,19 ＠＠ regenerate_window (struct window *w, Cha /* The lines had better exist by this point. */ if (!(dla = window_display_lines (w, type))) ABORT (); + + if (!in_display) + depth = enter_redisplay_critical_section (); + + /* This is one spot where a re-entrancy crash will occur, due to a check + in the dynarr to make sure it isn't "locked" */ +/* + +Info on Re-entrancy crashes, with backtraces given: + + (Info-goto-node "(internals)Nasty Bugs due to Reentrancy in Redisplay Structures handling QUIT") +*/ + Dynarr_reset (dla); w->max_line_len = 0; ＠＠ -5709,6 +5631,9 ＠＠ regenerate_window (struct window *w, Cha there when we first started working in this function. */ generate_modeline (w, Dynarr_atp (dla, 0), type); } + + if (depth >= 0) + exit_redisplay_critical_section (depth); } #define REGEN_INC_FIND_START_END \ Index: src/signal.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/signal.c,v retrieving revision 1.28 diff -u -p -r1.28 signal.c --- src/signal.c 2005/01/24 23:34:10 1.28 +++ src/signal.c 2005/01/26 10:31:54 ＠＠ -1,6 +1,6 ＠＠ /* Handling asynchronous signals. Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1995, 1996, 2001, 2002 Ben Wing. + Copyright (C) 1995, 1996, 2001, 2002, 2004 Ben Wing. This file is part of XEmacs. ＠＠ -693,163 +693,11 ＠＠ begin_do_check_for_quit (void) The C-g or Sh-C-g is discarded, so it won't be noticed again. */ + + void check_quit (void) { - /* dont_check_for_quit is set in three circumstances: - - (1) when we are in the process of changing the window - configuration. The frame might be in an inconsistent state, - which will cause assertion failures if we check for QUIT. - - (2) when we are reading events, and want to read the C-g - as an event. The normal check for quit will discard the C-g, - which would be bad. - - (3) when we're going down with a fatal error. we're most likely - in an inconsistent state, and we definitely don't want to be - interrupted. */ - - /* We should *not* conditionalize on Vinhibit_quit, or - critical-quit (Control-Shift-G) won't work right. */ - - /* WARNING: Even calling check_quit(), without actually dispatching - a quit signal, can result in arbitrary Lisp code getting executed - -- at least under Windows. (Not to mention obvious Lisp - invocations like asynchronous timer callbacks.) Here's a sample - stack trace to demonstrate: - - NTDLL! DbgBreakPoint＠0 address 0x77f9eea9 -assert_failed(const char * 0x012d036c, int 4596, const char * 0x012d0354) line 3478 -re_match_2_internal(re_pattern_buffer * 0x012d6780, const unsigned char * 0x00000000, int 0, const unsigned char * 0x022f9328, int 34, int 0, re_registers * 0x012d53d0 search_regs, int 34) line 4596 + 41 bytes -re_search_2(re_pattern_buffer * 0x012d6780, const char * 0x00000000, int 0, const char * 0x022f9328, int 34, int 0, int 34, re_registers * 0x012d53d0 search_regs, int 34) line 4269 + 37 bytes -re_search(re_pattern_buffer * 0x012d6780, const char * 0x022f9328, int 34, int 0, int 34, re_registers * 0x012d53d0 search_regs) line 4031 + 37 bytes -string_match_1(long 31222628, long 30282164, long 28377092, buffer * 0x022fde00, int 0) line 413 + 69 bytes -Fstring_match(long 31222628, long 30282164, long 28377092, long 28377092) line 436 + 34 bytes -Ffuncall(int 3, long * 0x008297f8) line 3488 + 168 bytes -execute_optimized_program(const unsigned char * 0x020ddc50, int 6, long * 0x020ddf50) line 744 + 16 bytes -funcall_compiled_function(long 34407748, int 1, long * 0x00829aec) line 516 + 53 bytes -Ffuncall(int 2, long * 0x00829ae8) line 3523 + 17 bytes -execute_optimized_program(const unsigned char * 0x020ddc90, int 4, long * 0x020ddf90) line 744 + 16 bytes -funcall_compiled_function(long 34407720, int 1, long * 0x00829e28) line 516 + 53 bytes -Ffuncall(int 2, long * 0x00829e24) line 3523 + 17 bytes -mapcar1(long 15, long * 0x00829e48, long 34447820, long 34187868) line 2929 + 11 bytes -Fmapcar(long 34447820, long 34187868) line 3035 + 21 bytes -Ffuncall(int 3, long * 0x00829f20) line 3488 + 93 bytes -execute_optimized_program(const unsigned char * 0x020c2b70, int 7, long * 0x020dd010) line 744 + 16 bytes -funcall_compiled_function(long 34407580, int 2, long * 0x0082a210) line 516 + 53 bytes -Ffuncall(int 3, long * 0x0082a20c) line 3523 + 17 bytes -execute_optimized_program(const unsigned char * 0x020cf810, int 6, long * 0x020cfb10) line 744 + 16 bytes -funcall_compiled_function(long 34407524, int 0, long * 0x0082a580) line 516 + 53 bytes -Ffuncall(int 1, long * 0x0082a57c) line 3523 + 17 bytes -run_hook_with_args_in_buffer(buffer * 0x022fde00, int 1, long * 0x0082a57c, int 0) line 3980 + 13 bytes -run_hook_with_args(int 1, long * 0x0082a57c, int 0) line 3993 + 23 bytes -Frun_hooks(int 1, long * 0x0082a57c) line 3847 + 19 bytes -run_hook(long 34447484) line 4094 + 11 bytes -unsafe_handle_wm_initmenu_1(frame * 0x01dbb000) line 736 + 11 bytes -unsafe_handle_wm_initmenu(long 28377092) line 807 + 11 bytes -condition_case_1(long 28377116, long (long)* 0x0101c827 unsafe_handle_wm_initmenu(long), long 28377092, long (long, long)* 0x01005fa4 mswindows_modal_loop_error_handler(long, long), long 28377092) line 1692 + 7 bytes -mswindows_protect_modal_loop(long (long)* 0x0101c827 unsafe_handle_wm_initmenu(long), long 28377092) line 1194 + 32 bytes -mswindows_handle_wm_initmenu(HMENU__ * 0x00010199, frame * 0x01dbb000) line 826 + 17 bytes -mswindows_wnd_proc(HWND__ * 0x000501da, unsigned int 278, unsigned int 65945, long 0) line 3089 + 31 bytes -USER32! UserCallWinProc＠20 + 24 bytes -USER32! DispatchClientMessage＠20 + 47 bytes -USER32! __fnDWORD＠4 + 34 bytes -NTDLL! KiUserCallbackDispatcher＠12 + 19 bytes -USER32! DispatchClientMessage＠20 address 0x77e163cc -USER32! DefWindowProcW＠16 + 34 bytes -qxeDefWindowProc(HWND__ * 0x000501da, unsigned int 274, unsigned int 61696, long 98) line 1188 + 22 bytes -mswindows_wnd_proc(HWND__ * 0x000501da, unsigned int 274, unsigned int 61696, long 98) line 3362 + 21 bytes -USER32! UserCallWinProc＠20 + 24 bytes -USER32! DispatchClientMessage＠20 + 47 bytes -USER32! __fnDWORD＠4 + 34 bytes -NTDLL! KiUserCallbackDispatcher＠12 + 19 bytes -USER32! DispatchClientMessage＠20 address 0x77e163cc -USER32! DefWindowProcW＠16 + 34 bytes -qxeDefWindowProc(HWND__ * 0x000501da, unsigned int 262, unsigned int 98, long 540016641) line 1188 + 22 bytes -mswindows_wnd_proc(HWND__ * 0x000501da, unsigned int 262, unsigned int 98, long 540016641) line 3362 + 21 bytes -USER32! UserCallWinProc＠20 + 24 bytes -USER32! DispatchMessageWorker＠8 + 244 bytes -USER32! DispatchMessageW＠4 + 11 bytes -qxeDispatchMessage(const tagMSG * 0x0082c684 {msg=0x00000106 wp=0x00000062 lp=0x20300001}) line 989 + 10 bytes -mswindows_drain_windows_queue() line 1345 + 9 bytes -emacs_mswindows_quit_p() line 3947 -event_stream_quit_p() line 666 -check_quit() line 686 -check_what_happened() line 437 -re_match_2_internal(re_pattern_buffer * 0x012d5a18, const unsigned char * 0x00000000, int 0, const unsigned char * 0x02235000, int 23486, int 14645, re_registers * 0x012d53d0 search_regs, int 23486) line 4717 + 14 bytes -re_search_2(re_pattern_buffer * 0x012d5a18, const char * 0x02235000, int 23486, const char * 0x0223b38e, int 0, int 14645, int 8841, re_registers * 0x012d53d0 search_regs, int 23486) line 4269 + 37 bytes -search_buffer(buffer * 0x022fde00, long 29077572, long 13789, long 23487, long 1, int 1, long 28377092, long 28377092, int 0) line 1224 + 89 bytes -search_command(long 29077572, long 46975, long 28377116, long 28377092, long 28377092, int 1, int 1, int 0) line 1054 + 151 bytes -Fre_search_forward(long 29077572, long 46975, long 28377116, long 28377092, long 28377092) line 2147 + 31 bytes -Ffuncall(int 4, long * 0x0082ceb0) line 3488 + 216 bytes -execute_optimized_program(const unsigned char * 0x02047810, int 13, long * 0x02080c10) line 744 + 16 bytes -funcall_compiled_function(long 34187208, int 3, long * 0x0082d1b8) line 516 + 53 bytes -Ffuncall(int 4, long * 0x0082d1b4) line 3523 + 17 bytes -execute_optimized_program(const unsigned char * 0x01e96a10, int 6, long * 0x020ae510) line 744 + 16 bytes -funcall_compiled_function(long 34186676, int 3, long * 0x0082d4a0) line 516 + 53 bytes -Ffuncall(int 4, long * 0x0082d49c) line 3523 + 17 bytes -execute_optimized_program(const unsigned char * 0x02156b50, int 4, long * 0x020c2db0) line 744 + 16 bytes -funcall_compiled_function(long 34186564, int 2, long * 0x0082d780) line 516 + 53 bytes -Ffuncall(int 3, long * 0x0082d77c) line 3523 + 17 bytes -execute_optimized_program(const unsigned char * 0x0082d964, int 3, long * 0x020c2d70) line 744 + 16 bytes -Fbyte_code(long 29405156, long 34352480, long 7) line 2392 + 38 bytes -Feval(long 34354440) line 3290 + 187 bytes -condition_case_1(long 34354572, long (long)* 0x01087232 Feval(long), long 34354440, long (long, long)* 0x01084764 run_condition_case_handlers(long, long), long 28377092) line 1692 + 7 bytes -condition_case_3(long 34354440, long 28377092, long 34354572) line 1779 + 27 bytes -execute_rare_opcode(long * 0x0082dc7c, const unsigned char * 0x01b090af, int 143) line 1269 + 19 bytes -execute_optimized_program(const unsigned char * 0x01b09090, int 6, long * 0x020ae590) line 654 + 17 bytes -funcall_compiled_function(long 34186620, int 0, long * 0x0082df68) line 516 + 53 bytes -Ffuncall(int 1, long * 0x0082df64) line 3523 + 17 bytes -execute_optimized_program(const unsigned char * 0x02195470, int 1, long * 0x020c2df0) line 744 + 16 bytes -funcall_compiled_function(long 34186508, int 0, long * 0x0082e23c) line 516 + 53 bytes -Ffuncall(int 1, long * 0x0082e238) line 3523 + 17 bytes -execute_optimized_program(const unsigned char * 0x01e5d410, int 6, long * 0x0207d410) line 744 + 16 bytes -funcall_compiled_function(long 34186312, int 1, long * 0x0082e524) line 516 + 53 bytes -Ffuncall(int 2, long * 0x0082e520) line 3523 + 17 bytes -execute_optimized_program(const unsigned char * 0x02108fb0, int 2, long * 0x020c2e30) line 744 + 16 bytes -funcall_compiled_function(long 34186340, int 0, long * 0x0082e7fc) line 516 + 53 bytes -Ffuncall(int 1, long * 0x0082e7f8) line 3523 + 17 bytes -execute_optimized_program(const unsigned char * 0x020fe150, int 2, long * 0x01e6f510) line 744 + 16 bytes -funcall_compiled_function(long 31008124, int 0, long * 0x0082ebd8) line 516 + 53 bytes -Ffuncall(int 1, long * 0x0082ebd4) line 3523 + 17 bytes -run_hook_with_args_in_buffer(buffer * 0x022fde00, int 1, long * 0x0082ebd4, int 0) line 3980 + 13 bytes -run_hook_with_args(int 1, long * 0x0082ebd4, int 0) line 3993 + 23 bytes -Frun_hooks(int 1, long * 0x0082ebd4) line 3847 + 19 bytes -Ffuncall(int 2, long * 0x0082ebd0) line 3509 + 14 bytes -execute_optimized_program(const unsigned char * 0x01ef2210, int 5, long * 0x01da8e10) line 744 + 16 bytes -funcall_compiled_function(long 31020440, int 2, long * 0x0082eeb8) line 516 + 53 bytes -Ffuncall(int 3, long * 0x0082eeb4) line 3523 + 17 bytes -execute_optimized_program(const unsigned char * 0x0082f09c, int 3, long * 0x01d89390) line 744 + 16 bytes -Fbyte_code(long 31102388, long 30970752, long 7) line 2392 + 38 bytes -Feval(long 31087568) line 3290 + 187 bytes -condition_case_1(long 30961240, long (long)* 0x01087232 Feval(long), long 31087568, long (long, long)* 0x01084764 run_condition_case_handlers(long, long), long 28510180) line 1692 + 7 bytes -condition_case_3(long 31087568, long 28510180, long 30961240) line 1779 + 27 bytes -execute_rare_opcode(long * 0x0082f450, const unsigned char * 0x01ef23ec, int 143) line 1269 + 19 bytes -execute_optimized_program(const unsigned char * 0x01ef2310, int 6, long * 0x01da8f10) line 654 + 17 bytes -funcall_compiled_function(long 31020412, int 1, long * 0x0082f740) line 516 + 53 bytes -Ffuncall(int 2, long * 0x0082f73c) line 3523 + 17 bytes -execute_optimized_program(const unsigned char * 0x020fe650, int 3, long * 0x01d8c490) line 744 + 16 bytes -funcall_compiled_function(long 31020020, int 2, long * 0x0082fa14) line 516 + 53 bytes -Ffuncall(int 3, long * 0x0082fa10) line 3523 + 17 bytes -Fcall_interactively(long 29685180, long 28377092, long 28377092) line 1008 + 22 bytes -Fcommand_execute(long 29685180, long 28377092, long 28377092) line 2929 + 17 bytes -execute_command_event(command_builder * 0x01be1900, long 36626492) line 4048 + 25 bytes -Fdispatch_event(long 36626492) line 4341 + 70 bytes -Fcommand_loop_1() line 582 + 9 bytes -command_loop_1(long 28377092) line 495 -condition_case_1(long 28377188, long (long)* 0x01064fb9 command_loop_1(long), long 28377092, long (long, long)* 0x010649d0 cmd_error(long, long), long 28377092) line 1692 + 7 bytes -command_loop_3() line 256 + 35 bytes -command_loop_2(long 28377092) line 269 -internal_catch(long 28457612, long (long)* 0x01064b20 command_loop_2(long), long 28377092, int * volatile 0x00000000) line 1317 + 7 bytes -initial_command_loop(long 28377092) line 305 + 25 bytes -STACK_TRACE_EYE_CATCHER(int 1, char * * 0x01b63ff0, char * * 0x01ca5300, int 0) line 2501 -main(int 1, char * * 0x01b63ff0, char * * 0x01ca5300) line 2938 -XEMACS! mainCRTStartup + 180 bytes -_start() line 171 -KERNEL32! BaseProcessStart＠4 + 115547 bytes - -*/ int specdepth; if (dont_check_for_quit) ＠＠ -860,10 +708,28 ＠＠ KERNEL32! BaseProcessStart＠4 + 115547 by #ifdef ERROR_CHECK_TRAPPING_PROBLEMS /* Since the code below can call Lisp, make sure that proper wrapping is in place during redisplay. */ +#if 0 assert_with_message (proper_redisplay_wrapping_in_place (), "QUIT called from within redisplay without being properly wrapped"); -#endif +#else + /* FUCKME! It looks like we cannot even check for QUIT, *EVER*, during + redisplay. Checking for quit can dispatch events, which can enter + redisplay recursively, which can trip on + +Fatal error: assertion failed, file c:\xemacs\build\src\redisplay.c, line 5532, +!dy->locked + +Backtrace given in + + (Info-goto-node "(internals)Nasty Bugs due to Reentrancy in Redisplay Structures handling QUIT") + + */ + assert_with_message + (!in_display, + "QUIT called from within redisplay without being properly wrapped"); +#endif /* 0 */ +#endif /* ERROR_CHECK_TRAPPING_PROBLEMS */ /* Since arbitrary Lisp code may be executed (e.g. through a menu filter, see backtrace directly above), GC might happen, Index: src/redisplay.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/redisplay.h,v retrieving revision 1.21 diff -u -p -r1.21 redisplay.h --- src/redisplay.h 2004/11/04 23:06:50 1.21 +++ src/redisplay.h 2005/01/26 10:31:56 ＠＠ -1,7 +1,7 ＠＠ /* Redisplay data structures. Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. Copyright (C) 1996 Chuck Thompson. - Copyright (C) 1995, 1996, 2002, 2003 Ben Wing. + Copyright (C) 1995, 1996, 2002, 2003, 2004 Ben Wing. This file is part of XEmacs. ＠＠ -840,5 +840,7 ＠＠ int enter_redisplay_critical_section (vo void exit_redisplay_critical_section (int); int enter_redisplay_critical_section_maybe (void); void exit_redisplay_critical_section_maybe (int depth); +int enter_redisplay_critical_section_if (Boolint from_outside); +void exit_redisplay_critical_section_if (Boolint from_outside, int depth); #endif /* INCLUDED_redisplay_h_ */

1 participants
0 comments

[COMMIT] Update history in emacs.c 20 years, 2 months

Ben Wing

NOTE: This patch has been committed. src/ChangeLog addition: 2005-01-26 Ben Wing <ben(a)xemacs.org> * emacs.c: Update history section. symlink source patch: Diff command: bash -ci "cvs-diff --show-c-function -no-changelog " Files affected: src/emacs.c Index: src/emacs.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/emacs.c,v retrieving revision 1.151 diff -u -p -r1.151 emacs.c --- src/emacs.c 2005/01/24 23:33:51 1.151 +++ src/emacs.c 2005/01/26 10:27:05 ＠＠ -36,103 +36,141 ＠＠ Boston, MA 02111-1307, USA. */ -- A time line for Lucid Emacs/XEmacs is -version 19.0 shipped with Energize 1.0, April 1992. -version 19.1 released June 4, 1992. -version 19.2 released June 19, 1992. -version 19.3 released September 9, 1992. -version 19.4 released January 21, 1993. -version 19.5 was a repackaging of 19.4 with a few bug fixes and - shipped with Energize 2.0. Never released to the net. -version 19.6 released April 9, 1993. -version 19.7 was a repackaging of 19.6 with a few bug fixes and +Version 19.0 shipped with Energize 1.0, April 1992. +Version 19.1 released June 4, 1992. +Version 19.2 released June 19, 1992. +Version 19.3 released September 9, 1992. +Version 19.4 released January 21, 1993. +Version 19.5 released February 5, 1993. This was a repackaging of 19.4 with a + few bug fixes and shipped with Energize 2.0. It was a trade-show giveaway + and never released to the net. +Version 19.6 released April 9, 1993. +Version 19.7 was a repackaging of 19.6 with a few bug fixes and shipped with Energize 2.1. Never released to the net. -version 19.8 released September 6, 1993. -version 19.9 released January 12, 1994. -version 19.10 released May 27, 1994. -version 19.11 (first XEmacs) released September 13, 1994. -version 19.12 released June 23, 1995. -version 19.13 released September 1, 1995. -version 19.14 released June 23, 1996. -version 20.0 released February 9, 1997. -version 19.15 released March 28, 1997. -version 20.1 (not released to the net) April 15, 1997. -version 20.2 released May 16, 1997. -version 19.16 released October 31, 1997. -version 20.3 (the first stable version of XEmacs 20.x) released November 30, -1997. -version 20.4 released February 28, 1998. -version 21.0.60 released December 10, 1998. (The version naming scheme was -changed at this point: [a] the second version number is odd for stable -versions, even for beta versions; [b] a third version number is added, -replacing the "beta xxx" ending for beta versions and allowing for -periodic maintenance releases for stable versions. Therefore, 21.0 was -never "officially" released; similarly for 21.2, etc.) -version 21.0.61 released January 4, 1999. -version 21.0.63 released February 3, 1999. -version 21.0.64 released March 1, 1999. -version 21.0.65 released March 5, 1999. -version 21.0.66 released March 12, 1999. -version 21.0.67 released March 25, 1999. -version 21.1.2 released May 14, 1999; on comp.emacs, May 28. (This is +Version 19.8 released September 6, 1993. (Epoch merger, preliminary I18N + support) +Version 19.9 released January 12, 1994. (Scrollbars, Athena.) +Version 19.10 released May 27, 1994. Known as "Lucid Emacs" when + shipped by Lucid, and as "XEmacs" when shipped by Sun; but Lucid + went out of business a few days later and it's unclear very many + copies of 19.10 were released by Lucid. (Last release by Jamie Zawinski.) +Version 19.11 (first XEmacs) released September 13, 1994. +Version 19.12 released June 23, 1995. +Version 19.13 released September 1, 1995. +Version 19.14 released June 23, 1996. +Version 20.0 released February 9, 1997. +Version 19.15 released March 28, 1997. +Version 20.1 (not released to the net) April 15, 1997. +Version 20.2 released May 16, 1997. +Version 19.16 released October 31, 1997; retiring of v19 series. +Version 20.3 (the first stable version of XEmacs 20.x) released November 30, + 1997. +Version 20.4 released February 28, 1998. (Jamie claims this version is the + "first reasonably stable release with MULE support" and says that "XEmacs + 'core' and 'packages' now packaged separately.") +Version 21.0-pre5 released July 18, 1998. (Jamie says "Numbering scheme goes + wonky due to switch to stable + unstable branches.") +Version 21.0.60 released December 10, 1998. (The version naming scheme was + changed at this point: [a] the second version number is odd for stable + versions, even for beta versions; [b] a third version number is added, + replacing the "beta xxx" ending for beta versions and allowing for + periodic maintenance releases for stable versions. Therefore, 21.0 was + never "officially" released; similarly for 21.2, etc.) +Version 21.0.61 released January 4, 1999. +Version 21.0.63 released February 3, 1999. +Version 21.0.64 released March 1, 1999. +Version 21.0.65 released March 5, 1999. +Version 21.0.66 released March 12, 1999. +Version 21.0.67 released March 25, 1999. +Version 21.1.2 released May 14, 1999; on comp.emacs, May 28. (This is the followup to 21.0.67. The second version number was bumped to indicate the beginning of the "stable" series.) -version 21.1.3 released June 26, 1999. -version 21.1.4 released July 8, 1999. -version 21.1.6 released August 14, 1999. (There was no 21.1.5.) -version 21.1.7 released September 26, 1999. -version 21.1.8 released November 2, 1999. -version 21.1.9 released February 13, 2000. -version 21.1.10 released May 7, 2000. -version 21.1.10a released June 24, 2000. -version 21.1.11 released July 18, 2000. -version 21.1.12 released August 5, 2000. -version 21.1.13 released January 7, 2001. -version 21.1.14 released January 27, 2001. -version 21.2.9 released February 3, 1999. -version 21.2.10 released February 5, 1999. -version 21.2.11 released March 1, 1999. -version 21.2.12 released March 5, 1999. -version 21.2.13 released March 12, 1999. -version 21.2.14 released May 14, 1999. -version 21.2.15 released June 4, 1999. -version 21.2.16 released June 11, 1999. -version 21.2.17 released June 22, 1999. -version 21.2.18 released July 14, 1999. -version 21.2.19 released July 30, 1999. -version 21.2.20 released November 10, 1999. -version 21.2.21 released November 28, 1999. -version 21.2.22 released November 29, 1999. -version 21.2.23 released December 7, 1999. -version 21.2.24 released December 14, 1999. -version 21.2.25 released December 24, 1999. -version 21.2.26 released December 31, 1999. -version 21.2.27 released January 18, 2000. -version 21.2.28 released February 7, 2000. -version 21.2.29 released February 16, 2000. -version 21.2.30 released February 21, 2000. -version 21.2.31 released February 23, 2000. -version 21.2.32 released March 20, 2000. -version 21.2.33 released May 1, 2000. -version 21.2.34 released May 28, 2000. -version 21.2.35 released July 19, 2000. -version 21.2.36 released October 4, 2000. -version 21.2.37 released November 14, 2000. -version 21.2.38 released December 5, 2000. -version 21.2.39 released December 31, 2000. -version 21.2.40 released January 8, 2001. -version 21.2.41 "Polyhymnia" released January 17, 2001. -version 21.2.42 "Poseidon" released January 20, 2001. -version 21.2.43 "Terspichore" released January 26, 2001. -version 21.2.44 "Thalia" released February 8, 2001. -version 21.2.45 "Thelxepeia" released February 23, 2001. -version 21.2.46 "Urania" released March 21, 2001. -version 21.5.0 "alfalfa" released April 18, 2001. -version 21.5.1 "anise" released May 9, 2001. -version 21.5.2 "artichoke" released July 28, 2001. -version 21.5.3 "asparagus" released September 7, 2001. -version 21.5.4 "bamboo" released January 8, 2002. -version 21.5.5 "beets" released March 5, 2002. -version 21.5.6 "bok choi" released April 5, 2002. +Version 21.1.3 released June 26, 1999. +Version 21.1.4 released July 8, 1999. +Version 21.1.6 released August 14, 1999. (There was no 21.1.5.) +Version 21.1.7 released September 26, 1999. +Version 21.1.8 released November 2, 1999. +Version 21.1.9 released February 13, 2000. +Version 21.1.10 released May 7, 2000. +Version 21.1.10a released June 24, 2000. +Version 21.1.11 released July 18, 2000. +Version 21.1.12 released August 5, 2000. +Version 21.1.13 released January 7, 2001. +Version 21.1.14 released January 27, 2001. +Version 21.2.9 released February 3, 1999. +Version 21.2.10 released February 5, 1999. +Version 21.2.11 released March 1, 1999. +Version 21.2.12 released March 5, 1999. +Version 21.2.13 released March 12, 1999. +Version 21.2.14 released May 14, 1999. +Version 21.2.15 released June 4, 1999. +Version 21.2.16 released June 11, 1999. +Version 21.2.17 released June 22, 1999. +Version 21.2.18 released July 14, 1999. +Version 21.2.19 released July 30, 1999. +Version 21.2.20 released November 10, 1999. +Version 21.2.21 released November 28, 1999. +Version 21.2.22 released November 29, 1999. +Version 21.2.23 released December 7, 1999. +Version 21.2.24 released December 14, 1999. +Version 21.2.25 released December 24, 1999. +Version 21.2.26 released December 31, 1999. +Version 21.2.27 released January 18, 2000. +Version 21.2.28 released February 7, 2000. +Version 21.2.29 released February 16, 2000. +Version 21.2.30 released February 21, 2000. +Version 21.2.31 released February 23, 2000. +Version 21.2.32 released March 20, 2000. +Version 21.2.33 released May 1, 2000. +Version 21.2.34 released May 28, 2000. +Version 21.2.35 released July 19, 2000. +Version 21.2.36 released October 4, 2000. +Version 21.2.37 released November 14, 2000. +Version 21.2.38 released December 5, 2000. +Version 21.2.39 released December 31, 2000. +Version 21.2.40 released January 8, 2001. +Version 21.2.41 "Polyhymnia" released January 17, 2001. +Version 21.2.42 "Poseidon" released January 20, 2001. +Version 21.2.43 "Terspichore" released January 26, 2001. +Version 21.2.44 "Thalia" released February 8, 2001. +Version 21.2.45 "Thelxepeia" released February 23, 2001. +Version 21.2.46 "Urania" released March 21, 2001. +Version 21.2.47 "Zephir" released April 14, 2001. +Version 21.4.0 "Solid Vapor" released April 16, 2001. +Version 21.4.1 "Copyleft" released April 19, 2001. +Version 21.4.2 "Developer-Friendly Unix APIs" released May 10, 2001. +Version 21.4.3 "Academic Rigor" released May 17, 2001. +Version 21.4.4 "Artificial Intelligence" released July 28, 2001. +Version 21.4.5 "Civil Service" released October 23, 2001. +Version 21.4.6 "Common Lisp" released December 17, 2001. +Version 21.4.7 "Economic Science" released May 4, 2002. +Version 21.4.8 "Honest Recruiter" released May 9, 2002. +Version 21.4.9 "Informed Management" released August 23, 2002. +Version 21.4.10 "Military Intelligence" released November 2, 2002. +Version 21.4.11 "Native Windows TTY Support" released January 3, 2003. +Version 21.4.12 "Portable Code" released January 15, 2003. +Version 21.4.13 "Rational FORTRAN" released May 25, 2003. +Version 21.4.14 "Reasonable Discussion" released September 3, 2003. +Version 21.4.15 "Security Through Obscurity" released February 2, 2004. +Version 21.5.0 "alfalfa" released April 18, 2001. +Version 21.5.1 "anise" released May 9, 2001. +Version 21.5.2 "artichoke" released July 28, 2001. +Version 21.5.3 "asparagus" released September 7, 2001. +Version 21.5.4 "bamboo" released January 8, 2002. +Version 21.5.5 "beets" released March 5, 2002. +Version 21.5.6 "bok choi" released April 5, 2002. +Version 21.5.7 "broccoflower" released July 2, 2002. +Version 21.5.8 "broccoli" released July 27, 2002. +Version 21.5.9 "brussels sprouts" released August 30, 2002. +Version 21.5.10 "burdock" released January 4, 2003. +Version 21.5.11 "cabbage" released February 16, 2003. +Version 21.5.12 "carrot" released April 24, 2003. +Version 21.5.13 "cauliflower" released May 10, 2003. +Version 21.5.14 "cassava" released June 1, 2003. +Version 21.5.15 "celery" released September 3, 2003. +Version 21.5.16 "celeriac" released September 26, 2003. +Version 21.5.17 "chayote" released March 22, 2004. +Version 21.5.18 "chestnut" released October 22, 2004. -- A time line for GNU Emacs version 19 is ＠＠ -175,6 +213,8 ＠＠ version 20.2 released September 20, 1997 version 20.3 released August 19, 1998. version 20.4 released July 12, 1999; on comp.emacs, July 27. version 21.1 released October 20, 2001. +Version 21.2 released March 16, 2002. +Version 21.3 released March 19, 2003. -- A time line for GNU Emacs version 18 and older is ＠＠ -233,6 +273,15 ＠＠ version 18.56 released on January 17, 19 version 18.57 released late January, 1991. version 18.58 released ?????. version 18.59 released October 31, 1992. + + +-- A time line for Epoch is + +Epoch 1.0 released December 14, 1989. (by Simon Kaplan, Chris Love, et al.) +Epoch 2.0 released December 23, 1989. +Epoch 3.1 released February 6, 1990. +Epoch 3.2 released December[????] 11, 1990. +Epoch 4.0 released August 27, 1990. */

1 participants
0 comments

[COMMIT] Rest of hash-table cleanup (Part 2 of 2) 20 years, 2 months

Ben Wing

NOTE: This patch has been committed. src/ChangeLog addition: 2005-01-26 Ben Wing <ben(a)xemacs.org> * lisp.h: Clean up and generalize creation of string hash tables. Use Hashcode rather than unsigned long. symlink source patch: Diff command: bash -ci "cvs-diff --show-c-function -no-changelog " Files affected: src/lisp.h Index: src/lisp.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/lisp.h,v retrieving revision 1.118 diff -u -p -r1.118 lisp.h --- src/lisp.h 2005/01/24 23:34:01 1.118 +++ src/lisp.h 2005/01/26 10:23:46 ＠＠ -3127,10 +3127,9 ＠＠ int begin_do_check_for_quit (void); #define HASH9(a,b,c,d,e,f,g,h,i) (GOOD_HASH * HASH8 (a,b,c,d,e,f,g,h) + (i)) #define LISP_HASH(obj) ((unsigned long) LISP_TO_VOID (obj)) -unsigned long string_hash (const char *xv); -unsigned long memory_hash (const void *xv, Bytecount size); -unsigned long internal_hash (Lisp_Object obj, int depth); -unsigned long internal_array_hash (Lisp_Object *arr, int size, int depth); +Hashcode memory_hash (const void *xv, Bytecount size); +Hashcode internal_hash (Lisp_Object obj, int depth); +Hashcode internal_array_hash (Lisp_Object *arr, int size, int depth); /************************************************************************/

1 participants
0 comments

[COMMIT] Minor changes to profile code 20 years, 2 months

Ben Wing

NOTE: This patch has been committed. src/ChangeLog addition: 2005-01-26 Ben Wing <ben(a)xemacs.org> * profile.c: * profile.c (vars_of_profile): * profile.h: Add fillers for easier temporary profiling. Add RETURN_UNGCPRO_EXIT_PROFILING, RETURN_EXIT_PROFILING. symlink source patch: Diff command: bash -ci "cvs-diff --show-c-function -no-changelog " Files affected: src/profile.h src/profile.c Index: src/profile.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/profile.c,v retrieving revision 1.22 diff -u -p -r1.22 profile.c --- src/profile.c 2004/12/06 03:52:16 1.22 +++ src/profile.c 2005/01/26 10:08:07 ＠＠ -1,5 +1,5 ＠＠ /* Why the hell is XEmacs so fucking slow? - Copyright (C) 1996, 2002, 2003 Ben Wing. + Copyright (C) 1996, 2002, 2003, 2004 Ben Wing. Copyright (C) 1998 Free Software Foundation, Inc. This file is part of XEmacs. ＠＠ -68,6 +68,15 ＠＠ int profiling_active; static Lisp_Object QSprocessing_events_at_top_level; static Lisp_Object QSunknown, QSprofile_overhead; +#ifdef DEBUG_XEMACS +/* For temporary profiling */ +Lisp_Object QSin_temp_spot_1; +Lisp_Object QSin_temp_spot_2; +Lisp_Object QSin_temp_spot_3; +Lisp_Object QSin_temp_spot_4; +Lisp_Object QSin_temp_spot_5; +#endif /* DEBUG_XEMACS */ + static Lisp_Object Qtiming, Qtotal_timing, Qcall_count; static Lisp_Object Qgc_usage, Qtotal_gc_usage; ＠＠ -672,6 +681,23 ＠＠ value can be. #endif /* 0 */ profiling_lock = 0; + +#ifdef DEBUG_XEMACS + QSin_temp_spot_1 = build_msg_string ("(in temp spot 1)"); + staticpro (&QSin_temp_spot_1); + + QSin_temp_spot_2 = build_msg_string ("(in temp spot 2)"); + staticpro (&QSin_temp_spot_2); + + QSin_temp_spot_3 = build_msg_string ("(in temp spot 3)"); + staticpro (&QSin_temp_spot_3); + + QSin_temp_spot_4 = build_msg_string ("(in temp spot 4)"); + staticpro (&QSin_temp_spot_4); + + QSin_temp_spot_5 = build_msg_string ("(in temp spot 5)"); + staticpro (&QSin_temp_spot_5); +#endif /* DEBUG_XEMACS */ QSunknown = build_msg_string ("(unknown)"); staticpro (&QSunknown); Index: src/profile.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/profile.h,v retrieving revision 1.1 diff -u -p -r1.1 profile.h --- src/profile.h 2003/02/13 09:57:08 1.1 +++ src/profile.h 2005/01/26 10:08:09 ＠＠ -95,3 +95,30 ＠＠ do \ if (do_backtrace) \ POP_BACKTRACE (backtrace); \ } while (0) + +#define RETURN_EXIT_PROFILING(tag, type, expr) \ +do \ +{ \ + type _ret_exitpr_ = (expr); \ + PROFILE_RECORD_EXITING_SECTION (tag); \ + RETURN_SANS_WARNINGS _ret_exitpr_; \ +} while (0) + +#define RETURN_LISP_EXIT_PROFILING(tag, expr) \ + RETURN_EXIT_PROFILING (tag, Lisp_Object, expr) + +#define RETURN_UNGCPRO_EXIT_PROFILING(tag, expr) \ +{ \ + Lisp_Object ret_ungc_val = (expr); \ + UNGCPRO; \ + PROFILE_RECORD_EXITING_SECTION (tag); \ + RETURN_SANS_WARNINGS ret_ungc_val; \ +} while (0) + +#ifdef DEBUG_XEMACS +extern Lisp_Object QSin_temp_spot_1; +extern Lisp_Object QSin_temp_spot_2; +extern Lisp_Object QSin_temp_spot_3; +extern Lisp_Object QSin_temp_spot_4; +extern Lisp_Object QSin_temp_spot_5; +#endif /* DEBUG_XEMACS */

1 participants
0 comments

[COMMIT] Remove CODING-STANDARDS 20 years, 2 months

Ben Wing

2004-11-13 Ben Wing <ben(a)xemacs.org> * CODING-STANDARDS: Delete and incorporate into Internals manual.

1 participants
0 comments

[COMMIT] Separate out optimization and debugging cflags 20 years, 2 months

Ben Wing

NOTE: This patch has been committed. ChangeLog addition: 2005-01-26 Ben Wing <ben(a)xemacs.org> * configure.in (AC_INIT_PARSE_ARGS): * configure.in (CANONICALIZE_PATH): * configure.in (TAB): * configure.usage: Add --with-optimization, cflags-optimization, cflags-debugging. Separate out optimization and debugging arguments. Document. symlink source patch: Diff command: bash -ci "cvs-diff --show-c-function -no-changelog " Files affected: configure.usage configure.in Index: configure.in =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/configure.in,v retrieving revision 1.236 diff -u -p -r1.236 configure.in --- configure.in 2005/01/21 09:30:49 1.236 +++ configure.in 2005/01/26 10:00:45 ＠＠ -531,6 +531,7 ＠＠ while test $# != 0; do with_dnet | \ with_infodock | \ with_netinstall | \ + with_optimization | \ with_ipv6_cname | \ external_widget | \ use_kkcc | \ ＠＠ -560,6 +561,8 ＠＠ while test $# != 0; do xemacs_compiler | \ cflags | \ cflags_warning | \ + cflags_optimization | \ + cflags_debugging | \ cpp | \ cppflags | \ libs | \ ＠＠ -1675,6 +1678,16 ＠＠ if test "${cflags_warning-unset}" != uns else cflags_warning_specified=no; fi +if test "${cflags_optimization-unset}" != unset + then cflags_optimization_specified=yes; + else cflags_optimization_specified=no; +fi + +if test "${cflags_debugging-unset}" != unset + then cflags_debugging_specified=yes; + else cflags_debugging_specified=no; +fi + xe_save_CFLAGS="$CFLAGS" AC_PROG_CC dnl Autoconf has its own magic for compiler autodetection ＠＠ -2010,35 +2023,67 ＠＠ if test "$CC" != "$XEMACS_CC"; then xemacs_cc_cc_mismatch=no fi fi - -dnl #### This may need to be overhauled so that all of XEMACS_CC's flags -dnl are handled separately, not just the xe_cflags_warning stuff. -AC_MSG_CHECKING([for preferred CFLAGS]) +dnl Calculate optimization flags. These will be off by default in beta +dnl versions and on in release versions. -dnl Use either command line flag, environment var, or autodetection -if test "$cflags_specified" = "no"; then - dnl Following values of CFLAGS are known to work well. - dnl Should we take debugging options into consideration? - if test "$GCC" = "yes"; then - CFLAGS="-g -O3" - elif test "$__SUNPRO_C" = "yes"; then - case "$opsys" in - sol2 ) CFLAGS="-xO4" ;; - sunos4* ) CFLAGS="-xO2" ;; - esac - elif test "$__DECC" = "yes"; then - CFLAGS="-O3" - elif test "$CC" = "xlc"; then - CFLAGS="-g -O3 -qstrict -qnoansialias -qlibansi -qro -qmaxmem=20000" - elif test "$__ICC" = "yes"; then - CFLAGS="-g -O3 -Ob2" - dnl ### Add optimal CFLAGS support for other compilers HERE! +if test -z "$with_optimization" ; then + if test -n "$emacs_is_beta" ; then + with_optimization=no else - CFLAGS="-O" ;dnl The only POSIX-approved flag + with_optimization=yes fi fi -AC_MSG_RESULT([${CFLAGS}]) + +dnl #### We should be checking C_OPTIMIZE_SWITCH in m/*, s/*. + +AC_MSG_CHECKING([for preferred optimization flags]) +if test "$with_optimization" = "yes" ; then + if test "$cflags_optimization_specified" = "no"; then + dnl Following values of cflags_optimization are known to work well. + dnl Should we take debugging options into consideration? + if test "$GCC" = "yes"; then + cflags_optimization="-O3" + elif test "$__SUNPRO_C" = "yes"; then + case "$opsys" in + sol2 ) cflags_optimization="-xO4" ;; + sunos4* ) cflags_optimization="-xO2" ;; + esac + elif test "$__DECC" = "yes"; then + cflags_optimization="-O3" + elif test "$CC" = "xlc"; then + dnl see http://www.nersc.gov/vendor_docs/ibm/vac/sc094959.pdf + cflags_optimization="-O3 -qstrict -qnoansialias -qlibansi -qmaxmem=20000" + elif test "$__ICC" = "yes"; then + cflags_optimization="-O3 -Ob2" + dnl ### Add optimal cflags_optimization support for other compilers HERE! + else + cflags_optimization="-O" ;dnl The only POSIX-approved flag + fi + fi +else + cflags_optimization= +fi + +AC_MSG_RESULT([${cflags_optimization}]) + +dnl #### We should be checking C_DEBUG_SWITCH in m/*, s/*. + +AC_MSG_CHECKING([for preferred debugging flags]) +if test "$cflags_debugging_specified" = "no"; then + dnl ### Add optimal debugging support for other compilers HERE! + cflags_debugging="-g" + + debugging_ok_with_optimization=no + if test "$GCC" = "yes" -o "$CC" = "xlc" -o "$__ICC" = "yes"; then + debugging_ok_with_optimization=yes + fi + + if test "$with_optimization" = "yes" -a "$debugging_ok_with_optimization" = "no"; then + cflags_debugging= + fi +fi +AC_MSG_RESULT([${cflags_debugging}]) dnl Calculate warning flags. We separate the flags for warnings from dnl the other flags because we want to force the warnings to be seen ＠＠ -2101,14 +2146,34 ＠＠ AC_MSG_RESULT([${xe_cflags_warning}]) AC_MSG_CHECKING([for preferred warning flags for CC]) AC_MSG_RESULT([${cflags_warning}]) + +dnl Calculate remaining cflags. +dnl Use either command line flag, environment var, or autodetection + +AC_MSG_CHECKING([for remaining CFLAGS]) -dnl Now combine all C flags. Put the warning flags first so that -dnl user-specified flags will override. -dnl Do XE_CFLAGS before adding warning flags to CFLAGS. +if test "$cflags_specified" = "no"; then + dnl Following values of CFLAGS are known to work well. + if test "$CC" = "xlc"; then + CFLAGS="-qro" + dnl ### Add optimal CFLAGS support for other compilers HERE! + fi +fi +AC_MSG_RESULT([${CFLAGS}]) + +dnl Now combine all C flags. Put the warning and optimization flags first +dnl so that user-specified flags will override. +dnl Do XE_CFLAGS before adding flags to CFLAGS. dnl Flags for XEMACS_CC: -XE_CFLAGS="$xe_cflags_warning $CFLAGS" + +XE_CFLAGS="$xe_cflags_warning $cflags_debugging $cflags_optimization $CFLAGS" dnl Flags for CC: -CFLAGS="$cflags_warning $CFLAGS" +CFLAGS="$cflags_warning $cflags_debugging $cflags_optimization $CFLAGS" + +AC_MSG_CHECKING([total value of XE_CFLAGS]) +AC_MSG_RESULT([${XE_CFLAGS}]) +AC_MSG_CHECKING([total value of CFLAGS]) +AC_MSG_RESULT([${CFLAGS}]) dnl Search for GCC specific build problems we know about if test "$GCC" = "yes"; then Index: configure.usage =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/configure.usage,v retrieving revision 1.37 diff -u -p -r1.37 configure.usage --- configure.usage 2004/12/05 08:06:41 1.37 +++ configure.usage 2005/01/26 10:00:47 ＠＠ -42,6 +42,22 ＠＠ Compilation options: --cflags-warning=FLAGS Override compiler flags used to control warnings. Normally, don't set this, as XEmacs already turns on the maximum safe warning level. +--with-optimization Control whether compilation is optimized. + By default, optimization is on in release versions + and off in beta versions, since it can interfere + with proper stack backtraces. +--cflags-optimization=FLAGS + Override compiler flags used to control optimization. + Only has an effect when optimization is enabled. + Normally, don't set this, as XEmacs will already set + the maximum safe optimization flags appropriate for + the compiler being invoked. +--cflags-debugging=FLAGS + Override compiler flags used to add debugging + information to the executable. Normally, debugging + information is added whenever possible (i.e. unless + optimization is turned on and the compiler does not + permit debugging and optimization simultaneously). --cpp=PROG C preprocessor to use (e.g. /usr/ccs/lib/cpp or cc -E) --cppflags=FLAGS C preprocessor flags (e.g. -I/foo or -Dfoo=bar) --libs=LIBS Additional libraries (e.g. -lfoo)

1 participants
0 comments

[COMMIT] Sync newcomment in FSF 21.3 20 years, 2 months

Ben Wing

NOTE: This patch has been committed. lisp/ChangeLog addition: 2005-01-26 Ben Wing <ben(a)xemacs.org> * newcomment.el: * newcomment.el (comment): * newcomment.el (comment-fill-column): New. * newcomment.el (comment-style): * newcomment.el (comment-padding): * newcomment.el (comment-multi-line): * newcomment.el (comment-normalize-vars): * newcomment.el (comment-indent): * newcomment.el (uncomment-region): * newcomment.el (comment-make-extra-lines): * newcomment.el (comment-with-narrowing): * newcomment.el (comment-region-internal): * newcomment.el (comment-region): * newcomment.el (comment-box): * newcomment.el (comment-or-uncomment-region): New. * newcomment.el (comment-dwim): * newcomment.el (comment-auto-fill-only-comments): * newcomment.el (comment-valid-prefix): New. * newcomment.el (comment-indent-new-line): Sync to FSF 21.3. symlink source patch: Diff command: bash -ci "cvs-diff --show-c-function -no-changelog " Files affected: lisp/newcomment.el Index: lisp/newcomment.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/newcomment.el,v retrieving revision 1.2 diff -u -p -r1.2 newcomment.el --- lisp/newcomment.el 2004/06/06 23:58:44 1.2 +++ lisp/newcomment.el 2005/01/26 09:56:32 ＠＠ -5,7 +5,6 ＠＠ ;; Author: code extracted from Emacs-20's simple.el ;; Maintainer: Stefan Monnier <monnier(a)cs.yale.edu> ;; Keywords: comment uncomment -;; Revision: $Id: newcomment.el,v 1.2 2004/06/06 23:58:44 adrian Exp $ ;; This file is part of GNU Emacs. ＠＠ -24,15 +23,19 ＠＠ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. +;;; Synched up with: FSF 21.3. + ;;; Commentary: ;; A replacement for simple.el's comment-related functions. ;;; Bugs: +;; - boxed comments in Perl are not properly uncommented because they are +;; uncommented one-line at a time. +;; - nested comments in sgml-mode are not properly quoted. ;; - single-char nestable comment-start can only do the "\\s<+" stuff ;; if the corresponding closing marker happens to be right. -;; - comment-box in TeXinfo generate bogus comments ＠ccccc＠ ;; - uncomment-region with a numeric argument can render multichar ;; comment markers invalid. ;; - comment-indent or comment-region when called inside a comment ＠＠ -43,15 +46,16 ＠＠ ;;; Todo: -;; - quantized steps in comment-alignment -;; - try to align tail comments -;; - check what c-comment-line-break-function has to say -;; - spill auto-fill of comments onto the end of the next line +;; - rebox.el-style refill. +;; - quantized steps in comment-alignment. +;; - try to align tail comments. +;; - check what c-comment-line-break-function has to say. +;; - spill auto-fill of comments onto the end of the next line. ;; - uncomment-region with a consp (for blocks) or somehow make the -;; deletion of continuation markers less dangerous -;; - drop block-comment-<foo> unless it's really used -;; - uncomment-region on a subpart of a comment -;; - support gnu-style "multi-line with space in continue" +;; deletion of continuation markers less dangerous. +;; - drop block-comment-<foo> unless it's really used. +;; - uncomment-region on a subpart of a comment. +;; - support gnu-style "multi-line with space in continue". ;; - somehow allow comment-dwim to use the region even if transient-mark-mode ;; is not turned on. ＠＠ -71,7 +75,6 ＠＠ ;;;###autoload (defalias 'indent-new-comment-line 'comment-indent-new-line) -;;;###autoload (defgroup comment nil "Indenting and filling of comments." :prefix "comment-" ＠＠ -85,14 +88,18 ＠＠ be used to try to determine whether synt to understand comments or not in the given buffer. Major modes should set this variable.") +(defcustom comment-fill-column nil + "Column to use for `comment-indent'. If nil, use `fill-column' instead." +:type '(choice (const nil) integer)) + ;;;###autoload (defcustom comment-column 32 "*Column to indent right-margin comments to. -Setting this variable automatically makes it local to the current buffer. Each mode establishes a different default value for this variable; you -can set the value for a particular mode using that mode's hook." -:type 'integer -:group 'comment) +can set the value for a particular mode using that mode's hook. +Comments might be indented to a value smaller than this in order +not to go beyond `comment-fill-column'." +:type 'integer) (make-variable-buffer-local 'comment-column) ;;;###autoload ＠＠ -167,7 +174,6 ＠＠ INDENT specifies that the `comment-start (defcustom comment-style 'plain "*Style to be used for `comment-region'. See `comment-styles' for a list of available styles." -:group 'comment :type (if (boundp 'comment-styles) `(choice ,＠(mapcar (lambda (s) `(const ,(car s))) comment-styles)) 'symbol)) ＠＠ -179,8 +185,7 ＠＠ Can also be an integer which will be aut of the corresponding number of spaces. Extra spacing between the comment characters and the comment text -makes the comment easier to read. Default is \" \". nil means 0." -:group 'comment +makes the comment easier to read. Default is 1. nil means 0." :type '(choice string integer (const nil))) ;;;###autoload ＠＠ -188,8 +193,7 ＠＠ makes the comment easier to read. Defau "*Non-nil means \\[indent-new-comment-line] should continue same comment on new line, with no new terminator or starter. This is obsolete because you might as well use \\[newline-and-indent]." -:type 'boolean -:group 'comment) +:type 'boolean) ;;;; ;;;; Helpers ＠＠ -206,6 +210,7 ＠＠ This is obsolete because you might as we "Return the mirror image of string S, without any trailing space." (comment-string-strip (concat (nreverse (string-to-list s))) nil t)) +;;;###autoload (defun comment-normalize-vars (&optional noerror) (if (not comment-start) (or noerror (error "No comment syntax is defined")) ;; comment-use-syntax ＠＠ -232,16 +237,24 ＠＠ This is obsolete because you might as we (unless (or comment-continue (string= comment-end "")) (set (make-local-variable 'comment-continue) (concat (if (string-match "\\S-\\S-" comment-start) " " "|") - (substring comment-start 1)))) + (substring comment-start 1))) + ;; Hasn't been necessary yet. + ;; (unless (string-match comment-start-skip comment-continue) + ;; (kill-local-variable 'comment-continue)) + ) ;; comment-skip regexps - (unless comment-start-skip + (unless (and comment-start-skip + ;; In case comment-start has changed since last time. + (string-match comment-start-skip comment-start)) (set (make-local-variable 'comment-start-skip) (concat "\$\\(^\\|[^\\\\\n]\$\$\\\\\\\\\$*\\)\$\\s<+\\|" (regexp-quote (comment-string-strip comment-start t t)) ;; Let's not allow any \s- but only [ \t] since \n ;; might be both a comment-end marker and \s-. "+\$[ \t]*"))) - (unless comment-end-skip + (unless (and comment-end-skip + ;; In case comment-end has changed since last time. + (string-match comment-end-skip comment-end)) (let ((ce (if (string= "" comment-end) "\n" (comment-string-strip comment-end t t)))) (set (make-local-variable 'comment-end-skip) ＠＠ -252,7 +265,7 ＠＠ This is obsolete because you might as we (if (and comment-quote-nested (<= (length ce) 1)) "" "+") (regexp-quote (substring ce 1)) "\\)")))))) - + (defun comment-quote-re (str unp) (concat (regexp-quote (substring str 0 1)) "\\\\" (if unp "+" "*") ＠＠ -468,13 +481,25 ＠＠ Comments starting in column 0 are not mo (begpos (comment-search-forward eolpos t)) cpos indent) ;; An existing comment? - (if begpos (setq cpos (point-marker)) + (if begpos + (progn + (if (and (not (looking-at "[\t\n ]")) + (looking-at comment-end-skip)) + ;; The comment is empty and we have skipped all its space + ;; and landed right before the comment-ender: + ;; Go back to the middle of the space. + (forward-char (/ (skip-chars-backward " \t") -2))) + (setq cpos (point-marker))) ;; If none, insert one. (save-excursion ;; Some comment-indent-function insist on not moving comments that ;; are in column 0, so we first go to the likely target column. (indent-to comment-column) (setq begpos (point)) + ;; Ensure there's a space before the comment for things + ;; like sh where it matters (as well as being neater). + (unless (eq ?\ (char-syntax (char-before))) + (insert ?\ )) (insert starter) (setq cpos (point-marker)) (insert ender))) ＠＠ -482,22 +507,20 ＠＠ Comments starting in column 0 are not mo ;; Compute desired indent. (setq indent (save-excursion (funcall comment-indent-function))) (if (not indent) - ;; comment-indent-function refuses delegates to indent. + ;; comment-indent-function refuses: delegate to indent. (indent-according-to-mode) ;; Avoid moving comments past the fill-column. (unless (save-excursion (skip-chars-backward " \t") (bolp)) (setq indent (min indent (+ (current-column) - (- fill-column + (- (or comment-fill-column fill-column) (save-excursion (end-of-line) (current-column))))))) ;; XEmacs change: Preserve indentation of comments starting in ;; column 0, as documented. - (if (or (= (current-column) 0) (= (current-column) indent)) - (goto-char begpos) + (unless (or (= (current-column) 0) (= (current-column) indent)) ;; If that's different from current, change it. - (skip-chars-backward " \t") - (delete-region (point) begpos) + (delete-region (point) (progn (skip-chars-backward " \t") (point))) (indent-to (if (bolp) indent (max indent (1+ (current-column))))))) (goto-char cpos) ＠＠ -619,7 +642,7 ＠＠ If N is `re', a regexp is returned inste ;;;###autoload (defun uncomment-region (beg end &optional arg) - "Uncomment each line in the BEG..END region. + "Uncomment each line in the BEG .. END region. The numeric prefix ARG can specify a number of chars to remove from the comment markers." (interactive "*r\nP") ＠＠ -649,31 +672,36 ＠＠ comment markers." (setq arg (list min-comments))) (goto-char beg))) - (let ((numarg (prefix-numeric-value arg)) - spt) + (let* ((numarg (prefix-numeric-value arg)) + (ccs comment-continue) + (srei (comment-padright ccs 're)) + (sre (and srei (concat "^\\s-*?\$" srei "\$"))) + spt) (while (and (< (point) end) (setq spt (comment-search-forward end t))) - (let* ((ipt (point)) - ;; Find the end of the comment. - (ept (progn - (goto-char spt) - (unless (comment-forward) - (error "Can't find the comment end")) - (point))) - (box nil) - (ccs comment-continue) - (srei (comment-padright ccs 're)) - (sre (and srei (concat "^\\s-*?\$" srei "\$")))) + (let ((ipt (point)) + ;; Find the end of the comment. + (ept (progn + (goto-char spt) + (unless (comment-forward) + (error "Can't find the comment end")) + (point))) + (box nil) + (box-equal nil)) ;Whether we might be using `=' for boxes. (save-restriction (narrow-to-region spt ept) + ;; Remove the comment-start. (goto-char ipt) (skip-syntax-backward " ") - ;; Check for special `=' used sometimes in comment-box. - (when (and (= (- (point) (point-min)) 1) (looking-at "=\\{7\\}")) - (skip-chars-forward "=")) ;; A box-comment starts with a looong comment-start marker. - (when (> (- (point) (point-min) (length comment-start)) 7) + (when (and (or (and (= (- (point) (point-min)) 1) + (setq box-equal t) + (looking-at "=\\{7\\}") + (not (eq (char-before (point-max)) ?\n)) + (skip-chars-forward "=")) + (> (- (point) (point-min) (length comment-start)) 7)) + (> (count-lines (point-min) (point-max)) 2)) (setq box t)) (when (looking-at (regexp-quote comment-padding)) (goto-char (match-end 0))) ＠＠ -686,7 +714,7 ＠＠ comment markers." ;; Remove the end-comment (and leading padding and such). (goto-char (point-max)) (comment-enter-backward) ;; Check for special `=' used sometimes in comment-box. - (when (= (- (point-max) (point)) 1) + (when (and box-equal (not (eq (char-before (point-max)) ?\n))) (let ((pos (point))) ;; skip `=' but only if there are at least 7. (when (> (skip-chars-backward "=") -7) (goto-char pos)))) ＠＠ -735,23 +763,32 ＠＠ This is used for `extra-line' style (or (s (concat cs "a=m" cce)) (e (concat ccs "a=m" ce)) (c (if (string-match ".*\\S-\\S-" cs) - (aref cs (1- (match-end 0))) ?=)) - ; Huh? (_ (string-match "\\s-*a=m\\s-*" s)) + (aref cs (1- (match-end 0))) + (if (and (equal comment-end "") (string-match ".*\\S-" cs)) + (aref cs (1- (match-end 0))) ?=))) + (re "\\s-*a=m\\s-*") + ; Huh? (_ (string-match re s)) + (lcs (length cs)) (fill (make-string (+ width (- (match-end 0) - (match-beginning 0) (length cs) 3)) c))) + (match-beginning 0) lcs 3)) c))) (setq cs (replace-match fill t t s)) - (string-match "\\s-*a=m\\s-*" e) + (when (and (not (string-match comment-start-skip cs)) + (string-match "a=m" s)) + ;; The whitespace around CS cannot be ignored: put it back. + (setq re "a=m") + (setq fill (make-string (- width lcs) c)) + (setq cs (replace-match fill t t s))) + (string-match re e) (setq ce (replace-match fill t t e)))) (cons (concat cs "\n" (make-string min-indent ? ) ccs) (concat cce "\n" (make-string (+ min-indent eindent) ? ) ce)))) -;(def-edebug-spec comment-with-narrowing t) -(put 'comment-with-narrowing 'lisp-indent-function 2) (defmacro comment-with-narrowing (beg end &rest body) "Execute BODY with BEG..END narrowing. Space is added (and then removed) at the beginning for the text's indentation to be kept as it was before narrowing." + (declare (debug t) (indent 2)) (let ((bindent (make-symbol "bindent"))) `(let ((,bindent (save-excursion (goto-char beg) (current-column)))) (save-restriction ＠＠ -778,7 +815,7 ＠＠ indentation to be kept as it was before (defun comment-region-internal (beg end cs ce &optional ccs cce block lines indent) - "Comment region BEG..END. + "Comment region BEG .. END. CS and CE are the comment start resp end string. CCS and CCE are the comment continuation strings for the start resp end of lines (default to CS and CE). ＠＠ -803,7 +840,7 ＠＠ rather than at left margin." (unless block (setq cce nil)) ;; Continuation defaults to the same as CS and CE. (unless ccs (setq ccs cs cce ce)) - + (save-excursion (goto-char end) ;; If the end is not at the end of a line and the comment-end ＠＠ -825,7 +862,7 ＠＠ rather than at left margin." (end-of-line) (setq max-indent (max max-indent (current-column))) (not (or (eobp) (progn (forward-line) nil))))) - + ;; Inserting ccs can change max-indent by (1- tab-width). (setq max-indent (+ max-indent (max (length cs) (length ccs)) tab-width -1)) ＠＠ -838,7 +875,7 ＠＠ rather than at left margin." cs ce ccs cce min-indent max-indent block))) (setq cs (car csce)) (setq ce (cdr csce)))) - + (goto-char (point-min)) ;; Loop over all lines from BEG to END. (while ＠＠ -857,7 +894,7 ＠＠ rather than at left margin." ;;;###autoload (defun comment-region (beg end &optional arg) "Comment or uncomment each line in the region. -With just \\[universal-argument] prefix arg, uncomment each line in region BEG..END. +With just \\[universal-argument] prefix arg, uncomment each line in region BEG .. END. Numeric prefix arg ARG means use ARG comment characters. If ARG is negative, delete that many comment characters instead. By default, comments start at the left margin, are terminated on each line, ＠＠ -894,8 +931,8 ＠＠ The strings used as comment starts are b (>= (point) beg)) (progn (goto-char end) (end-of-line) (skip-syntax-backward " ") (<= (point) end)) - (or (not (string= "" comment-end)) block) - (progn (goto-char beg) (search-forward "\n" end t))))) + (or block (not (string= "" comment-end))) + (or block (progn (goto-char beg) (search-forward "\n" end t)))))) ;; don't add end-markers just because the user asked for `block' (unless (or lines (string= "" comment-end)) (setq block nil)) ＠＠ -921,7 +958,7 ＠＠ The strings used as comment starts are b (nth 3 style)))))) (defun comment-box (beg end &optional arg) - "Comment out the BEG..END region, putting it inside a box. + "Comment out the BEG .. END region, putting it inside a box. The numeric prefix ARG specifies how many characters to add to begin- and end- comment markers additionally to what `comment-add' already specifies." (interactive "*r\np") ＠＠ -929,7 +966,21 ＠＠ end- comment markers additionally to wha 'box-multi 'box))) (comment-region beg end (+ comment-add arg)))) + ;;;###autoload +(defun comment-or-uncomment-region (beg end &optional arg) + "Call `comment-region', unless the region only consists of comments, +in which case call `uncomment-region'. If a prefix arg is given, it +is passed on to the respective function." + (interactive "*r\nP") + (funcall (if (save-excursion ;; check for already commented region + (goto-char beg) + (comment-forward (point-max)) + (<= end (point))) + 'uncomment-region 'comment-region) + beg end arg)) + +;;;###autoload (defun comment-dwim (arg) "Call the comment command you want (Do What I Mean). If the region is active and `transient-mark-mode' is on, call ＠＠ -941,14 +992,7 ＠＠ Else, call `comment-indent'." (interactive "*P") (comment-normalize-vars) (if (region-active-p) ;mark-active transient-mark-mode) - (let ((beg (min (point) (mark))) - (end (max (point) (mark)))) - (if (save-excursion ;; check for already commented region - (goto-char beg) - (comment-forward (point-max)) - (<= end (point))) - (uncomment-region beg end arg) - (comment-region beg end arg))) + (comment-or-uncomment-region (region-beginning) (region-end) arg) (if (save-excursion (beginning-of-line) (not (looking-at "\\s-*$"))) ;; FIXME: If there's no comment to kill on this line and ARG is ;; specified, calling comment-kill is not very clever. ＠＠ -967,9 +1011,16 ＠＠ Else, call `comment-indent'." (defcustom comment-auto-fill-only-comments nil "Non-nil means to only auto-fill inside comments. This has no effect in modes that do not define a comment syntax." -:type 'boolean -:group 'comment) +:type 'boolean) +(defun comment-valid-prefix (prefix compos) + (or + ;; Accept any prefix if the current comment is not EOL-terminated. + (save-excursion (goto-char compos) (comment-forward) (not (bolp))) + ;; Accept any prefix that starts with a comment-start marker. + (string-match (concat "\\`[ \t]*\$?:" comment-start-skip "\$") + fill-prefix))) + ;;;###autoload (defun comment-indent-new-line (&optional soft) "Break line at point and indent, continuing comment if within one. ＠＠ -992,42 +1043,59 ＠＠ unless optional argument SOFT is non-nil ;; don't do anything (unless no comment syntax is defined). (unless (and comment-start comment-auto-fill-only-comments + (not (interactive-p)) (not (save-excursion (prog1 (setq compos (comment-beginning)) (setq comin (point)))))) - ;; Now we know we should auto-fill. ;; XEmacs: next 3 lines from old version. (skip-chars-backward " \t") (if (featurep 'mule) (declare-fboundp (kinsoku-process))) - (delete-horizontal-space) + + ;; Now we know we should auto-fill. + ;; Insert the newline before removing empty space so that markers + ;; get preserved better. (if soft (insert-and-inherit ?\n) (newline 1)) - (if fill-prefix + (save-excursion (forward-char -1) (delete-horizontal-space)) + (delete-horizontal-space) + + (if (and fill-prefix (not adaptive-fill-mode)) + ;; Blindly trust a non-adaptive fill-prefix. (progn (indent-to-left-margin) - (insert-and-inherit fill-prefix)) + (insert-before-markers-and-inherit fill-prefix)) ;;#### jhod: probably need to fix this for kinsoku processing ;; If necessary check whether we're inside a comment. - (unless (or comment-multi-line compos (null comment-start)) + (unless (or compos (null comment-start)) (save-excursion (backward-char) (setq compos (comment-beginning)) (setq comin (point)))) - ;; If we're not inside a comment, just try to indent. - ;; #### XEmacs: the line `(if comcol' was changed as follows. - ;; I'm leaving it out since who knows if it's applicable any more. - ;; --ben - ;; (if (and comcol (not fill-prefix)) ; XEmacs - (ENE) from fa-extras. - (if (not compos) (indent-according-to-mode) + (cond + ;; If there's an adaptive prefix, use it unless we're inside + ;; a comment and the prefix is not a comment starter. + ((and fill-prefix + (or (not compos) + (comment-valid-prefix fill-prefix compos))) + (indent-to-left-margin) + (insert-and-inherit fill-prefix)) + ;; If we're not inside a comment, just try to indent. + ;; #### XEmacs: the line `(if comcol' was changed as follows. + ;; I'm leaving it out since who knows if it's applicable any more. + ;; --ben + ;; (if (and comcol (not fill-prefix)) ; XEmacs - (ENE) from fa-extras. + ((not compos) (indent-according-to-mode)) + (t (let* ((comment-column ;; The continuation indentation should be somewhere between ;; the current line's indentation (plus 2 for good measure) ;; and the current comment's indentation, with a preference ;; for comment-column. (save-excursion + ;; FIXME: use prev line's info rather than first line's. (goto-char compos) (min (current-column) (max comment-column (+ 2 (current-indentation)))))) ＠＠ -1049,22 +1117,25 ＠＠ unless optional argument SOFT is non-nil (point)) nil t))))) (comment-start comstart) + (continuep (or comment-multi-line + (cadr (assoc comment-style comment-styles)))) ;; Force comment-continue to be recreated from comment-start. ;; FIXME: wrong if comment-continue was set explicitly! + ;; FIXME: use prev line's continuation if available. (comment-continue nil)) - (insert-and-inherit ?\n) - (forward-char -1) - (comment-indent (cadr (assoc comment-style comment-styles))) - (save-excursion - (let ((pt (point))) - (end-of-line) - (let ((comend (buffer-substring pt (point)))) - ;; The 1+ is to make sure we delete the \n inserted above. - (delete-region pt (1+ (point))) - (beginning-of-line) - (backward-char) - (insert comend) - (forward-char)))))))))) + (if (and comment-multi-line (> (length comment-end) 0)) + (indent-according-to-mode) + (insert-and-inherit ?\n) + (forward-char -1) + (comment-indent continuep) + (save-excursion + (let ((pt (point))) + (end-of-line) + (let ((comend (buffer-substring pt (point)))) + ;; The 1+ is to make sure we delete the \n inserted above. + (delete-region pt (1+ (point))) + (end-of-line 0) + (insert comend)))))))))))) (provide 'newcomment)

1 participants
0 comments

[COMMIT] Sync to FSF 20 years, 2 months

Ben Wing

NOTE: This patch has been committed. lisp/ChangeLog addition: 2005-01-26 Ben Wing <ben(a)xemacs.org> * fill.el: * fill.el (canonically-space-region): * fill.el (fill-region-as-paragraph): * fill.el (justify-current-line): * fill.el (fill-individual-paragraphs): Sync for real to FSF 19.34. * page.el: * page.el (narrow-to-page): * register.el: * register.el (set-register): * register.el (point-to-register): * register.el (register-swap-out): * register.el (number-to-register): * register.el (view-register): * register.el (list-registers): New. * register.el (describe-register-1): New. * register.el (insert-register): Sync to FSF 21.3. symlink source patch: Diff command: bash -ci "cvs-diff --show-c-function -no-changelog " Files affected: lisp/register.el lisp/page.el lisp/fill.el Index: lisp/fill.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/fill.el,v retrieving revision 1.7 diff -u -p -r1.7 fill.el --- lisp/fill.el 2002/03/15 07:43:19 1.7 +++ lisp/fill.el 2005/01/26 09:55:12 ＠＠ -23,6 +23,10 ＠＠ ;; 02111-1307, USA. ;;; Synched up with: FSF 19.34. +;;; NOTE: Merging past 19.34 is currently impossible. Later versions +;;; contain FSF's own Kinsoku processing, conflicting with the current code +;;; and depending on various features of their Mule implementation that +;;; do not currently exist. ;;; Commentary: ＠＠ -201,9 +205,7 ＠＠ Remove indentation from each line." ;; We insert before markers in case a caller such as ;; do-auto-fill has done a save-excursion with point at the end ;; of the line and wants it to stay at the end of the line. - (insert ? )))) -;; XEmacs: we don't have this function. -;; (insert-before-markers-and-inherit ? )))) + (insert-before-markers-and-inherit ? )))) ;; XEmacs -- added DONT-SKIP-FIRST. Port of older code changes by Stig. ;; #### probably this junk is broken -- do-auto-fill doesn't actually use ＠＠ -377,8 +379,7 ＠＠ space does not end a sentence, so don't ;; Make sure sentences ending at end of line get an extra space. ;; loses on split abbrevs ("Mr.\nSmith") (while (re-search-forward "[.?!][])}\"']*$" nil t) - ;; XEmacs change (no insert-and-inherit) - (or (eobp) (insert ?\ ?\ ))) + (or (eobp) (insert-and-inherit ?\ ?\ ))) (goto-char from) (skip-chars-forward " \t") ;; Then change all newlines to spaces. ＠＠ -423,8 +424,7 ＠＠ space does not end a sentence, so don't (canonically-space-region (or squeeze-after (point)) (point-max)) (goto-char (point-max)) (delete-horizontal-space) - ;; XEmacs change (no insert-and-inherit) - (insert " ")) + (insert-and-inherit " ")) (goto-char (point-min)) ;; This is the actual filling loop. ＠＠ -572,7 +572,7 ＠＠ space does not end a sentence, so don't ;; Set prefixcol so whitespace in the prefix won't get lost. (and fill-prefix (not (equal fill-prefix "")) (progn - (insert fill-prefix) + (insert-and-inherit fill-prefix) (setq prefixcol (current-column)))))) ;; Justify the line just ended, if desired. (if justify ＠＠ -930,8 +930,7 ＠＠ otherwise it is made canonical." (find-space-insertable-point))) ;(search-backward " "))) (skip-chars-backward " ") (setq nmove (1- nmove)))) - ;; XEmacs change - (insert " ") + (insert-and-inherit " ") (skip-chars-backward " ") (setq ncols (1- ncols))))))) (t (error "Unknown justification value")))) ＠＠ -1046,7 +1045,7 ＠＠ MAIL-FLAG for a mail message, i. e. don' fill-prefix-regexp (regexp-quote fill-prefix))) (forward-line 1) (if (bolp) - ;; If forward-line went past a newline + ;; If forward-line went past a newline, ;; move further to the left margin. (move-to-left-margin)) ;; Now stop the loop if end of paragraph. Index: lisp/page.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/page.el,v retrieving revision 1.3 diff -u -p -r1.3 page.el --- lisp/page.el 2001/04/12 18:21:34 1.3 +++ lisp/page.el 2005/01/26 09:55:14 ＠＠ -1,9 +1,10 ＠＠ -;;; page.el --- page motion commands for emacs. +;;; page.el --- page motion commands for Emacs ;; Copyright (C) 1985, 1997 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: extensions, dumped +;; Keywords: wp convenience ;; This file is part of XEmacs. ＠＠ -22,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: ＠＠ -94,15 +95,28 ＠＠ thus showing a page other than the one p (if (> arg 0) (forward-page arg) (if (< arg 0) - (forward-page (1- arg)))) + (let ((adjust 0) + (opoint (point))) + ;; If we are not now at the beginning of a page, + ;; move back one extra time, to get to the start of this page. + (save-excursion + (beginning-of-line) + (or (and (looking-at page-delimiter) + (eq (match-end 0) opoint)) + (setq adjust 1))) + (forward-page (- arg adjust))))) ;; Find the end of the page. + (set-match-data nil) (forward-page) ;; If we stopped due to end of buffer, stay there. ;; If we stopped after a page delimiter, put end of restriction ;; at the beginning of that line. - (if (save-excursion - (goto-char (match-beginning 0)) ; was (beginning-of-line) - (looking-at page-delimiter)) + ;; Before checking the match that was found, + ;; verify that forward-page actually set the match data. + (if (and (match-beginning 0) + (save-excursion + (goto-char (match-beginning 0)) ; was (beginning-of-line) + (looking-at page-delimiter))) (beginning-of-line)) (narrow-to-region (point) (progn Index: lisp/register.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/register.el,v retrieving revision 1.7 diff -u -p -r1.7 register.el --- lisp/register.el 1998/07/12 07:30:39 1.7 +++ lisp/register.el 2005/01/26 09:55:15 ＠＠ -1,4 +1,4 ＠＠ -;;; register.el --- register commands for Emacs. +;;; register.el --- register commands for Emacs ;; Copyright (C) 1985, 1993, 1994, 1997 Free Software Foundation, Inc. ＠＠ -22,7 +22,7 ＠＠ ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ;; 02111-1307, USA. -;;; Synched up with: FSF 20.3 +;;; Synched up with: FSF 21.3 ;;; Commentary: ＠＠ -57,8 +57,7 ＠＠ See the documentation of the variable `r (let ((aelt (assq register register-alist))) (if aelt (setcdr aelt value) - (setq aelt (cons register value)) - (setq register-alist (cons aelt register-alist))) + (push (cons register value) register-alist)) value)) (defun point-to-register (register &optional arg) ＠＠ -67,6 +66,8 ＠＠ With prefix argument, store current fram Use \\[jump-to-register] to go to that location or restore that configuration. Argument is a character, naming the register." (interactive "cPoint to register: \nP") + ;; Turn the marker into a file-ref if the buffer is killed. + (add-hook 'kill-buffer-hook 'register-swap-out nil t) (set-register register (if arg (list (current-frame-configuration) (point-marker)) (point-marker)))) ＠＠ -125,21 +126,17 ＠＠ delete any existing frames that the fram (t (error "Register doesn't contain a buffer position or configuration"))))) -;; Turn markers into file-query references when a buffer is killed. (defun register-swap-out () + "Turn markers into file-query references when a buffer is killed." (and buffer-file-name - (let ((tail register-alist)) - (while tail - (and (markerp (cdr (car tail))) - (eq (marker-buffer (cdr (car tail))) (current-buffer)) - (setcdr (car tail) - (list 'file-query - buffer-file-name - (marker-position (cdr (car tail)))))) - (setq tail (cdr tail)))))) + (dolist (elem register-alist) + (and (markerp (cdr elem)) + (eq (marker-buffer (cdr elem)) (current-buffer)) + (setcdr elem + (list 'file-query + buffer-file-name + (marker-position (cdr elem)))))))) -(add-hook 'kill-buffer-hook 'register-swap-out) - (defun number-to-register (number register) "Store a number in a register. Two args, NUMBER and REGISTER (a character, naming the register). ＠＠ -147,7 +144,7 ＠＠ If NUMBER is nil, a decimal number is re at point, and point moves to the end of that number. Interactively, NUMBER is the prefix arg (none means nil)." (interactive "P\ncNumber to register: ") - (set-register register + (set-register register (if number (prefix-numeric-value number) (if (looking-at "\\s-*-?[0-9]+") ＠＠ -172,54 +169,89 ＠＠ The Lisp value REGISTER is a character." (if (null val) (message "Register %s is empty" (single-key-description register)) (with-output-to-temp-buffer "*Output*" - (princ "Register ") - (princ (single-key-description register)) - (princ " contains ") - (cond - ((numberp val) - (princ val)) + (describe-register-1 register t))))) + +(defun list-registers () + "Display a list of nonempty registers saying briefly what they contain." + (interactive) + (let ((list (copy-sequence register-alist))) + (setq list (sort list (lambda (a b) (< (car a) (car b))))) + (with-output-to-temp-buffer "*Output*" + (dolist (elt list) + (when (get-register (car elt)) + (describe-register-1 (car elt)) + (terpri)))))) + +(defun describe-register-1 (register &optional verbose) + (princ "Register ") + (princ (single-key-description register)) + (princ " contains ") + (let ((val (get-register register))) + (cond + ((numberp val) + (princ val)) + + ((markerp val) + (let ((buf (marker-buffer val))) + (if (null buf) + (princ "a marker in no buffer") + (princ "a buffer position:\n buffer ") + (princ (buffer-name buf)) + (princ ", position ") + (princ (marker-position val))))) + + ((and (consp val) (window-configuration-p (car val))) + (princ "a window configuration.")) - ((markerp val) - (let ((buf (marker-buffer val))) - (if (null buf) - (princ "a marker in no buffer") - (princ "a buffer position:\nbuffer ") - (princ (buffer-name buf)) - (princ ", position ") - (princ (marker-position val))))) - - ((and (consp val) (window-configuration-p (car val))) - (princ "a window configuration.")) - - ((and (consp val) (frame-configuration-p (car val))) - (princ "a frame configuration.")) - - ((and (consp val) (eq (car val) 'file)) - (princ "the file ") - (prin1 (cdr val)) - (princ ".")) - - ((and (consp val) (eq (car val) 'file-query)) - (princ "a file-query reference:\nfile ") - (prin1 (car (cdr val))) - (princ ",\nposition ") - (princ (car (cdr (cdr val)))) - (princ ".")) - - ((consp val) - (princ "the rectangle:\n") - (while val - (princ (car val)) - (terpri) - (setq val (cdr val)))) - - ((stringp val) - (princ "the text:\n") - (princ val)) + ((and (consp val) (frame-configuration-p (car val))) + (princ "a frame configuration.")) + + ((and (consp val) (eq (car val) 'file)) + (princ "the file ") + (prin1 (cdr val)) + (princ ".")) + + ((and (consp val) (eq (car val) 'file-query)) + (princ "a file-query reference:\n file ") + (prin1 (car (cdr val))) + (princ ",\n position ") + (princ (car (cdr (cdr val)))) + (princ ".")) + ((consp val) + (if verbose + (progn + (princ "the rectangle:\n") + (while val + (princ " ") + (princ (car val)) + (terpri) + (setq val (cdr val)))) + (princ "a rectangle starting with ") + (princ (car val)))) + + ((stringp val) + (remove-list-of-text-properties 0 (length val) + yank-excluded-properties val) + (if verbose + (progn + (princ "the text:\n") + (princ val)) + (cond + ;; Extract first N characters starting with first non-whitespace. + ((string-match (format "[^ \t\n].\\{,%d\\}" + ;; Deduct 6 for the spaces inserted below. + (min 20 (max 0 (- (window-width) 6)))) + val) + (princ "text starting with\n ") + (princ (match-string 0 val))) + ((string-match "^[ \t\n]+$" val) + (princ "whitespace")) (t - (princ "Garbage:\n") - (prin1 val))))))) + (princ "the empty string"))))) + (t + (princ "Garbage:\n") + (if verbose (prin1 val)))))) (defun insert-register (register &optional arg) "Insert contents of register REGISTER. (REGISTER is a character.) ＠＠ -233,7 +265,7 ＠＠ Interactively, second arg is non-nil if ((consp val) (insert-rectangle val)) ((stringp val) - (insert val)) + (insert-for-yank val)) ((numberp val) (princ val (current-buffer))) ((and (markerp val) (marker-position val))

1 participants
0 comments

[COMMIT] fix warnings 20 years, 2 months

Ben Wing

NOTE: This patch has been committed. lisp/ChangeLog addition: 2005-01-26 Ben Wing <ben(a)xemacs.org> * frame.el (display-mouse-p): Fix warning. * cl.el (cl-random-time): Conditionalize on coerce-number as Jerry says it's OK. lib-src/ChangeLog addition: 2005-01-26 Ben Wing <ben(a)xemacs.org> * fakemail.c (main): Add args to fix warning. symlink source patch: Diff command: bash -ci "cvs-diff --show-c-function -no-changelog " Files affected: lib-src/fakemail.c lisp/cl.el lisp/frame.el Index: lisp/frame.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/frame.el,v retrieving revision 1.22 diff -u -p -r1.22 frame.el --- lisp/frame.el 2004/11/04 23:05:55 1.22 +++ lisp/frame.el 2005/01/26 09:52:19 ＠＠ -1186,7 +1186,7 ＠＠ selected frame)." (case (framep-on-display display) ;; We assume X, NeXTstep, and GTK *always* have a pointing device ((x ns gtk) t) - (mswindows (> mswindows-num-mouse-buttons 0)) + (mswindows (> (declare-boundp mswindows-num-mouse-buttons) 0)) (tty (and-fboundp 'gpm-is-supported-p (gpm-is-supported-p (display-device display)))) Index: lisp/cl.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/cl.el,v retrieving revision 1.14 diff -u -p -r1.14 cl.el --- lisp/cl.el 2004/11/04 23:05:54 1.14 +++ lisp/cl.el 2005/01/26 09:52:21 ＠＠ -307,8 +307,8 ＠＠ definitions to shadow the loaded ones fo (defun cl-random-time () (let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0)) (while (>= (decf i) 0) (setq v (+ (* v 3) (aref time i)))) - (if (featurep 'bignum) - (declare-fboundp (coerce-number v 'fixnum)) + (if-fboundp 'coerce-number + (coerce-number v 'fixnum) v))) (defvar *gensym-counter* (* (logand (cl-random-time) 1023) 100)) Index: lib-src/fakemail.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lib-src/fakemail.c,v retrieving revision 1.7 diff -u -p -r1.7 fakemail.c --- lib-src/fakemail.c 2004/09/20 19:19:10 1.7 +++ lib-src/fakemail.c 2005/01/26 09:52:22 ＠＠ -34,7 +34,7 ＠＠ main (int argc, char *argv[]) #include <stdio.h> #include <stdlib.h> int -main () +main (int argc, char *argv[]) { /* Linux /bin/mail, if it exists, is NOT the Unix v7 mail that fakemail depends on! This causes garbled mail. Better to

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 January 2005