carbon2-commit: Supply check_string_lessp_nokey explicitly to list_sort(), #'apropos-internal
12 years
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
carbon2-commit: Have #'sort*, #'merge use the same test approach as functions from cl-seq.el
12 years
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
carbon2-commit: Unbreak font-lock during `revert-buffer.
12 years
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
carbon2-commit: Don't commit suicide when an X device dies.
12 years
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
Re: just not familiar with the environment yet
12 years
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
[COMMIT] Complete support for macro-declaration-function, bytecomp{, -runtime}.el
12 years, 1 month
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
commit: Complete support for macro-declaration-function, bytecomp{, -runtime}.el
12 years, 1 month
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
[COMMIT] Remove an extraneous #endif, s/netbsd.h, thank you Adam Sjoegren!
12 years, 1 month
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
commit: Remove an extraneous #endif, s/netbsd.h, thank you Adam Sjoegren!
12 years, 1 month
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
[COMMIT] Move #'split-path to subr.el, as was always the intention.
12 years, 1 month
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