carbon2-commit: Supply check_string_lessp_nokey explicitly to list_sort(), #'apropos-internal
14 years
Aidan Kehoe
Aidan Kehoe
changeset: 5410:b5561bfd5061
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sun Feb 06 23:46:17 2011 +0000
files: src/ChangeLog src/symbols.c
description:
Supply check_string_lessp_nokey explicitly to list_sort(), #'apropos-internal
2011-02-06 Aidan Kehoe <kehoea(a)parhasard.net>
* symbols.c (Fapropos_internal):
Supply check_string_lessp_nokey explicitly as the CHECK_MERGE
argument to list_sort(), NULL no longer works. Thank you Mats
Lidell in IRC!
diff -r 94bbd4792049 -r b5561bfd5061 src/ChangeLog
--- a/src/ChangeLog Sat Feb 05 12:04:34 2011 +0000
+++ b/src/ChangeLog Sun Feb 06 23:46:17 2011 +0000
＠＠ -1,3 +1,10 ＠＠
+2011-02-06 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * symbols.c (Fapropos_internal):
+ Supply check_string_lessp_nokey explicitly as the CHECK_MERGE
+ argument to list_sort(), NULL no longer works. Thank you Mats
+ Lidell in IRC!
+
2011-02-05 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c:
diff -r 94bbd4792049 -r b5561bfd5061 src/symbols.c
--- a/src/symbols.c Sat Feb 05 12:04:34 2011 +0000
+++ b/src/symbols.c Sun Feb 06 23:46:17 2011 +0000
＠＠ -508,8 +508,8 ＠＠
closure.accumulation = Qnil;
GCPRO1 (closure.accumulation);
map_obarray (Vobarray, apropos_mapper, &closure);
- closure.accumulation = list_sort (closure.accumulation, NULL, Qstring_lessp,
- Qidentity);
+ closure.accumulation = list_sort (closure.accumulation,
+ check_string_lessp_nokey, Qnil, Qnil);
UNGCPRO;
return closure.accumulation;
}
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Have #'sort*, #'merge use the same test approach as functions from cl-seq.el
14 years
Aidan Kehoe
Aidan Kehoe
changeset: 5409:94bbd4792049
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sat Feb 05 12:04:34 2011 +0000
files: src/ChangeLog src/abbrev.c src/dired.c src/fileio.c src/fns.c src/fontcolor-msw.c src/keymap.c src/lisp.h
description:
Have #'sort*, #'merge use the same test approach as functions from cl-seq.el
2011-02-05 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c:
* fns.c (check_lss_key, check_lss_key_car): New.
* fns.c (check_string_lessp_key check_string_lessp_key_car): New.
* fns.c (get_merge_predicate): New.
* fns.c (list_merge):
* fns.c (array_merge):
* fns.c (list_array_merge_into_list):
* fns.c (list_list_merge_into_array):
* fns.c (list_array_merge_into_array):
* fns.c (Fmerge):
* fns.c (list_sort):
* fns.c (array_sort):
* fns.c (FsortX):
* fns.c (syms_of_fns):
* lisp.h:
Move #'sort, #'merge to using the same test approach as is used in
the functions that take TEST, TEST-NOT and KEY arguments. This
allows us to avoid the Ffuncall() overhead when the most common
PREDICATE arguments are supplied, in particular #'< and
#'string-lessp.
* fontcolor-msw.c (sort_font_list_function):
* fontcolor-msw.c (mswindows_enumerate_fonts):
* dired.c:
* dired.c (Fdirectory_files):
* fileio.c:
* fileio.c (build_annotations):
* fileio.c (syms_of_fileio):
* keymap.c:
* keymap.c (keymap_submaps):
* keymap.c (map_keymap_sort_predicate):
* keymap.c (describe_map_sort_predicate):
* keymap.c (describe_map):
Change the various C predicates passed to list_sort () and
list_merge () to fit the new calling convention, returning
non-zero if the first argument is less than the second, zero
otherwise.
diff -r 239193591765 -r 94bbd4792049 src/ChangeLog
--- a/src/ChangeLog Sun Jan 30 14:27:31 2011 +0100
+++ b/src/ChangeLog Sat Feb 05 12:04:34 2011 +0000
＠＠ -1,3 +1,43 ＠＠
+2011-02-05 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * fns.c:
+ * fns.c (check_lss_key, check_lss_key_car): New.
+ * fns.c (check_string_lessp_key check_string_lessp_key_car): New.
+ * fns.c (get_merge_predicate): New.
+ * fns.c (list_merge):
+ * fns.c (array_merge):
+ * fns.c (list_array_merge_into_list):
+ * fns.c (list_list_merge_into_array):
+ * fns.c (list_array_merge_into_array):
+ * fns.c (Fmerge):
+ * fns.c (list_sort):
+ * fns.c (array_sort):
+ * fns.c (FsortX):
+ * fns.c (syms_of_fns):
+ * lisp.h:
+ Move #'sort, #'merge to using the same test approach as is used in
+ the functions that take TEST, TEST-NOT and KEY arguments. This
+ allows us to avoid the Ffuncall() overhead when the most common
+ PREDICATE arguments are supplied, in particular #'< and
+ #'string-lessp.
+
+ * fontcolor-msw.c (sort_font_list_function):
+ * fontcolor-msw.c (mswindows_enumerate_fonts):
+ * dired.c:
+ * dired.c (Fdirectory_files):
+ * fileio.c:
+ * fileio.c (build_annotations):
+ * fileio.c (syms_of_fileio):
+ * keymap.c:
+ * keymap.c (keymap_submaps):
+ * keymap.c (map_keymap_sort_predicate):
+ * keymap.c (describe_map_sort_predicate):
+ * keymap.c (describe_map):
+ Change the various C predicates passed to list_sort () and
+ list_merge () to fit the new calling convention, returning
+ non-zero if the first argument is less than the second, zero
+ otherwise.
+
2011-01-30 Michael Sperber <mike(a)xemacs.org>
* redisplay.h:
diff -r 239193591765 -r 94bbd4792049 src/abbrev.c
--- a/src/abbrev.c Sun Jan 30 14:27:31 2011 +0100
+++ b/src/abbrev.c Sat Feb 05 12:04:34 2011 +0000
＠＠ -524,7 +524,7 ＠＠
map_obarray (table, record_symbol, &symbols);
/* map_obarray (table, record_symbol, &closure); */
symbols = XCDR (symbols);
- symbols = list_sort (symbols, NULL, Qstring_lessp, Qidentity);
+ symbols = list_sort (symbols, check_string_lessp_nokey, Qnil, Qnil);
if (!NILP (readable))
{
diff -r 239193591765 -r 94bbd4792049 src/dired.c
--- a/src/dired.c Sun Jan 30 14:27:31 2011 +0100
+++ b/src/dired.c Sat Feb 05 12:04:34 2011 +0000
＠＠ -181,7 +181,7 ＠＠
unbind_to (speccount); /* This will close the dir */
if (NILP (nosort))
- list = list_sort (Fnreverse (list), NULL, Qstring_lessp, Qidentity);
+ list = list_sort (Fnreverse (list), check_string_lessp_nokey, Qnil, Qnil);
RETURN_UNGCPRO (list);
}
diff -r 239193591765 -r 94bbd4792049 src/fileio.c
--- a/src/fileio.c Sun Jan 30 14:27:31 2011 +0100
+++ b/src/fileio.c Sat Feb 05 12:04:34 2011 +0000
＠＠ -131,8 +131,6 ＠＠
Lisp_Object Qauto_save_hook;
Lisp_Object Qauto_save_error;
Lisp_Object Qauto_saving;
-
-Lisp_Object Qcar_less_than_car;
Lisp_Object Qcompute_buffer_file_truename;
＠＠ -3677,7 +3675,8 ＠＠
annotations = Qnil;
}
Flength (res); /* Check basic validity of return value */
- annotations = list_merge (annotations, res, NULL, Qlss, Qcar);
+ annotations = list_merge (annotations, res, check_lss_key_car, Qnil,
+ Qnil);
p = Fcdr (p);
}
＠＠ -3708,7 +3707,8 ＠＠
annotations = Qnil;
}
Flength (res);
- annotations = list_merge (annotations, res, NULL, Qlss, Qcar);
+ annotations = list_merge (annotations, res, check_lss_key_car, Qnil,
+ Qnil);
p = Fcdr (p);
}
＠＠ -4381,7 +4381,6 ＠＠
DEFSYMBOL (Qwrite_region);
DEFSYMBOL (Qverify_visited_file_modtime);
DEFSYMBOL (Qset_visited_file_modtime);
- DEFSYMBOL (Qcar_less_than_car); /* Vomitous! */
DEFSYMBOL (Qexcl);
DEFSYMBOL (Qauto_save_hook);
diff -r 239193591765 -r 94bbd4792049 src/fns.c
--- a/src/fns.c Sun Jan 30 14:27:31 2011 +0100
+++ b/src/fns.c Sat Feb 05 12:04:34 2011 +0000
＠＠ -63,7 +63,7 ＠＠
Lisp_Object Q_test_not, Q_count, Qnsubstitute, Qdelete_duplicates, Qmismatch;
Lisp_Object Qintersection, Qset_difference, Qnset_difference;
-Lisp_Object Qnunion, Qnintersection, Qsubsetp;
+Lisp_Object Qnunion, Qnintersection, Qsubsetp, Qcar_less_than_car;
Lisp_Object Qbase64_conversion_error;
＠＠ -210,9 +210,6 ＠＠
/* Various test functions for #'member*, #'assoc* and the other functions
that take both TEST and KEY arguments. */
-typedef Boolint (*check_test_func_t) (Lisp_Object test, Lisp_Object key,
- Lisp_Object item, Lisp_Object elt);
-
static Boolint
check_eq_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
Lisp_Object item, Lisp_Object elt)
＠＠ -439,7 +436,84 ＠＠
return !NILP (elt1);
}
-
+
+static Boolint
+check_lss_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
+ Lisp_Object elt1, Lisp_Object elt2)
+{
+ return bytecode_arithcompare (elt1, elt2) < 0;
+}
+
+static Boolint
+check_lss_key (Lisp_Object UNUSED (test), Lisp_Object key,
+ Lisp_Object elt1, Lisp_Object elt2)
+{
+ Lisp_Object args[] = { key, elt1, elt2 };
+ struct gcpro gcpro1;
+
+ GCPRO1 (args[0]);
+ gcpro1.nvars = countof (args);
+ args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
+ args[1] = key;
+ args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
+ UNGCPRO;
+
+ return bytecode_arithcompare (args[0], args[1]) < 0;
+}
+
+Boolint
+check_lss_key_car (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
+ Lisp_Object elt1, Lisp_Object elt2)
+{
+ struct gcpro gcpro1, gcpro2;
+
+ GCPRO2 (elt1, elt2);
+ elt1 = CONSP (elt1) ? XCAR (elt1) : Fcar (elt1);
+ elt2 = CONSP (elt2) ? XCAR (elt2) : Fcar (elt2);
+ UNGCPRO;
+
+ return bytecode_arithcompare (elt1, elt2) < 0;
+}
+
+Boolint
+check_string_lessp_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
+ Lisp_Object elt1, Lisp_Object elt2)
+{
+ return !NILP (Fstring_lessp (elt1, elt2));
+}
+
+static Boolint
+check_string_lessp_key (Lisp_Object UNUSED (test), Lisp_Object key,
+ Lisp_Object elt1, Lisp_Object elt2)
+{
+ Lisp_Object args[] = { key, elt1, elt2 };
+ struct gcpro gcpro1;
+
+ GCPRO1 (args[0]);
+ gcpro1.nvars = countof (args);
+ args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
+ args[1] = key;
+ args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
+ UNGCPRO;
+
+ return !NILP (Fstring_lessp (args[0], args[1]));
+}
+
+static Boolint
+check_string_lessp_key_car (Lisp_Object UNUSED (test),
+ Lisp_Object UNUSED (key),
+ Lisp_Object elt1, Lisp_Object elt2)
+{
+ struct gcpro gcpro1, gcpro2;
+
+ GCPRO2 (elt1, elt2);
+ elt1 = CONSP (elt1) ? XCAR (elt1) : Fcar (elt1);
+ elt2 = CONSP (elt2) ? XCAR (elt2) : Fcar (elt2);
+ UNGCPRO;
+
+ return !NILP (Fstring_lessp (elt1, elt2));
+}
+
static check_test_func_t
get_check_match_function_1 (Lisp_Object item,
Lisp_Object *test_inout, Lisp_Object test_not,
＠＠ -646,6 +720,72 ＠＠
test_not_unboundp_out, test_func_out);
}
+/* Given PREDICATE and KEY, return a C function pointer appropriate for use
+ in deciding whether one given elements of a sequence is less than
+ another. */
+
+static check_test_func_t
+get_merge_predicate (Lisp_Object predicate, Lisp_Object key)
+{
+ predicate = indirect_function (predicate, 1);
+
+ if (NILP (key))
+ {
+ key = Qidentity;
+ }
+ else
+ {
+ key = indirect_function (key, 1);
+ if (EQ (key, XSYMBOL_FUNCTION (Qidentity)))
+ {
+ key = Qidentity;
+ }
+ }
+
+ if (EQ (key, Qidentity) && EQ (predicate,
+ XSYMBOL_FUNCTION (Qcar_less_than_car)))
+ {
+ key = XSYMBOL_FUNCTION (Qcar);
+ predicate = XSYMBOL_FUNCTION (Qlss);
+ }
+
+ if (EQ (predicate, XSYMBOL_FUNCTION (Qlss)))
+ {
+ if (EQ (key, Qidentity))
+ {
+ return check_lss_nokey;
+ }
+
+ if (EQ (key, XSYMBOL_FUNCTION (Qcar)))
+ {
+ return check_lss_key_car;
+ }
+
+ return check_lss_key;
+ }
+
+ if (EQ (predicate, XSYMBOL_FUNCTION (Qstring_lessp)))
+ {
+ if (EQ (key, Qidentity))
+ {
+ return check_string_lessp_nokey;
+ }
+
+ if (EQ (key, XSYMBOL_FUNCTION (Qcar)))
+ {
+ return check_string_lessp_key_car;
+ }
+
+ return check_string_lessp_key;
+ }
+
+ if (EQ (key, Qidentity))
+ {
+ return check_other_nokey;
+ }
+
+ return check_match_other_key;
+}
DEFUN ("identity", Fidentity, 1, 1, 0, /*
Return the argument unchanged.
＠＠ -4694,58 +4834,10 ＠＠
return result;
}
-static Lisp_Object
-c_merge_predicate_key (Lisp_Object obj1, Lisp_Object obj2,
- Lisp_Object pred, Lisp_Object key_func)
-{
- struct gcpro gcpro1;
- Lisp_Object args[3];
-
- /* We could use call2() and call3() here, but we're called O(nlogn) times
- for a sequence of length n, it make some sense to inline them. */
- args[0] = key_func;
- args[1] = obj1;
- args[2] = Qnil;
-
- GCPRO1 (args[0]);
- gcpro1.nvars = countof (args);
-
- obj1 = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
-
- args[1] = obj2;
- obj2 = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
-
- args[0] = pred;
- args[1] = obj1;
- args[2] = obj2;
-
- RETURN_UNGCPRO (IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args)));
-}
-
-static Lisp_Object
-c_merge_predicate_nokey (Lisp_Object obj1, Lisp_Object obj2,
- Lisp_Object pred, Lisp_Object UNUSED (key_func))
-{
- struct gcpro gcpro1;
- Lisp_Object args[3];
-
- /* This is (almost) the implementation of call2, it makes some sense to
- inline it here. */
- args[0] = pred;
- args[1] = obj1;
- args[2] = obj2;
-
- GCPRO1 (args[0]);
- gcpro1.nvars = countof (args);
-
- RETURN_UNGCPRO (IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args)));
-}
-
Lisp_Object
list_merge (Lisp_Object org_l1, Lisp_Object org_l2,
- Lisp_Object (*c_predicate) (Lisp_Object, Lisp_Object,
- Lisp_Object, Lisp_Object),
- Lisp_Object predicate, Lisp_Object key_func)
+ check_test_func_t check_merge,
+ Lisp_Object predicate, Lisp_Object key)
{
Lisp_Object value;
Lisp_Object tail;
＠＠ -4762,15 +4854,8 ＠＠
tortoises[0] = org_l1;
tortoises[1] = org_l2;
- if (NULL == c_predicate)
- {
- c_predicate = EQ (key_func, Qidentity) ?
- c_merge_predicate_nokey : c_merge_predicate_key;
- }
-
- /* It is sufficient to protect org_l1 and org_l2.
- When l1 and l2 are updated, we copy the new values
- back into the org_ vars. */
+ /* It is sufficient to protect org_l1 and org_l2. When l1 and l2 are
+ updated, we copy the new values back into the org_ vars. */
GCPRO5 (org_l1, org_l2, predicate, value, tortoises[0]);
gcpro5.nvars = 2;
＠＠ -4794,7 +4879,7 ＠＠
return value;
}
- if (NILP (c_predicate (Fcar (l2), Fcar (l1), predicate, key_func)))
+ if (check_merge (predicate, key, Fcar (l2), Fcar (l1)) == 0)
{
tem = l1;
l1 = Fcdr (l1);
＠＠ -4856,9 +4941,8 ＠＠
array_merge (Lisp_Object *dest, Elemcount dest_len,
Lisp_Object *front, Elemcount front_len,
Lisp_Object *back, Elemcount back_len,
- Lisp_Object (*c_predicate) (Lisp_Object, Lisp_Object,
- Lisp_Object, Lisp_Object),
- Lisp_Object predicate, Lisp_Object key_func)
+ check_test_func_t check_merge,
+ Lisp_Object predicate, Lisp_Object key)
{
Elemcount ii, fronting, backing;
Lisp_Object *front_staging = front;
＠＠ -4920,8 +5004,8 ＠＠
return;
}
- if (NILP (c_predicate (back_staging[backing], front_staging[fronting],
- predicate, key_func)))
+ if (check_merge (predicate, key, back_staging[backing],
+ front_staging[fronting]) == 0)
{
dest[ii] = front_staging[fronting];
++fronting;
＠＠ -4939,11 +5023,8 ＠＠
static Lisp_Object
list_array_merge_into_list (Lisp_Object list,
Lisp_Object *array, Elemcount array_len,
- Lisp_Object (*c_predicate) (Lisp_Object,
- Lisp_Object,
- Lisp_Object,
- Lisp_Object),
- Lisp_Object predicate, Lisp_Object key_func,
+ check_test_func_t check_merge,
+ Lisp_Object predicate, Lisp_Object key,
Boolint reverse_order)
{
Lisp_Object tail = Qnil, value = Qnil, tortoise = list;
＠＠ -4982,10 +5063,8 ＠＠
if (reverse_order ?
- !NILP (c_predicate (Fcar (list), array [array_index], predicate,
- key_func)) :
- NILP (c_predicate (array [array_index], Fcar (list), predicate,
- key_func)))
+ check_merge (predicate, key, Fcar (list), array [array_index])
+ : !check_merge (predicate, key, array [array_index], Fcar (list)))
{
if (NILP (tail))
{
＠＠ -5031,11 +5110,8 ＠＠
static void
list_list_merge_into_array (Lisp_Object *output, Elemcount output_len,
Lisp_Object list_one, Lisp_Object list_two,
- Lisp_Object (*c_predicate) (Lisp_Object,
- Lisp_Object,
- Lisp_Object,
- Lisp_Object),
- Lisp_Object predicate, Lisp_Object key_func)
+ check_test_func_t check_merge,
+ Lisp_Object predicate, Lisp_Object key)
{
Elemcount output_index = 0;
＠＠ -5061,8 +5137,8 ＠＠
return;
}
- if (NILP (c_predicate (Fcar (list_two), Fcar (list_one), predicate,
- key_func)))
+ if (check_merge (predicate, key, Fcar (list_two), Fcar (list_one))
+ == 0)
{
output [output_index] = XCAR (list_one);
list_one = XCDR (list_one);
＠＠ -5083,11 +5159,8 ＠＠
list_array_merge_into_array (Lisp_Object *output, Elemcount output_len,
Lisp_Object list,
Lisp_Object *array, Elemcount array_len,
- Lisp_Object (*c_predicate) (Lisp_Object,
- Lisp_Object,
- Lisp_Object,
- Lisp_Object),
- Lisp_Object predicate, Lisp_Object key_func,
+ check_test_func_t check_merge,
+ Lisp_Object predicate, Lisp_Object key,
Boolint reverse_order)
{
Elemcount output_index = 0, array_index = 0;
＠＠ -5121,10 +5194,8 ＠＠
}
if (reverse_order ?
- !NILP (c_predicate (Fcar (list), array [array_index], predicate,
- key_func)) :
- NILP (c_predicate (array [array_index], Fcar (list), predicate,
- key_func)))
+ check_merge (predicate, key, Fcar (list), array [array_index]) :
+ !check_merge (predicate, key, array [array_index], Fcar (list)))
{
output [output_index] = XCAR (list);
list = XCDR (list);
＠＠ -5172,8 +5243,7 ＠＠
{
Lisp_Object type = args[0], sequence_one = args[1], sequence_two = args[2],
predicate = args[3], result = Qnil;
- Lisp_Object (*c_predicate) (Lisp_Object, Lisp_Object, Lisp_Object,
- Lisp_Object);
+ check_test_func_t check_merge = NULL;
PARSE_KEYWORDS (Fmerge, nargs, args, 1, (key), NULL);
＠＠ -5182,8 +5252,7 ＠＠
CHECK_KEY_ARGUMENT (key);
- c_predicate = EQ (key, Qidentity) ?
- c_merge_predicate_nokey : c_merge_predicate_key;
+ check_merge = get_merge_predicate (predicate, key);
if (EQ (type, Qlist) && (LISTP (sequence_one) || LISTP (sequence_two)))
{
＠＠ -5199,7 +5268,7 ＠＠
}
else if (CONSP (sequence_one) && CONSP (sequence_two))
{
- result = list_merge (sequence_one, sequence_two, c_predicate,
+ result = list_merge (sequence_one, sequence_two, check_merge,
predicate, key);
}
else
＠＠ -5241,8 +5310,7 ＠＠
result = list_array_merge_into_list (sequence_one,
array_storage, array_length,
- c_predicate,
- predicate, key,
+ check_merge, predicate, key,
reverse_order);
}
}
＠＠ -5306,8 +5374,7 ＠＠
{
list_list_merge_into_array (output + 1, output_len - 1,
sequence_one, sequence_two,
- c_predicate, predicate,
- key);
+ check_merge, predicate, key);
}
else if (LISTP (sequence_one))
{
＠＠ -5315,8 +5382,7 ＠＠
sequence_one,
sequence_two_storage,
sequence_two_len,
- c_predicate, predicate,
- key, 0);
+ check_merge, predicate, key, 0);
}
else if (LISTP (sequence_two))
{
＠＠ -5324,15 +5390,14 ＠＠
sequence_two,
sequence_one_storage,
sequence_one_len,
- c_predicate, predicate,
- key, 1);
+ check_merge, predicate, key, 1);
}
else
{
array_merge (output + 1, output_len - 1,
sequence_one_storage, sequence_one_len,
sequence_two_storage, sequence_two_len,
- c_predicate, predicate,
+ check_merge, predicate,
key);
}
＠＠ -5349,13 +5414,9 ＠＠
return result;
}
-/* The sort function should return non-nil if OBJ1 < OBJ2, nil otherwise.
- NOTE: This is backwards from the way qsort() works. */
-Lisp_Object
-list_sort (Lisp_Object list,
- Lisp_Object (*c_predicate) (Lisp_Object, Lisp_Object,
- Lisp_Object, Lisp_Object),
- Lisp_Object predicate, Lisp_Object key_func)
+Lisp_Object
+list_sort (Lisp_Object list, check_test_func_t check_merge,
+ Lisp_Object predicate, Lisp_Object key)
{
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
Lisp_Object back, tem;
＠＠ -5365,29 +5426,22 ＠＠
if (XINT (len) < 2)
return list;
- if (NULL == c_predicate)
- {
- c_predicate = EQ (key_func, Qidentity) ? c_merge_predicate_nokey :
- c_merge_predicate_key;
- }
-
len = make_int (XINT (len) / 2 - 1);
tem = Fnthcdr (len, list);
back = Fcdr (tem);
Fsetcdr (tem, Qnil);
- GCPRO4 (front, back, predicate, key_func);
- front = list_sort (front, c_predicate, predicate, key_func);
- back = list_sort (back, c_predicate, predicate, key_func);
-
- RETURN_UNGCPRO (list_merge (front, back, c_predicate, predicate, key_func));
+ GCPRO4 (front, back, predicate, key);
+ front = list_sort (front, check_merge, predicate, key);
+ back = list_sort (back, check_merge, predicate, key);
+
+ RETURN_UNGCPRO (list_merge (front, back, check_merge, predicate, key));
}
static void
array_sort (Lisp_Object *array, Elemcount array_len,
- Lisp_Object (*c_predicate) (Lisp_Object, Lisp_Object,
- Lisp_Object, Lisp_Object),
- Lisp_Object predicate, Lisp_Object key_func)
+ check_test_func_t check_merge,
+ Lisp_Object predicate, Lisp_Object key)
{
Elemcount split;
＠＠ -5396,11 +5450,11 ＠＠
split = array_len / 2;
- array_sort (array, split, c_predicate, predicate, key_func);
- array_sort (array + split, array_len - split, c_predicate, predicate,
- key_func);
+ array_sort (array, split, check_merge, predicate, key);
+ array_sort (array + split, array_len - split, check_merge, predicate,
+ key);
array_merge (array, array_len, array, split, array + split,
- array_len - split, c_predicate, predicate, key_func);
+ array_len - split, check_merge, predicate, key);
}
DEFUN ("sort*", FsortX, 2, MANY, 0, /*
＠＠ -5423,8 +5477,7 ＠＠
{
Lisp_Object sequence = args[0], predicate = args[1];
Lisp_Object *sequence_carray;
- Lisp_Object (*c_predicate) (Lisp_Object, Lisp_Object, Lisp_Object,
- Lisp_Object);
+ check_test_func_t check_merge = NULL;
Elemcount sequence_len, i;
PARSE_KEYWORDS (FsortX, nargs, args, 1, (key), NULL);
＠＠ -5433,17 +5486,16 ＠＠
CHECK_KEY_ARGUMENT (key);
- c_predicate = EQ (key, Qidentity) ?
- c_merge_predicate_nokey : c_merge_predicate_key;
+ check_merge = get_merge_predicate (predicate, key);
if (LISTP (sequence))
{
- sequence = list_sort (sequence, c_predicate, predicate, key);
+ sequence = list_sort (sequence, check_merge, predicate, key);
}
else if (VECTORP (sequence))
{
array_sort (XVECTOR_DATA (sequence), XVECTOR_LENGTH (sequence),
- c_predicate, predicate, key);
+ check_merge, predicate, key);
}
else if (STRINGP (sequence))
{
＠＠ -5454,7 +5506,7 ＠＠
STRING_DATA_TO_OBJECT_ARRAY (strdata, sequence_carray, i, sequence_len);
/* No GCPRO necessary, characters are immediate. */
- array_sort (sequence_carray, sequence_len, c_predicate, predicate, key);
+ array_sort (sequence_carray, sequence_len, check_merge, predicate, key);
strdata = XSTRING_DATA (sequence);
＠＠ -5476,7 +5528,7 ＠＠
BIT_VECTOR_TO_OBJECT_ARRAY (v, sequence_carray, i, sequence_len);
/* No GCPRO necessary, bits are immediate. */
- array_sort (sequence_carray, sequence_len, c_predicate, predicate, key);
+ array_sort (sequence_carray, sequence_len, check_merge, predicate, key);
for (i = 0; i < sequence_len; ++i)
{
＠＠ -11698,6 +11750,7 ＠＠
DEFSYMBOL (Qintersection);
DEFSYMBOL (Qnintersection);
DEFSYMBOL (Qsubsetp);
+ DEFSYMBOL (Qcar_less_than_car);
DEFSYMBOL (Qset_difference);
DEFSYMBOL (Qnset_difference);
DEFSYMBOL (Qnunion);
diff -r 239193591765 -r 94bbd4792049 src/fontcolor-msw.c
--- a/src/fontcolor-msw.c Sun Jan 30 14:27:31 2011 +0100
+++ b/src/fontcolor-msw.c Sat Feb 05 12:04:34 2011 +0000
＠＠ -1198,10 +1198,9 ＠＠
"family::::charset" for TrueType fonts, "family::size::charset"
otherwise. */
-static Lisp_Object
-sort_font_list_function (Lisp_Object obj1, Lisp_Object obj2,
- Lisp_Object UNUSED (pred),
- Lisp_Object UNUSED (key_function))
+static Boolint
+sort_font_list_function (Lisp_Object UNUSED (pred), Lisp_Object UNUSED (key),
+ Lisp_Object obj1, Lisp_Object obj2)
{
Ibyte *font1, *font2;
Ibyte *c1, *c2;
＠＠ -1215,16 +1214,16 ＠＠
5. Courier New over other families.
*/
- /* The sort function should return non-nil if OBJ1 < OBJ2, nil otherwise.
- NOTE: This is backwards from the way qsort() works. */
+ /* The sort function should return non-zero if OBJ1 < OBJ2, zero
+ otherwise. */
t1 = !NILP (XCDR (obj1));
t2 = !NILP (XCDR (obj2));
if (t1 && !t2)
- return Qt;
+ return 1;
if (t2 && !t1)
- return Qnil;
+ return 0;
font1 = XSTRING_DATA (XCAR (obj1));
font2 = XSTRING_DATA (XCAR (obj2));
＠＠ -1236,9 +1235,9 ＠＠
t2 = !qxestrcasecmp_ascii (c2 + 1, "western");
if (t1 && !t2)
- return Qt;
+ return 1;
if (t2 && !t1)
- return Qnil;
+ return 0;
c1 -= 2;
c2 -= 2;
＠＠ -1246,9 +1245,9 ＠＠
t2 = *c2 == ':';
if (t1 && !t2)
- return Qt;
+ return 1;
if (t2 && !t1)
- return Qnil;
+ return 0;
if (!t1 && !t2)
{
＠＠ -1261,25 +1260,25 ＠＠
t2 = qxeatoi (c2 + 1) - 10;
if (abs (t1) < abs (t2))
- return Qt;
+ return 1;
else if (abs (t2) < abs (t1))
- return Qnil;
+ return 0;
else if (t1 < t2)
/* Prefer a smaller font over a larger one just as far away
because the smaller one won't upset the total line height if it's
just a few chars. */
- return Qt;
+ return 1;
}
t1 = !qxestrncasecmp_ascii (font1, "courier new:", 12);
t2 = !qxestrncasecmp_ascii (font2, "courier new:", 12);
if (t1 && !t2)
- return Qt;
+ return 1;
if (t2 && !t1)
- return Qnil;
+ return 0;
- return Qnil;
+ return 0;
}
/*
diff -r 239193591765 -r 94bbd4792049 src/keymap.c
--- a/src/keymap.c Sun Jan 30 14:27:31 2011 +0100
+++ b/src/keymap.c Sat Feb 05 12:04:34 2011 +0000
＠＠ -737,10 +737,9 ＠＠
return 0;
}
-static Lisp_Object map_keymap_sort_predicate (Lisp_Object obj1,
- Lisp_Object obj2,
- Lisp_Object pred,
- Lisp_Object key_func);
+static Boolint map_keymap_sort_predicate (Lisp_Object pred, Lisp_Object key,
+ Lisp_Object obj1, Lisp_Object obj2);
+
static Lisp_Object
keymap_submaps (Lisp_Object keymap)
＠＠ -764,7 +763,7 ＠＠
&keymap_submaps_closure);
/* keep it sorted so that the result of accessible-keymaps is ordered */
k->sub_maps_cache = list_sort (result, map_keymap_sort_predicate,
- Qnil, Qidentity);
+ Qnil, Qnil);
UNGCPRO;
}
return k->sub_maps_cache;
＠＠ -2896,10 +2895,9 ＠＠
/* used by map_keymap_sorted(), describe_map_sort_predicate(),
and keymap_submaps().
*/
-static Lisp_Object
-map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2,
- Lisp_Object UNUSED (pred),
- Lisp_Object UNUSED (key_func))
+static Boolint
+map_keymap_sort_predicate (Lisp_Object UNUSED (pred), Lisp_Object UNUSED (key),
+ Lisp_Object obj1, Lisp_Object obj2)
{
/* obj1 and obj2 are conses with keysyms in their cars. Cdrs are ignored.
*/
＠＠ -2912,12 +2910,12 ＠＠
obj2 = XCAR (obj2);
if (EQ (obj1, obj2))
- return Qnil;
+ return 0;
bit1 = MODIFIER_HASH_KEY_BITS (obj1);
bit2 = MODIFIER_HASH_KEY_BITS (obj2);
- /* If either is a symbol with a Qcharacter_of_keysym property, then sort it by
- that code instead of alphabetically.
+ /* If either is a symbol with a Qcharacter_of_keysym property, then sort
+ it by that code instead of alphabetically.
*/
if (! bit1 && SYMBOLP (obj1))
{
＠＠ -2942,7 +2940,7 ＠＠
/* all symbols (non-ASCIIs) come after characters (ASCIIs) */
if (XTYPE (obj1) != XTYPE (obj2))
- return SYMBOLP (obj2) ? Qt : Qnil;
+ return SYMBOLP (obj2);
if (! bit1 && CHARP (obj1)) /* they're both ASCII */
{
＠＠ -2950,24 +2948,24 ＠＠
int o2 = XCHAR (obj2);
if (o1 == o2 && /* If one started out as a symbol and the */
sym1_p != sym2_p) /* other didn't, the symbol comes last. */
- return sym2_p ? Qt : Qnil;
-
- return o1 < o2 ? Qt : Qnil; /* else just compare them */
+ return sym2_p;
+
+ return o1 < o2; /* else just compare them */
}
/* else they're both symbols. If they're both buckys, then order them. */
if (bit1 && bit2)
- return bit1 < bit2 ? Qt : Qnil;
+ return bit1 < bit2;
/* if only one is a bucky, then it comes later */
if (bit1 || bit2)
- return bit2 ? Qt : Qnil;
+ return bit2;
/* otherwise, string-sort them. */
{
Ibyte *s1 = XSTRING_DATA (XSYMBOL (obj1)->name);
Ibyte *s2 = XSTRING_DATA (XSYMBOL (obj2)->name);
- return 0 > qxestrcmp (s1, s2) ? Qt : Qnil;
+ return 0 > qxestrcmp (s1, s2);
}
}
＠＠ -4087,10 +4085,10 ＠＠
*(closure->list));
}
-
-static Lisp_Object
-describe_map_sort_predicate (Lisp_Object obj1, Lisp_Object obj2,
- Lisp_Object pred, Lisp_Object key_func)
+static Boolint
+describe_map_sort_predicate (Lisp_Object pred, Lisp_Object key_func,
+ Lisp_Object obj1, Lisp_Object obj2)
+
{
/* obj1 and obj2 are conses of the form
( ( <keysym> . <modifiers> ) . <binding> )
＠＠ -4102,7 +4100,7 ＠＠
bit1 = XINT (XCDR (obj1));
bit2 = XINT (XCDR (obj2));
if (bit1 != bit2)
- return bit1 < bit2 ? Qt : Qnil;
+ return bit1 < bit2;
else
return map_keymap_sort_predicate (obj1, obj2, pred, key_func);
}
＠＠ -4212,7 +4210,7 ＠＠
if (!NILP (list))
{
- list = list_sort (list, describe_map_sort_predicate, Qnil, Qidentity);
+ list = list_sort (list, describe_map_sort_predicate, Qnil, Qnil);
buffer_insert_ascstring (buf, "\n");
while (!NILP (list))
{
diff -r 239193591765 -r 94bbd4792049 src/lisp.h
--- a/src/lisp.h Sun Jan 30 14:27:31 2011 +0100
+++ b/src/lisp.h Sat Feb 05 12:04:34 2011 +0000
＠＠ -5248,15 +5248,19 ＠＠
EXFUN (Fsubseq, 3);
EXFUN (Fvalid_plist_p, 1);
+extern Boolint check_lss_key_car (Lisp_Object, Lisp_Object, Lisp_Object,
+ Lisp_Object);
+extern Boolint check_string_lessp_nokey (Lisp_Object, Lisp_Object,
+ Lisp_Object, Lisp_Object);
+
+typedef Boolint (*check_test_func_t) (Lisp_Object test, Lisp_Object key,
+ Lisp_Object item, Lisp_Object elt);
+
Lisp_Object list_merge (Lisp_Object org_l1, Lisp_Object org_l2,
- Lisp_Object (*c_predicate) (Lisp_Object o1,
- Lisp_Object o2,
- Lisp_Object pred,
- Lisp_Object keyf),
+ check_test_func_t check_merge,
Lisp_Object predicate, Lisp_Object key_func);
Lisp_Object list_sort (Lisp_Object list,
- Lisp_Object (*c_predicate) (Lisp_Object, Lisp_Object,
- Lisp_Object, Lisp_Object),
+ check_test_func_t check_merge,
Lisp_Object predicate, Lisp_Object key_func);
void bump_string_modiff (Lisp_Object);
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Unbreak font-lock during `revert-buffer.
14 years
Michael Sperber
Michael Sperber
changeset: 5408:239193591765
user: Mike Sperber <sperber(a)deinprogramm.de>
date: Sun Jan 30 14:27:31 2011 +0100
files: lisp/ChangeLog lisp/font-lock.el
description:
Unbreak font-lock during `revert-buffer.
2011-01-30 Mike Sperber <mike(a)xemacs.org>
* font-lock.el (font-lock-fontify-pending-extents): Don't fail if
`font-lock-mode' is unset, which can happen in the middle of
`revert-buffer'.
This fixes Issue622.
diff -r 39304a35b6b3 -r 239193591765 lisp/ChangeLog
--- a/lisp/ChangeLog Sun Jan 30 12:20:19 2011 +0100
+++ b/lisp/ChangeLog Sun Jan 30 14:27:31 2011 +0100
＠＠ -1,3 +1,9 ＠＠
+2011-01-30 Mike Sperber <mike(a)xemacs.org>
+
+ * font-lock.el (font-lock-fontify-pending-extents): Don't fail if
+ `font-lock-mode' is unset, which can happen in the middle of
+ `revert-buffer'.
+
2011-01-23 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-macs.el (delete):
diff -r 39304a35b6b3 -r 239193591765 lisp/font-lock.el
--- a/lisp/font-lock.el Sun Jan 30 12:20:19 2011 +0100
+++ b/lisp/font-lock.el Sun Jan 30 14:27:31 2011 +0100
＠＠ -1477,51 +1477,55 ＠＠
(save-match-data
(maphash
#'(lambda (buffer dummy)
- ;; remove first, to avoid infinite reprocessing if error
- (remhash buffer font-lock-pending-buffer-table)
- (when (buffer-live-p buffer)
- (clear-range-table font-lock-range-table)
- (with-current-buffer buffer
- (save-excursion
- (save-restriction
- ;; if we don't widen, then the C code in
- ;; syntactically-sectionize will fail to realize that
- ;; we're inside a comment. #### We don't actually use
- ;; syntactically-sectionize any more. Do we still
- ;; need the widen?
- (widen)
- (map-extents
- #'(lambda (ex dummy-maparg)
- ;; first expand the ranges to full lines,
- ;; because that is what will be fontified;
- ;; then use a range table to merge the
- ;; ranges. (we could also do this simply using
- ;; text properties. the range table code was
- ;; here from a previous version of this code
- ;; and works just as well.)
- (let* ((beg (extent-start-position ex))
- (end (extent-end-position ex))
- (beg (progn (goto-char beg)
- (beginning-of-line)
- (point)))
- (end (progn (goto-char end)
- (forward-line 1)
- (point))))
- (put-range-table beg end t
- font-lock-range-table)))
- nil nil nil nil nil 'font-lock-pending t)
- ;; clear all pending extents first in case of error below.
- (put-text-property (point-min) (point-max)
- 'font-lock-pending nil)
- (map-range-table
- #'(lambda (beg end val)
+ (catch 'exit
+ ;; font-lock-mode may be temporarily unset during `revert-buffer'
+ (if (not font-lock-mode)
+ (throw 'exit nil))
+ ;; remove first, to avoid infinite reprocessing if error
+ (remhash buffer font-lock-pending-buffer-table)
+ (when (buffer-live-p buffer)
+ (clear-range-table font-lock-range-table)
+ (with-current-buffer buffer
+ (save-excursion
+ (save-restriction
+ ;; if we don't widen, then the C code in
+ ;; syntactically-sectionize will fail to realize that
+ ;; we're inside a comment. #### We don't actually use
+ ;; syntactically-sectionize any more. Do we still
+ ;; need the widen?
+ (widen)
+ (map-extents
+ #'(lambda (ex dummy-maparg)
+ ;; first expand the ranges to full lines,
+ ;; because that is what will be fontified;
+ ;; then use a range table to merge the
+ ;; ranges. (we could also do this simply using
+ ;; text properties. the range table code was
+ ;; here from a previous version of this code
+ ;; and works just as well.)
+ (let* ((beg (extent-start-position ex))
+ (end (extent-end-position ex))
+ (beg (progn (goto-char beg)
+ (beginning-of-line)
+ (point)))
+ (end (progn (goto-char end)
+ (forward-line 1)
+ (point))))
+ (put-range-table beg end t
+ font-lock-range-table)))
+ nil nil nil nil nil 'font-lock-pending t)
+ ;; clear all pending extents first in case of error below.
+ (put-text-property (point-min) (point-max)
+ 'font-lock-pending nil)
+ (map-range-table
+ #'(lambda (beg end val)
;; This creates some unnecessary progress gauges.
;; (if (and (= beg (point-min))
;; (= end (point-max)))
;; (font-lock-fontify-buffer)
;; (font-lock-fontify-region beg end)))
- (font-lock-fontify-region beg end))
- font-lock-range-table))))))
+ (font-lock-fontify-region beg end))
+ font-lock-range-table)))))))
font-lock-pending-buffer-table)))
;; Syntactic fontification functions.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Don't commit suicide when an X device dies.
14 years
Michael Sperber
Michael Sperber
changeset: 5407:39304a35b6b3
parent: 5405:fd441b85d760
user: Mike Sperber <sperber(a)deinprogramm.de>
date: Sun Jan 30 12:20:19 2011 +0100
files: src/ChangeLog src/device-x.c src/eval.c src/lisp.h src/redisplay.c src/redisplay.h
description:
Don't commit suicide when an X device dies.
2011-01-30 Michael Sperber <mike(a)xemacs.org>
* redisplay.h:
* redisplay.c:
(redisplay_cancel_ritual_suicide):
* eval.c (throw_or_bomb_out_unsafe):
* device-x.c (x_IO_error_handler): Don't commit suicide when an X
device dies.
diff -r fd441b85d760 -r 39304a35b6b3 src/ChangeLog
--- a/src/ChangeLog Sun Jan 23 13:56:37 2011 +0000
+++ b/src/ChangeLog Sun Jan 30 12:20:19 2011 +0100
＠＠ -1,3 +1,12 ＠＠
+2011-01-30 Michael Sperber <mike(a)xemacs.org>
+
+ * redisplay.h:
+ * redisplay.c:
+ (redisplay_cancel_ritual_suicide):
+ * eval.c (throw_or_bomb_out_unsafe):
+ * device-x.c (x_IO_error_handler): Don't commit suicide when an X
+ device dies.
+
2011-01-23 Aidan Kehoe <kehoea(a)parhasard.net>
* file-coding.c (complex_vars_of_file_coding):
diff -r fd441b85d760 -r 39304a35b6b3 src/device-x.c
--- a/src/device-x.c Sun Jan 23 13:56:37 2011 +0000
+++ b/src/device-x.c Sun Jan 30 12:20:19 2011 +0100
＠＠ -1255,7 +1255,8 ＠＠
DEVICE_X_BEING_DELETED (d) = 1;
}
- throw_or_bomb_out (Qtop_level, Qnil, 0, Qnil, Qnil);
+ redisplay_cancel_ritual_suicide();
+ throw_or_bomb_out_unsafe (Qtop_level, Qnil, 0, Qnil, Qnil);
RETURN_NOT_REACHED (0);
}
diff -r fd441b85d760 -r 39304a35b6b3 src/eval.c
--- a/src/eval.c Sun Jan 23 13:56:37 2011 +0000
+++ b/src/eval.c Sun Jan 30 12:20:19 2011 +0100
＠＠ -1802,22 +1802,13 ＠＠
LONGJMP (c->jmp, 1);
}
-DECLARE_DOESNT_RETURN (throw_or_bomb_out (Lisp_Object, Lisp_Object, int,
+DECLARE_DOESNT_RETURN (throw_or_bomb_out_unsafe (Lisp_Object, Lisp_Object, int,
Lisp_Object, Lisp_Object));
DOESNT_RETURN
-throw_or_bomb_out (Lisp_Object tag, Lisp_Object val, int bomb_out_p,
- Lisp_Object sig, Lisp_Object data)
-{
-#ifdef DEFEND_AGAINST_THROW_RECURSION
- /* die if we recurse more than is reasonable */
- assert (++throw_level <= 20);
-#endif
-
-#ifdef ERROR_CHECK_TRAPPING_PROBLEMS
- check_proper_critical_section_nonlocal_exit_protection ();
-#endif
-
+throw_or_bomb_out_unsafe (Lisp_Object tag, Lisp_Object val, int bomb_out_p,
+ Lisp_Object sig, Lisp_Object data)
+{
/* If bomb_out_p is t, this is being called from Fsignal as a
"last resort" when there is no handler for this error and
the debugger couldn't be invoked, so we are throwing to
＠＠ -1856,6 +1847,24 ＠＠
else
call1 (Qreally_early_error_handler, Fcons (sig, data));
}
+}
+
+DECLARE_DOESNT_RETURN (throw_or_bomb_out (Lisp_Object, Lisp_Object, int,
+ Lisp_Object, Lisp_Object));
+
+DOESNT_RETURN
+throw_or_bomb_out (Lisp_Object tag, Lisp_Object val, int bomb_out_p,
+ Lisp_Object sig, Lisp_Object data)
+{
+#ifdef DEFEND_AGAINST_THROW_RECURSION
+ /* die if we recurse more than is reasonable */
+ assert (++throw_level <= 20);
+#endif
+
+#ifdef ERROR_CHECK_TRAPPING_PROBLEMS
+ check_proper_critical_section_nonlocal_exit_protection ();
+#endif
+ throw_or_bomb_out_unsafe (tag, val, bomb_out_p, sig, data);
}
/* See above, where CATCHLIST is defined, for a description of how
diff -r fd441b85d760 -r 39304a35b6b3 src/lisp.h
--- a/src/lisp.h Sun Jan 23 13:56:37 2011 +0000
+++ b/src/lisp.h Sun Jan 30 12:20:19 2011 +0100
＠＠ -4722,6 +4722,10 ＠＠
Lisp_Object, int,
Lisp_Object, Lisp_Object));
+MODULE_API DECLARE_DOESNT_RETURN (throw_or_bomb_out_unsafe (Lisp_Object,
+ Lisp_Object, int,
+ Lisp_Object, Lisp_Object));
+
MODULE_API DECLARE_DOESNT_RETURN (signal_error_1 (Lisp_Object, Lisp_Object));
void maybe_signal_error_1 (Lisp_Object, Lisp_Object, Lisp_Object,
Error_Behavior);
diff -r fd441b85d760 -r 39304a35b6b3 src/redisplay.c
--- a/src/redisplay.c Sun Jan 23 13:56:37 2011 +0000
+++ b/src/redisplay.c Sun Jan 30 12:20:19 2011 +0100
＠＠ -6688,12 +6688,25 ＠＠
unbind_to (depth);
}
+static int the_ritual_suicide_has_been_cancelled = 0;
+
+void
+redisplay_cancel_ritual_suicide(void)
+{
+ the_ritual_suicide_has_been_cancelled = 1;
+}
+
#ifdef ERROR_CHECK_TRAPPING_PROBLEMS
static Lisp_Object
commit_ritual_suicide (Lisp_Object UNUSED (ceci_nest_pas_une_pipe))
{
- assert (!in_display);
+ if (!the_ritual_suicide_has_been_cancelled)
+ {
+ assert (!in_display);
+ }
+ else
+ the_ritual_suicide_has_been_cancelled = 0;
return Qnil;
}
diff -r fd441b85d760 -r 39304a35b6b3 src/redisplay.h
--- a/src/redisplay.h Sun Jan 23 13:56:37 2011 +0000
+++ b/src/redisplay.h Sun Jan 30 12:20:19 2011 +0100
＠＠ -848,4 +848,6 ＠＠
int enter_redisplay_critical_section_if (Boolint from_outside);
void exit_redisplay_critical_section_if (Boolint from_outside, int depth);
+void redisplay_cancel_ritual_suicide(void);
+
#endif /* INCLUDED_redisplay_h_ */
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
Re: just not familiar with the environment yet
14 years
Aidan Kehoe
Aidan Kehoe
Ar an naoiú lá de mí Bealtaine, scríobh Stephen J. Turnbull:
> Reply-To set to XEmacs Patches. Please take care with replies.
>
> Aidan Kehoe writes:
>
> > I’ve just disabled HTTP access to the xemacs-beta repository, it’s
> > confusing and unhelpful.
>
> Please reenable that. AFAIK Mike S. and Vin continue to keep it
> reasonably up to date. OTOH, Ben has already committed one megapatch
> (fortunately all docs) since the release of 21.5.31, and there is a
> substantial amount of long time breakage as well. I expect the
> 'xemacs' repo to get very unstable at times.
OK, re-enabled, I’m happy enough with the change to the web pages. I still
don’t see any real upside to the xemacs-beta repository, given it’s possible
to check out a specific revision anyway, and given now that Mats’ buildbot
allows us to see the last good revision, but arguing about it is not a
constructive use of my time.
Note that the merge of Ben’s changes was my doing, not his, and note also
that I’m still interested in feedback on
http://mid.gmane.org/19902.32968.993055.512591＠parhasard.net ; can we go
ahead and require a recent makeinfo for our docs?
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT] Complete support for macro-declaration-function, bytecomp{, -runtime}.el
14 years
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1304842765 -3600
# Node ID b0d87f92e60b2c81e9d95e9868a605676559542c
# Parent 3b220aa03f89c8549b05969da407c5ab7156d15c
Complete support for macro-declaration-function, bytecomp{,-runtime}.el
lisp/ChangeLog addition:
2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
* bytecomp-runtime.el:
* bytecomp.el (byte-compile-file-form-defmumble):
* bytecomp-runtime.el (macro-declaration-function): New.
* subr.el:
* subr.el (macro-declaration-function): Removed.
Add support for macro-declaration-function, which is a GNU
mechanism for indicating indentation and edebug information in
macros (and only in macros).
src/ChangeLog addition:
2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
* eval.c:
* eval.c (Fdefmacro):
* eval.c (syms_of_eval):
Support macro-declaration-function in defmacro, incompletely and
without documentation.
* lisp.h:
Declare Fnth here, necessary for the previous changes.
diff -r 3b220aa03f89 -r b0d87f92e60b lisp/ChangeLog
--- a/lisp/ChangeLog Sat May 07 21:27:27 2011 +0100
+++ b/lisp/ChangeLog Sun May 08 09:19:25 2011 +0100
＠＠ -1,3 +1,14 ＠＠
+2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * bytecomp-runtime.el:
+ * bytecomp.el (byte-compile-file-form-defmumble):
+ * bytecomp-runtime.el (macro-declaration-function): New.
+ * subr.el:
+ * subr.el (macro-declaration-function): Removed.
+ Add support for macro-declaration-function, which is a GNU
+ mechanism for indicating indentation and edebug information in
+ macros (and only in macros).
+
2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
* subr.el:
diff -r 3b220aa03f89 -r b0d87f92e60b lisp/bytecomp-runtime.el
--- a/lisp/bytecomp-runtime.el Sat May 07 21:27:27 2011 +0100
+++ b/lisp/bytecomp-runtime.el Sun May 08 09:19:25 2011 +0100
＠＠ -38,6 +38,43 ＠＠
;;; Code:
+;; We define macro-declaration-function here because it is needed to
+;; handle declarations in macro definitions and this is the first file
+;; loaded by loadup.el that uses declarations in macros.
+(defun macro-declaration-function (macro decl)
+ "Process a declaration found in a macro definition.
+This is set as the value of the variable `macro-declaration-function'.
+MACRO is the name of the macro being defined.
+DECL is a list `(declare ...)' containing the declarations.
+The return value of this function is not used.
+
+XEmacs; any forms handed to the function described by the variable
+`macro-declaration-function' will also (eventually) be handled by the
+`declare' macro; see its documentation for further details of this."
+ ;; We can't use `dolist' or `cadr' yet for bootstrapping reasons.
+ (let (d)
+ ;; Ignore the first element of `decl' (it's always `declare').
+ (while (setq decl (cdr decl))
+ (setq d (car decl))
+ (if (and (consp d)
+ (listp (cdr d))
+ (null (cdr (cdr d))))
+ (cond ((eq (car d) 'indent)
+ (put macro 'lisp-indent-function (car (cdr d))))
+ ((eq (car d) 'debug)
+ (put macro 'edebug-form-spec (car (cdr d))))
+ ((eq (car d) 'doc-string)
+ ;;; #### XEmacs; not sure that this does anything sensible.
+ (put macro 'doc-string-elt (car (cdr d))))
+ ;; XEmacs; don't warn about the known XEmacs declarations.
+ ((memq (car d) '(special inline notinline optimize warn)))
+ (t
+ (message "Unknown declaration %s" d)))
+ (message "Invalid declaration %s" d)))))
+
+(setq macro-declaration-function 'macro-declaration-function)
+
+
;; Redefined in byte-optimize.el.
;; This is not documented--it's not clear that we should promote it.
(fset 'inline 'progn)
diff -r 3b220aa03f89 -r b0d87f92e60b lisp/bytecomp.el
--- a/lisp/bytecomp.el Sat May 07 21:27:27 2011 +0100
+++ b/lisp/bytecomp.el Sun May 08 09:19:25 2011 +0100
＠＠ -2297,6 +2297,26 ＠＠
(stringp (car-safe (cdr-safe (cdr-safe body)))))
(byte-compile-warn "Probable `\"' without `\\' in doc string of %s"
(nth 1 form))))
+
+ ;; Generate code for declarations in macro definitions.
+ ;; Remove declarations from the body of the macro definition.
+ (when macrop
+ (let ((byte-compile-defmacro-body (nthcdr 3 form)))
+ (if (stringp (car byte-compile-defmacro-body))
+ (setq byte-compile-defmacro-body (nthcdr 4 form)))
+ (when (and (consp byte-compile-defmacro-body)
+ (eq 'declare (car-safe (car byte-compile-defmacro-body))))
+ (if (eq 'declare (car-safe (car-safe
+ (cdr byte-compile-defmacro-body))))
+ (byte-compile-warn "Multiple macro-specific `declare' calls \
+not supported by XEmacs."))
+ (setq byte-compile-output-preface
+ (byte-compile-top-level
+ `(progn (and macro-declaration-function
+ (funcall macro-declaration-function
+ ',name
+ ',(car byte-compile-defmacro-body)))
+ ,byte-compile-output-preface) t 'file)))))
(let* ((new-one (byte-compile-lambda (cons 'lambda (nthcdr 2 form))))
(code (byte-compile-byte-code-maker new-one))
(docform-info
diff -r 3b220aa03f89 -r b0d87f92e60b lisp/subr.el
--- a/lisp/subr.el Sat May 07 21:27:27 2011 +0100
+++ b/lisp/subr.el Sun May 08 09:19:25 2011 +0100
＠＠ -39,22 +39,6 ＠＠
;; XEmacs; no need for custom-declare-variable-list, preloaded-file-list is
;; ordered to make it unnecessary.
-
-(defun macro-declaration-function (macro decl)
- "Process a declaration found in a macro definition.
-This is set as the value of the variable `macro-declaration-function'.
-MACRO is the name of the macro being defined.
-DECL is a list `(declare ...)' containing the declarations.
-The return value of this function is not used."
- (dolist (d (cdr decl))
- (cond ((and (consp d) (eq (car d) 'indent))
- (put macro 'lisp-indent-function (cadr d)))
- ((and (consp d) (eq (car d) 'debug))
- (put macro 'edebug-form-spec (cadr d)))
- (t
- (message "Unknown declaration %s" d)))))
-
-(setq macro-declaration-function 'macro-declaration-function)
;; XEmacs; this is here because we use it in backquote.el, so it needs to be
;; available the first time a `(...) form is expanded.
diff -r 3b220aa03f89 -r b0d87f92e60b src/ChangeLog
--- a/src/ChangeLog Sat May 07 21:27:27 2011 +0100
+++ b/src/ChangeLog Sun May 08 09:19:25 2011 +0100
＠＠ -1,3 +1,13 ＠＠
+2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * eval.c:
+ * eval.c (Fdefmacro):
+ * eval.c (syms_of_eval):
+ Support macro-declaration-function in defmacro, incompletely and
+ without documentation.
+ * lisp.h:
+ Declare Fnth here, necessary for the previous changes.
+
2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
* s/netbsd.h:
diff -r 3b220aa03f89 -r b0d87f92e60b src/eval.c
--- a/src/eval.c Sat May 07 21:27:27 2011 +0100
+++ b/src/eval.c Sun May 08 09:19:25 2011 +0100
＠＠ -224,7 +224,7 ＠＠
every attempt to throw past this level. */
Lisp_Object Vcatch_everything_tag;
-Lisp_Object Qautoload, Qmacro, Qexit;
+Lisp_Object Qautoload, Qmacro, Qexit, Qdeclare;
Lisp_Object Qinteractive, Qcommandp, Qdefun, Qprogn, Qvalues;
Lisp_Object Vquit_flag, Vinhibit_quit;
Lisp_Object Qand_rest, Qand_optional;
＠＠ -273,6 +273,8 ＠＠
(FUN . ODEF) for a defun, (OFEATURES . nil) for a provide. */
Lisp_Object Vautoload_queue;
+Lisp_Object Vmacro_declaration_function;
+
/* Current number of specbindings allocated in specpdl. */
int specpdl_size;
＠＠ -1406,6 +1408,33 ＠＠
(args))
{
/* This function can GC */
+ if (!NILP (Vmacro_declaration_function))
+ {
+ Lisp_Object declare = Fnth (make_int (2), args);
+
+ /* Sigh. This GNU interface is incompatible with the CL declare macro,
+ and the latter is much older.
+
+ GNU describe this syntax in their docstrings. It's sufficiently
+ ugly in the XEmacs context (and in general, but ...) that I'm not
+ rushing to document it.
+
+ The GNU interface accepts multiple (declare ...) sexps at the
+ beginning of a macro. Nothing uses this, and the XEmacs byte
+ compiler (will) warn(s) if it encounters code that attempts to use
+ it. */
+
+ if (STRINGP (declare))
+ {
+ declare = Fnth (make_int (3), args);
+ }
+
+ if (CONSP (declare) && EQ (Qdeclare, XCAR (declare)))
+ {
+ call2 (Vmacro_declaration_function, XCAR (args), declare);
+ }
+ }
+
return define_function (XCAR (args),
Fcons (Qmacro, Fcons (Qlambda, XCDR (args))));
}
＠＠ -7315,6 +7344,7 ＠＠
defsymbol (&Qand_optional, "&optional");
/* Note that the process code also uses Qexit */
DEFSYMBOL (Qexit);
+ DEFSYMBOL (Qdeclare);
DEFSYMBOL (Qsetq);
DEFSYMBOL (Qinteractive);
DEFSYMBOL (Qcommandp);
＠＠ -7572,6 +7602,15 ＠＠
*/);
Vmultiple_values_limit = EMACS_INT_MAX > INT_MAX ? INT_MAX : EMACS_INT_MAX;
+ DEFVAR_LISP ("macro-declaration-function", &Vmacro_declaration_function /*
+Function to process declarations in a macro definition.
+The function will be called with two args MACRO and DECL.
+MACRO is the name of the macro being defined.
+DECL is a list `(declare ...)' containing the declarations.
+The value the function returns is not used.
+*/);
+ Vmacro_declaration_function = Qnil;
+
staticpro (&Vcatch_everything_tag);
Vcatch_everything_tag = make_opaque (OPAQUE_CLEAR, 0);
diff -r 3b220aa03f89 -r b0d87f92e60b src/lisp.h
--- a/src/lisp.h Sat May 07 21:27:27 2011 +0100
+++ b/src/lisp.h Sun May 08 09:19:25 2011 +0100
＠＠ -5247,6 +5247,7 ＠＠
EXFUN (Fnconc, MANY);
MODULE_API EXFUN (Fnreverse, 1);
EXFUN (Fnthcdr, 2);
+EXFUN (Fnth, 2);
EXFUN (Fold_assq, 2);
EXFUN (Fold_equal, 2);
EXFUN (Fold_member, 2);
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Complete support for macro-declaration-function, bytecomp{, -runtime}.el
14 years
Aidan Kehoe
Aidan Kehoe
changeset: 5506:b0d87f92e60b
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sun May 08 09:19:25 2011 +0100
files: lisp/ChangeLog lisp/bytecomp-runtime.el lisp/bytecomp.el lisp/subr.el src/ChangeLog src/eval.c src/lisp.h
description:
Complete support for macro-declaration-function, bytecomp{,-runtime}.el
lisp/ChangeLog addition:
2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
* bytecomp-runtime.el:
* bytecomp.el (byte-compile-file-form-defmumble):
* bytecomp-runtime.el (macro-declaration-function): New.
* subr.el:
* subr.el (macro-declaration-function): Removed.
Add support for macro-declaration-function, which is a GNU
mechanism for indicating indentation and edebug information in
macros (and only in macros).
src/ChangeLog addition:
2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
* eval.c:
* eval.c (Fdefmacro):
* eval.c (syms_of_eval):
Support macro-declaration-function in defmacro, incompletely and
without documentation.
* lisp.h:
Declare Fnth here, necessary for the previous changes.
diff -r 3b220aa03f89 -r b0d87f92e60b lisp/ChangeLog
--- a/lisp/ChangeLog Sat May 07 21:27:27 2011 +0100
+++ b/lisp/ChangeLog Sun May 08 09:19:25 2011 +0100
＠＠ -1,3 +1,14 ＠＠
+2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * bytecomp-runtime.el:
+ * bytecomp.el (byte-compile-file-form-defmumble):
+ * bytecomp-runtime.el (macro-declaration-function): New.
+ * subr.el:
+ * subr.el (macro-declaration-function): Removed.
+ Add support for macro-declaration-function, which is a GNU
+ mechanism for indicating indentation and edebug information in
+ macros (and only in macros).
+
2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
* subr.el:
diff -r 3b220aa03f89 -r b0d87f92e60b lisp/bytecomp-runtime.el
--- a/lisp/bytecomp-runtime.el Sat May 07 21:27:27 2011 +0100
+++ b/lisp/bytecomp-runtime.el Sun May 08 09:19:25 2011 +0100
＠＠ -38,6 +38,43 ＠＠
;;; Code:
+;; We define macro-declaration-function here because it is needed to
+;; handle declarations in macro definitions and this is the first file
+;; loaded by loadup.el that uses declarations in macros.
+(defun macro-declaration-function (macro decl)
+ "Process a declaration found in a macro definition.
+This is set as the value of the variable `macro-declaration-function'.
+MACRO is the name of the macro being defined.
+DECL is a list `(declare ...)' containing the declarations.
+The return value of this function is not used.
+
+XEmacs; any forms handed to the function described by the variable
+`macro-declaration-function' will also (eventually) be handled by the
+`declare' macro; see its documentation for further details of this."
+ ;; We can't use `dolist' or `cadr' yet for bootstrapping reasons.
+ (let (d)
+ ;; Ignore the first element of `decl' (it's always `declare').
+ (while (setq decl (cdr decl))
+ (setq d (car decl))
+ (if (and (consp d)
+ (listp (cdr d))
+ (null (cdr (cdr d))))
+ (cond ((eq (car d) 'indent)
+ (put macro 'lisp-indent-function (car (cdr d))))
+ ((eq (car d) 'debug)
+ (put macro 'edebug-form-spec (car (cdr d))))
+ ((eq (car d) 'doc-string)
+ ;;; #### XEmacs; not sure that this does anything sensible.
+ (put macro 'doc-string-elt (car (cdr d))))
+ ;; XEmacs; don't warn about the known XEmacs declarations.
+ ((memq (car d) '(special inline notinline optimize warn)))
+ (t
+ (message "Unknown declaration %s" d)))
+ (message "Invalid declaration %s" d)))))
+
+(setq macro-declaration-function 'macro-declaration-function)
+
+
;; Redefined in byte-optimize.el.
;; This is not documented--it's not clear that we should promote it.
(fset 'inline 'progn)
diff -r 3b220aa03f89 -r b0d87f92e60b lisp/bytecomp.el
--- a/lisp/bytecomp.el Sat May 07 21:27:27 2011 +0100
+++ b/lisp/bytecomp.el Sun May 08 09:19:25 2011 +0100
＠＠ -2297,6 +2297,26 ＠＠
(stringp (car-safe (cdr-safe (cdr-safe body)))))
(byte-compile-warn "Probable `\"' without `\\' in doc string of %s"
(nth 1 form))))
+
+ ;; Generate code for declarations in macro definitions.
+ ;; Remove declarations from the body of the macro definition.
+ (when macrop
+ (let ((byte-compile-defmacro-body (nthcdr 3 form)))
+ (if (stringp (car byte-compile-defmacro-body))
+ (setq byte-compile-defmacro-body (nthcdr 4 form)))
+ (when (and (consp byte-compile-defmacro-body)
+ (eq 'declare (car-safe (car byte-compile-defmacro-body))))
+ (if (eq 'declare (car-safe (car-safe
+ (cdr byte-compile-defmacro-body))))
+ (byte-compile-warn "Multiple macro-specific `declare' calls \
+not supported by XEmacs."))
+ (setq byte-compile-output-preface
+ (byte-compile-top-level
+ `(progn (and macro-declaration-function
+ (funcall macro-declaration-function
+ ',name
+ ',(car byte-compile-defmacro-body)))
+ ,byte-compile-output-preface) t 'file)))))
(let* ((new-one (byte-compile-lambda (cons 'lambda (nthcdr 2 form))))
(code (byte-compile-byte-code-maker new-one))
(docform-info
diff -r 3b220aa03f89 -r b0d87f92e60b lisp/subr.el
--- a/lisp/subr.el Sat May 07 21:27:27 2011 +0100
+++ b/lisp/subr.el Sun May 08 09:19:25 2011 +0100
＠＠ -39,22 +39,6 ＠＠
;; XEmacs; no need for custom-declare-variable-list, preloaded-file-list is
;; ordered to make it unnecessary.
-
-(defun macro-declaration-function (macro decl)
- "Process a declaration found in a macro definition.
-This is set as the value of the variable `macro-declaration-function'.
-MACRO is the name of the macro being defined.
-DECL is a list `(declare ...)' containing the declarations.
-The return value of this function is not used."
- (dolist (d (cdr decl))
- (cond ((and (consp d) (eq (car d) 'indent))
- (put macro 'lisp-indent-function (cadr d)))
- ((and (consp d) (eq (car d) 'debug))
- (put macro 'edebug-form-spec (cadr d)))
- (t
- (message "Unknown declaration %s" d)))))
-
-(setq macro-declaration-function 'macro-declaration-function)
;; XEmacs; this is here because we use it in backquote.el, so it needs to be
;; available the first time a `(...) form is expanded.
diff -r 3b220aa03f89 -r b0d87f92e60b src/ChangeLog
--- a/src/ChangeLog Sat May 07 21:27:27 2011 +0100
+++ b/src/ChangeLog Sun May 08 09:19:25 2011 +0100
＠＠ -1,3 +1,13 ＠＠
+2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * eval.c:
+ * eval.c (Fdefmacro):
+ * eval.c (syms_of_eval):
+ Support macro-declaration-function in defmacro, incompletely and
+ without documentation.
+ * lisp.h:
+ Declare Fnth here, necessary for the previous changes.
+
2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
* s/netbsd.h:
diff -r 3b220aa03f89 -r b0d87f92e60b src/eval.c
--- a/src/eval.c Sat May 07 21:27:27 2011 +0100
+++ b/src/eval.c Sun May 08 09:19:25 2011 +0100
＠＠ -224,7 +224,7 ＠＠
every attempt to throw past this level. */
Lisp_Object Vcatch_everything_tag;
-Lisp_Object Qautoload, Qmacro, Qexit;
+Lisp_Object Qautoload, Qmacro, Qexit, Qdeclare;
Lisp_Object Qinteractive, Qcommandp, Qdefun, Qprogn, Qvalues;
Lisp_Object Vquit_flag, Vinhibit_quit;
Lisp_Object Qand_rest, Qand_optional;
＠＠ -273,6 +273,8 ＠＠
(FUN . ODEF) for a defun, (OFEATURES . nil) for a provide. */
Lisp_Object Vautoload_queue;
+Lisp_Object Vmacro_declaration_function;
+
/* Current number of specbindings allocated in specpdl. */
int specpdl_size;
＠＠ -1406,6 +1408,33 ＠＠
(args))
{
/* This function can GC */
+ if (!NILP (Vmacro_declaration_function))
+ {
+ Lisp_Object declare = Fnth (make_int (2), args);
+
+ /* Sigh. This GNU interface is incompatible with the CL declare macro,
+ and the latter is much older.
+
+ GNU describe this syntax in their docstrings. It's sufficiently
+ ugly in the XEmacs context (and in general, but ...) that I'm not
+ rushing to document it.
+
+ The GNU interface accepts multiple (declare ...) sexps at the
+ beginning of a macro. Nothing uses this, and the XEmacs byte
+ compiler (will) warn(s) if it encounters code that attempts to use
+ it. */
+
+ if (STRINGP (declare))
+ {
+ declare = Fnth (make_int (3), args);
+ }
+
+ if (CONSP (declare) && EQ (Qdeclare, XCAR (declare)))
+ {
+ call2 (Vmacro_declaration_function, XCAR (args), declare);
+ }
+ }
+
return define_function (XCAR (args),
Fcons (Qmacro, Fcons (Qlambda, XCDR (args))));
}
＠＠ -7315,6 +7344,7 ＠＠
defsymbol (&Qand_optional, "&optional");
/* Note that the process code also uses Qexit */
DEFSYMBOL (Qexit);
+ DEFSYMBOL (Qdeclare);
DEFSYMBOL (Qsetq);
DEFSYMBOL (Qinteractive);
DEFSYMBOL (Qcommandp);
＠＠ -7572,6 +7602,15 ＠＠
*/);
Vmultiple_values_limit = EMACS_INT_MAX > INT_MAX ? INT_MAX : EMACS_INT_MAX;
+ DEFVAR_LISP ("macro-declaration-function", &Vmacro_declaration_function /*
+Function to process declarations in a macro definition.
+The function will be called with two args MACRO and DECL.
+MACRO is the name of the macro being defined.
+DECL is a list `(declare ...)' containing the declarations.
+The value the function returns is not used.
+*/);
+ Vmacro_declaration_function = Qnil;
+
staticpro (&Vcatch_everything_tag);
Vcatch_everything_tag = make_opaque (OPAQUE_CLEAR, 0);
diff -r 3b220aa03f89 -r b0d87f92e60b src/lisp.h
--- a/src/lisp.h Sat May 07 21:27:27 2011 +0100
+++ b/src/lisp.h Sun May 08 09:19:25 2011 +0100
＠＠ -5247,6 +5247,7 ＠＠
EXFUN (Fnconc, MANY);
MODULE_API EXFUN (Fnreverse, 1);
EXFUN (Fnthcdr, 2);
+EXFUN (Fnth, 2);
EXFUN (Fold_assq, 2);
EXFUN (Fold_equal, 2);
EXFUN (Fold_member, 2);
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT] Remove an extraneous #endif, s/netbsd.h, thank you Adam Sjoegren!
14 years
Aidan Kehoe
Aidan Kehoe
I’m not sure whether it was Ben’s commit or my merging that broke this, but
it needs addressing either way. Thank you Adam.
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1304800047 -3600
# Node ID 3b220aa03f89c8549b05969da407c5ab7156d15c
# Parent d3e0482c7899f71fcb65fce6ae8b97a8d2261dfa
Remove an extraneous #endif, s/netbsd.h, thank you Adam Sjoegren!
src/ChangeLog addition:
2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
* s/netbsd.h:
Remove an extraneous #endif, hopefully fixing the NetBSD and
OpenBSD builds; thank you Adam Sjoegren!
diff -r d3e0482c7899 -r 3b220aa03f89 src/ChangeLog
--- a/src/ChangeLog Sat May 07 16:57:17 2011 +0100
+++ b/src/ChangeLog Sat May 07 21:27:27 2011 +0100
＠＠ -1,3 +1,9 ＠＠
+2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * s/netbsd.h:
+ Remove an extraneous #endif, hopefully fixing the NetBSD and
+ OpenBSD builds; thank you Adam Sjøgren!
+
2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Fsplit_path): Removed.
diff -r d3e0482c7899 -r 3b220aa03f89 src/s/netbsd.h
--- a/src/s/netbsd.h Sat May 07 16:57:17 2011 +0100
+++ b/src/s/netbsd.h Sat May 07 21:27:27 2011 +0100
＠＠ -121,7 +121,6 ＠＠
/* arch-tag: e80f364a-04e9-4faf-93cb-f36a0fe95c81
(do not change this comment) */
-#endif /* 0 */
/* Begin XEmacs additions */
#undef BSD
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Remove an extraneous #endif, s/netbsd.h, thank you Adam Sjoegren!
14 years
Aidan Kehoe
Aidan Kehoe
changeset: 5505:3b220aa03f89
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sat May 07 21:27:27 2011 +0100
files: src/ChangeLog src/s/netbsd.h
description:
Remove an extraneous #endif, s/netbsd.h, thank you Adam Sjoegren!
src/ChangeLog addition:
2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
* s/netbsd.h:
Remove an extraneous #endif, hopefully fixing the NetBSD and
OpenBSD builds; thank you Adam Sjoegren!
diff -r d3e0482c7899 -r 3b220aa03f89 src/ChangeLog
--- a/src/ChangeLog Sat May 07 16:57:17 2011 +0100
+++ b/src/ChangeLog Sat May 07 21:27:27 2011 +0100
＠＠ -1,3 +1,9 ＠＠
+2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * s/netbsd.h:
+ Remove an extraneous #endif, hopefully fixing the NetBSD and
+ OpenBSD builds; thank you Adam Sjøgren!
+
2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Fsplit_path): Removed.
diff -r d3e0482c7899 -r 3b220aa03f89 src/s/netbsd.h
--- a/src/s/netbsd.h Sat May 07 16:57:17 2011 +0100
+++ b/src/s/netbsd.h Sat May 07 21:27:27 2011 +0100
＠＠ -121,7 +121,6 ＠＠
/* arch-tag: e80f364a-04e9-4faf-93cb-f36a0fe95c81
(do not change this comment) */
-#endif /* 0 */
/* Begin XEmacs additions */
#undef BSD
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT] Move #'split-path to subr.el, as was always the intention.
14 years
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1304783837 -3600
# Node ID d3e0482c7899f71fcb65fce6ae8b97a8d2261dfa
# Parent 7b5946dbfb9695dfed9ab288d7bd4f6150591ac5
Move #'split-path to subr.el, as was always the intention.
src/ChangeLog addition:
2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Fsplit_path): Removed.
* fns.c (syms_of_fns):
Move #'split-path to subr.el, as was always the intention.
lisp/ChangeLog addition:
2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
* subr.el:
* subr.el (split-path): New.
Moved here from fns.c. There's no need to have this in C, it's no
longer used that early at startup.
diff -r 7b5946dbfb96 -r d3e0482c7899 lisp/ChangeLog
--- a/lisp/ChangeLog Sat May 07 12:26:39 2011 +0100
+++ b/lisp/ChangeLog Sat May 07 16:57:17 2011 +0100
＠＠ -1,3 +1,10 ＠＠
+2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * subr.el:
+ * subr.el (split-path): New.
+ Moved here from fns.c. There's no need to have this in C, it's no
+ longer used that early at startup.
+
2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
* bytecomp.el:
diff -r 7b5946dbfb96 -r d3e0482c7899 lisp/subr.el
--- a/lisp/subr.el Sat May 07 12:26:39 2011 +0100
+++ b/lisp/subr.el Sat May 07 16:57:17 2011 +0100
＠＠ -505,18 +505,20 ＠＠
;; BEGIN SYNCHED WITH FSF 21.2
-;; #### #### #### AAaargh! Must be in C, because it is used insanely
-;; early in the bootstrap process.
-;(defun split-path (path)
+(defun split-path (path)
+ "Explode a search path into a list of strings.
+The path components are separated with the characters specified
+with `path-separator'."
+ (while (or (not (stringp path-separator))
+ (/= (length path-separator) 1))
+ (setq path-separator (signal 'error (list "\
+`path-separator' should be set to a single-character string"
+ path-separator))))
+ (split-string-by-char path (aref path-separator 0)))
+
; "Explode a search path into a list of strings.
;The path components are separated with the characters specified
;with `path-separator'."
-; (while (or (not stringp path-separator)
-; (/= (length path-separator) 1))
-; (setq path-separator (signal 'error (list "\
-;`path-separator' should be set to a single-character string"
-; path-separator))))
-; (split-string-by-char path (aref separator 0)))
(defmacro with-current-buffer (buffer &rest body)
"Temporarily make BUFFER the current buffer and execute the forms in BODY.
diff -r 7b5946dbfb96 -r d3e0482c7899 src/ChangeLog
--- a/src/ChangeLog Sat May 07 12:26:39 2011 +0100
+++ b/src/ChangeLog Sat May 07 16:57:17 2011 +0100
＠＠ -1,3 +1,9 ＠＠
+2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * fns.c (Fsplit_path): Removed.
+ * fns.c (syms_of_fns):
+ Move #'split-path to subr.el, as was always the intention.
+
2011-05-03 Stephen J. Turnbull <stephen(a)xemacs.org>
* dumper.c (pdump_file_try): Remove static qualifier.
diff -r 7b5946dbfb96 -r d3e0482c7899 src/fns.c
--- a/src/fns.c Sat May 07 12:26:39 2011 +0100
+++ b/src/fns.c Sat May 07 16:57:17 2011 +0100
＠＠ -2260,8 +2260,9 ＠＠
return split_string_by_ichar_1 (path, qxestrlen (path), SEPCHAR, 0, 0);
}
-/* Ben thinks this function should not exist or be exported to Lisp.
- We use it to define split-path-string in subr.el (not!). */
+/* Ben thinks [or thought in 1998] this function should not exist or be
+ exported to Lisp. It's used to define #'split-path in subr.el, and for
+ parsing Carbon font names under that window system. */
DEFUN ("split-string-by-char", Fsplit_string_by_char, 2, 3, 0, /*
Split STRING into a list of substrings originally separated by SEPCHAR.
＠＠ -2286,31 +2287,6 ＠＠
XCHAR (sepchar),
!NILP (escape_char), escape_ichar);
}
-
-/* #### This was supposed to be in subr.el, but is used VERY early in
- the bootstrap process, so it goes here. Damn. */
-
-DEFUN ("split-path", Fsplit_path, 1, 1, 0, /*
-Explode a search path into a list of strings.
-The path components are separated with the characters specified
-with `path-separator'.
-*/
- (path))
-{
- CHECK_STRING (path);
-
- while (!STRINGP (Vpath_separator)
- || (string_char_length (Vpath_separator) != 1))
- Vpath_separator = signal_continuable_error
- (Qinvalid_state,
- "`path-separator' should be set to a single-character string",
- Vpath_separator);
-
- return (split_string_by_ichar_1
- (XSTRING_DATA (path), XSTRING_LENGTH (path),
- itext_ichar (XSTRING_DATA (Vpath_separator)), 0, 0));
-}
-
DEFUN ("nthcdr", Fnthcdr, 2, 2, 0, /*
Take cdr N times on LIST, and return the result.
＠＠ -11955,7 +11931,6 ＠＠
DEFSUBR (Fsubstring_no_properties);
DEFSUBR (Fsplit_string_by_char);
- DEFSUBR (Fsplit_path); /* #### */
}
void
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments