commit: Move #'replace to C, add bounds-checking to it and to #'fill.
14 years, 3 months
Aidan Kehoe
changeset: 5261:69f687b3ba9d
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Mon Sep 06 17:29:51 2010 +0100
files: lisp/ChangeLog lisp/cl-seq.el src/ChangeLog src/fns.c
description:
Move #'replace to C, add bounds-checking to it and to #'fill.
2010-09-06 Aidan Kehoe <kehoea(a)parhasard.net>
Move #'replace to C; add bounds checking to it and to #'fill.
* fns.c (Fsubseq, Ffill, mapcarX):
Don't #'nreverse in #'subseq, use fill_string_range and check
bounds in #'fill, use replace_string_range() in #'map-into
avoiding quadratic time when modfiying the string.
* fns.c (check_sequence_range, fill_string_range)
(replace_string_range, replace_string_range_1, Freplace):
New functions; check that arguments fit sequence dimensions, fill
a string range with a given character, replace a string range from
an Ibyte pointer.
diff -r dceee3855f15 -r 69f687b3ba9d lisp/ChangeLog
--- a/lisp/ChangeLog Sun Sep 05 20:31:05 2010 +0100
+++ b/lisp/ChangeLog Mon Sep 06 17:29:51 2010 +0100
@@ -1,3 +1,9 @@
+2010-09-06 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * cl-seq.el (replace):
+ Move this function, with added bounds-checking per ANSI Common
+ Lisp, to fns.c.
+
2010-09-05 Aidan Kehoe <kehoea(a)parhasard.net>
* x-compose.el (define-compose-map, compose-map)
diff -r dceee3855f15 -r 69f687b3ba9d lisp/cl-seq.el
--- a/lisp/cl-seq.el Sun Sep 05 20:31:05 2010 +0100
+++ b/lisp/cl-seq.el Mon Sep 06 17:29:51 2010 +0100
@@ -142,48 +142,7 @@
(defvar cl-if) (defvar cl-if-not)
(defvar cl-key)
-(defun replace (cl-seq1 cl-seq2 &rest cl-keys)
- "Replace the elements of SEQ1 with the elements of SEQ2.
-SEQ1 is destructively modified, then returned.
-Keywords supported: :start1 :end1 :start2 :end2
-:start1 and :end1 specify a subsequence of SEQ1, and :start2 and :end2 a
-subsequence of SEQ2; see `search' for more information."
- (cl-parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) ()
- (if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1))
- (or (= cl-start1 cl-start2)
- (let* ((cl-len (length cl-seq1))
- (cl-n (min (- (or cl-end1 cl-len) cl-start1)
- (- (or cl-end2 cl-len) cl-start2))))
- (while (>= (setq cl-n (1- cl-n)) 0)
- (cl-set-elt cl-seq1 (+ cl-start1 cl-n)
- (elt cl-seq2 (+ cl-start2 cl-n))))))
- (if (listp cl-seq1)
- (let ((cl-p1 (nthcdr cl-start1 cl-seq1))
- (cl-n1 (if cl-end1 (- cl-end1 cl-start1) 4000000)))
- (if (listp cl-seq2)
- (let ((cl-p2 (nthcdr cl-start2 cl-seq2))
- (cl-n (min cl-n1
- (if cl-end2 (- cl-end2 cl-start2) 4000000))))
- (while (and cl-p1 cl-p2 (>= (setq cl-n (1- cl-n)) 0))
- (setcar cl-p1 (car cl-p2))
- (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2))))
- (setq cl-end2 (min (or cl-end2 (length cl-seq2))
- (+ cl-start2 cl-n1)))
- (while (and cl-p1 (< cl-start2 cl-end2))
- (setcar cl-p1 (aref cl-seq2 cl-start2))
- (setq cl-p1 (cdr cl-p1) cl-start2 (1+ cl-start2)))))
- (setq cl-end1 (min (or cl-end1 (length cl-seq1))
- (+ cl-start1 (- (or cl-end2 (length cl-seq2))
- cl-start2))))
- (if (listp cl-seq2)
- (let ((cl-p2 (nthcdr cl-start2 cl-seq2)))
- (while (< cl-start1 cl-end1)
- (aset cl-seq1 cl-start1 (car cl-p2))
- (setq cl-p2 (cdr cl-p2) cl-start1 (1+ cl-start1))))
- (while (< cl-start1 cl-end1)
- (aset cl-seq1 cl-start1 (aref cl-seq2 cl-start2))
- (setq cl-start2 (1+ cl-start2) cl-start1 (1+ cl-start1))))))
- cl-seq1))
+;; XEmacs; #'replace is in fns.c.
(defun remove* (cl-item cl-seq &rest cl-keys)
"Remove all occurrences of ITEM in SEQ.
diff -r dceee3855f15 -r 69f687b3ba9d src/ChangeLog
--- a/src/ChangeLog Sun Sep 05 20:31:05 2010 +0100
+++ b/src/ChangeLog Mon Sep 06 17:29:51 2010 +0100
@@ -1,3 +1,18 @@
+2010-09-06 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ Move #'replace to C; add bounds checking to it and to #'fill.
+
+ * fns.c (Fsubseq, Ffill, mapcarX):
+ Don't #'nreverse in #'subseq, use fill_string_range and check
+ bounds in #'fill, use replace_string_range() in #'map-into
+ avoiding quadratic time when modfiying the string.
+
+ * fns.c (check_sequence_range, fill_string_range)
+ (replace_string_range, replace_string_range_1, Freplace):
+ New functions; check that arguments fit sequence dimensions, fill
+ a string range with a given character, replace a string range from
+ an Ibyte pointer.
+
2010-09-05 Aidan Kehoe <kehoea(a)parhasard.net>
* chartab.c (char_table_default_for_type,
diff -r dceee3855f15 -r 69f687b3ba9d src/fns.c
--- a/src/fns.c Sun Sep 05 20:31:05 2010 +0100
+++ b/src/fns.c Mon Sep 06 17:29:51 2010 +0100
@@ -54,11 +54,12 @@
/* NOTE: This symbol is also used in lread.c */
#define FEATUREP_SYNTAX
-Lisp_Object Qstring_lessp, Qsort, Qmerge, Qfill;
+Lisp_Object Qstring_lessp, Qsort, Qmerge, Qfill, Qreplace;
Lisp_Object Qidentity;
Lisp_Object Qvector, Qarray, Qbit_vector, QsortX, Q_from_end, Q_initial_value;
Lisp_Object Qmapconcat, QmapcarX, Qmapvector, Qmapcan, Qmapc, Qmap, Qmap_into;
Lisp_Object Qsome, Qevery, Qmaplist, Qmapl, Qmapcon, Qreduce;
+Lisp_Object Q_start1, Q_start2, Q_end1, Q_end2;
Lisp_Object Qbase64_conversion_error;
@@ -71,6 +72,20 @@
mapping_interaction_error (Lisp_Object func, Lisp_Object object)
{
invalid_state_2 ("object modified while traversing it", func, object);
+}
+
+static void
+check_sequence_range (Lisp_Object sequence, Lisp_Object start,
+ Lisp_Object end, Lisp_Object length)
+{
+ Elemcount starting = XINT (start), ending, len = XINT (length);
+
+ ending = NILP (end) ? XINT (length) : XINT (end);
+
+ if (!(0 <= starting && starting <= ending && ending <= len))
+ {
+ args_out_of_range_3 (sequence, start, make_int (ending));
+ }
}
static Lisp_Object
@@ -885,7 +900,7 @@
{
CHECK_CHAR_COERCE_INT (elt);
string_result_ptr += set_itext_ichar (string_result_ptr,
- XCHAR (elt));
+ XCHAR (elt));
}
}
if (args_mse)
@@ -1044,8 +1059,8 @@
e = len + e;
}
- if (!(0 <= s && s <= e && e <= len))
- args_out_of_range_3 (sequence, make_int (s), make_int (e));
+ check_sequence_range (sequence, make_int (s), make_int (e),
+ make_int (len));
if (VECTORP (sequence))
{
@@ -1060,18 +1075,24 @@
}
else if (LISTP (sequence))
{
- Lisp_Object result = Qnil;
+ Lisp_Object result = Qnil, result_tail;
EMACS_INT i;
sequence = Fnthcdr (make_int (s), sequence);
- for (i = s; i < e; i++)
- {
- result = Fcons (Fcar (sequence), result);
+ if (s < e)
+ {
+ result = result_tail = Fcons (Fcar (sequence), Qnil);
sequence = Fcdr (sequence);
- }
-
- return Fnreverse (result);
+ for (i = s + 1; i < e; i++)
+ {
+ XSETCDR (result_tail, Fcons (Fcar (sequence), Qnil));
+ sequence = Fcdr (sequence);
+ result_tail = XCDR (result_tail);
+ }
+ }
+
+ return result;
}
else if (BIT_VECTORP (sequence))
{
@@ -3872,6 +3893,29 @@
}
+static Lisp_Object replace_string_range_1 (Lisp_Object dest,
+ Lisp_Object start,
+ Lisp_Object end,
+ const Ibyte *source,
+ const Ibyte *source_limit,
+ Lisp_Object item);
+
+/* Fill the substring of DEST beginning at START and ending before END with
+ the character ITEM. If DEST does not have sufficient space for END -
+ START characters at START, write as many as is possible without changing
+ the character length of DEST. Update the string modification flag and do
+ any sledgehammer checks we have turned on.
+
+ START must be a Lisp integer. END can be nil, indicating the length of the
+ string, or a Lisp integer. The condition (<= 0 START END (length DEST))
+ must hold, or fill_string_range() will signal an error. */
+static Lisp_Object
+fill_string_range (Lisp_Object dest, Lisp_Object item, Lisp_Object start,
+ Lisp_Object end)
+{
+ return replace_string_range_1 (dest, start, end, NULL, NULL, item);
+}
+
DEFUN ("fill", Ffill, 2, MANY, 0, /*
Destructively modify SEQUENCE by replacing each element with ITEM.
SEQUENCE is a list, vector, bit vector, or string.
@@ -3881,21 +3925,20 @@
exclusive upper bound on the elements of SEQUENCE to be modified, and
defaults to the length of SEQUENCE.
-arguments: (SEQUENCE ITEM &key (START 0) END)
+arguments: (SEQUENCE ITEM &key (START 0) (END (length SEQUENCE)))
*/
(int nargs, Lisp_Object *args))
{
Lisp_Object sequence = args[0];
Lisp_Object item = args[1];
- Elemcount starting = 0, ending = EMACS_INT_MAX, ii;
-
- PARSE_KEYWORDS (Qfill, nargs, args, 2, 2, (start, end),
- (start = Qzero, end = Qunbound), 0);
+ Elemcount starting = 0, ending = EMACS_INT_MAX, ii, len;
+
+ PARSE_KEYWORDS (Qfill, nargs, args, 2, 2, (start, end), (start = Qzero), 0);
CHECK_NATNUM (start);
starting = XINT (start);
- if (!UNBOUNDP (end))
+ if (!NILP (end))
{
CHECK_NATNUM (end);
ending = XINT (end);
@@ -3904,49 +3947,21 @@
retry:
if (STRINGP (sequence))
{
- Bytecount prefix_bytecount, item_bytecount, delta;
- Ibyte item_buf[MAX_ICHAR_LEN];
- Ibyte *p, *pend;
-
CHECK_CHAR_COERCE_INT (item);
-
CHECK_LISP_WRITEABLE (sequence);
- sledgehammer_check_ascii_begin (sequence);
- item_bytecount = set_itext_ichar (item_buf, XCHAR (item));
-
- p = XSTRING_DATA (sequence);
- p = (Ibyte *) itext_n_addr (p, starting);
- prefix_bytecount = p - XSTRING_DATA (sequence);
-
- ending = min (ending, string_char_length (sequence));
- pend = (Ibyte *) itext_n_addr (p, ending - starting);
- delta = ((ending - starting) * item_bytecount) - (pend - p);
-
- /* Resize the string if the bytecount for the area being modified is
- different. */
- if (delta)
- {
- resize_string (sequence, prefix_bytecount, delta);
- /* No need to zero-terminate the string, resize_string has done
- that for us. */
- p = XSTRING_DATA (sequence) + prefix_bytecount;
- pend = p + ((ending - starting) * item_bytecount);
- }
-
- for (; p < pend; p += item_bytecount)
- memcpy (p, item_buf, item_bytecount);
-
-
- init_string_ascii_begin (sequence);
- bump_string_modiff (sequence);
- sledgehammer_check_ascii_begin (sequence);
+
+ fill_string_range (sequence, item, start, end);
}
else if (VECTORP (sequence))
{
Lisp_Object *p = XVECTOR_DATA (sequence);
+
CHECK_LISP_WRITEABLE (sequence);
-
- ending = min (ending, XVECTOR_LENGTH (sequence));
+ len = XVECTOR_LENGTH (sequence);
+
+ check_sequence_range (sequence, start, end, make_int (len));
+ ending = min (ending, len);
+
for (ii = starting; ii < ending; ++ii)
{
p[ii] = item;
@@ -3956,11 +3971,15 @@
{
Lisp_Bit_Vector *v = XBIT_VECTOR (sequence);
int bit;
+
CHECK_BIT (item);
bit = XINT (item);
CHECK_LISP_WRITEABLE (sequence);
-
- ending = min (ending, bit_vector_length (v));
+ len = bit_vector_length (v);
+
+ check_sequence_range (sequence, start, end, make_int (len));
+ ending = min (ending, len);
+
for (ii = starting; ii < ending; ++ii)
{
set_bit_vector_bit (v, ii, bit);
@@ -3985,6 +4004,11 @@
}
++counting;
}
+
+ if (counting != ending)
+ {
+ check_sequence_range (sequence, start, end, Flength (sequence));
+ }
}
else
{
@@ -4129,6 +4153,24 @@
}
+/* Replace the substring of DEST beginning at START and ending before END
+ with the text at SOURCE, which is END - START characters long and
+ SOURCE_LIMIT - SOURCE octets long. If DEST does not have sufficient
+ space for END - START characters at START, write as many as is possible
+ without changing the length of DEST. Update the string modification flag
+ and do any sledgehammer checks we have turned on in this build.
+
+ START must be a Lisp integer. END can be nil, indicating the length of the
+ string, or a Lisp integer. The condition (<= 0 START END (length DEST))
+ must hold, or replace_string_range() will signal an error. */
+static Lisp_Object
+replace_string_range (Lisp_Object dest, Lisp_Object start, Lisp_Object end,
+ const Ibyte *source, const Ibyte *source_limit)
+{
+ return replace_string_range_1 (dest, start, end, source, source_limit,
+ Qnil);
+}
+
/* This is the guts of several mapping functions.
Call FUNCTION CALL_COUNT times, with NSEQUENCES arguments each time,
@@ -4168,6 +4210,7 @@
{
Lisp_Object called, *args;
struct gcpro gcpro1, gcpro2;
+ Ibyte *lisp_vals_staging, *cursor;
int i, j;
assert ((EQ (caller, Qsome) || EQ (caller, Qevery)) ? vals == NULL : 1);
@@ -4224,9 +4267,15 @@
if (!EQ (caller, Qsome) && !EQ (caller, Qevery))
{
assert (LRECORDP (lisp_vals));
+
lisp_vals_type
= (enum lrecord_type) XRECORD_LHEADER (lisp_vals)->type;
- assert (NILP (lisp_vals) || lisp_vals_type != lrecord_type_symbol);
+
+ if (lrecord_type_string == lisp_vals_type)
+ {
+ lisp_vals_staging = cursor
+ = alloca_ibytes (call_count * MAX_ICHAR_LEN);
+ }
}
for (i = 0; i < call_count; ++i)
@@ -4305,8 +4354,7 @@
switch (lisp_vals_type)
{
case lrecord_type_symbol:
- /* This is #'mapc; the result of the funcall is
- discarded. */
+ /* Discard the result of funcall. */
break;
case lrecord_type_cons:
{
@@ -4331,10 +4379,8 @@
}
case lrecord_type_string:
{
- /* If this ever becomes a code hotspot, we can keep
- around pointers into the data of the string, checking
- each time that it hasn't been relocated. */
- Faset (lisp_vals, make_int (i), called);
+ CHECK_CHAR_COERCE_INT (called);
+ cursor += set_itext_ichar (cursor, XCHAR (called));
break;
}
case lrecord_type_bit_vector:
@@ -4354,7 +4400,15 @@
}
}
}
- }
+
+ if (!EQ (caller, Qsome) && !EQ (caller, Qevery) &&
+ lrecord_type_string == lisp_vals_type)
+ {
+ replace_string_range (lisp_vals, Qzero, make_int (call_count),
+ lisp_vals_staging, cursor);
+ }
+ }
+
UNGCPRO;
}
@@ -5302,6 +5356,590 @@
return old;
}
+/* This function is the implementation of fill_string_range() and
+ replace_string_range(); see the comments for those functions. */
+static Lisp_Object
+replace_string_range_1 (Lisp_Object dest, Lisp_Object start, Lisp_Object end,
+ const Ibyte *source, const Ibyte *source_limit,
+ Lisp_Object item)
+{
+ Ibyte *destp = XSTRING_DATA (dest), *p = destp,
+ *pend = p + XSTRING_LENGTH (dest), *pcursor, item_buf[MAX_ICHAR_LEN];
+ Bytecount prefix_bytecount, source_len = source_limit - source;
+ Charcount ii = 0, starting = XINT (start), ending, len;
+ Elemcount delta;
+
+ while (ii < starting && p < pend)
+ {
+ INC_IBYTEPTR (p);
+ ii++;
+ }
+
+ pcursor = p;
+
+ if (NILP (end))
+ {
+ while (pcursor < pend)
+ {
+ INC_IBYTEPTR (pcursor);
+ ii++;
+ }
+
+ ending = len = ii;
+ }
+ else
+ {
+ ending = XINT (end);
+ while (ii < ending && pcursor < pend)
+ {
+ INC_IBYTEPTR (pcursor);
+ ii++;
+ }
+ }
+
+ if (pcursor == pend)
+ {
+ /* We have the length, check it for our callers. */
+ check_sequence_range (dest, start, end, make_int (ii));
+ }
+
+ if (!(p == pend || p == pcursor))
+ {
+ prefix_bytecount = p - destp;
+
+ if (!NILP (item))
+ {
+ assert (source == NULL && source_limit == NULL);
+ source_len = set_itext_ichar (item_buf, XCHAR (item));
+ delta = (source_len * (ending - starting)) - (pcursor - p);
+ }
+ else
+ {
+ assert (source != NULL && source_limit != NULL);
+ delta = source_len - (pcursor - p);
+ }
+
+ if (delta)
+ {
+ resize_string (dest, prefix_bytecount, delta);
+ destp = XSTRING_DATA (dest);
+ pcursor = destp + prefix_bytecount + (pcursor - p);
+ p = destp + prefix_bytecount;
+ }
+
+ if (CHARP (item))
+ {
+ while (starting < ending)
+ {
+ memcpy (p, item_buf, source_len);
+ p += source_len;
+ starting++;
+ }
+ }
+ else
+ {
+ while (starting < ending && source < source_limit)
+ {
+ source_len = itext_copy_ichar (source, p);
+ p += source_len, source += source_len;
+ }
+ }
+
+ init_string_ascii_begin (dest);
+ bump_string_modiff (dest);
+ sledgehammer_check_ascii_begin (dest);
+ }
+
+ return dest;
+}
+
+DEFUN ("replace", Freplace, 2, MANY, 0, /*
+Replace the elements of SEQUENCE-ONE with the elements of SEQUENCE-TWO.
+
+SEQUENCE-ONE is destructively modified, and returned. Its length is not
+changed.
+
+Keywords:start1 and :end1 specify a subsequence of SEQUENCE-ONE, and
+:start2 and :end2 a subsequence of SEQUENCE-TWO. See `search' for more
+information.
+
+arguments: (SEQUENCE-ONE SEQUENCE-TWO &key (START1 0) (END1 (length SEQUENCE-ONE)) (START2 0) (END2 (length SEQUENCE-TWO)))
+*/
+ (int nargs, Lisp_Object *args))
+{
+ Lisp_Object sequence1 = args[0], sequence2 = args[1],
+ result = sequence1;
+ Elemcount starting1, ending1 = EMACS_INT_MAX, starting2;
+ Elemcount ending2 = EMACS_INT_MAX, counting, startcounting;
+ Boolint sequence1_listp, sequence2_listp,
+ overwriting = EQ (sequence1, sequence2);
+
+ PARSE_KEYWORDS (Qreplace, nargs, args, 2, 4, (start1, end1, start2, end2),
+ (start1 = start2 = Qzero), 0);
+
+ CHECK_SEQUENCE (sequence1);
+ CHECK_LISP_WRITEABLE (sequence1);
+
+ CHECK_SEQUENCE (sequence2);
+
+ CHECK_NATNUM (start1);
+ starting1 = XINT (start1);
+ CHECK_NATNUM (start2);
+ starting2 = XINT (start2);
+
+ if (!NILP (end1))
+ {
+ CHECK_NATNUM (end1);
+ ending1 = XINT (end1);
+
+ if (!(starting1 <= ending1))
+ {
+ args_out_of_range_3 (sequence1, start1, end1);
+ }
+ }
+
+ if (!NILP (end2))
+ {
+ CHECK_NATNUM (end2);
+ ending2 = XINT (end2);
+
+ if (!(starting2 <= ending2))
+ {
+ args_out_of_range_3 (sequence1, start2, end2);
+ }
+ }
+
+ sequence1_listp = LISTP (sequence1);
+ sequence2_listp = LISTP (sequence2);
+
+ overwriting = overwriting && starting2 <= starting1;
+
+ if (sequence1_listp && !ZEROP (start1))
+ {
+ Lisp_Object nthcdrd = Fnthcdr (start1, sequence1);
+
+ if (NILP (nthcdrd))
+ {
+ check_sequence_range (sequence1, start1, end1, Flength (sequence1));
+ /* Give up early here. */
+ return result;
+ }
+
+ sequence1 = nthcdrd;
+ ending1 -= starting1;
+ starting1 = 0;
+ }
+
+ if (sequence2_listp && !ZEROP (start2))
+ {
+ Lisp_Object nthcdrd = Fnthcdr (start2, sequence2);
+
+ if (NILP (nthcdrd))
+ {
+ check_sequence_range (sequence1, start1, end1, Flength (sequence1));
+ /* Nothing available to replace sequence1's contents. */
+ return result;
+ }
+
+ sequence2 = nthcdrd;
+ ending2 -= starting2;
+ starting2 = 0;
+ }
+
+ if (overwriting)
+ {
+ if (EQ (start1, start2))
+ {
+ return result;
+ }
+
+ /* Our ranges may overlap. Save the data that might be overwritten. */
+
+ if (CONSP (sequence2))
+ {
+ Elemcount len = XINT (Flength (sequence2));
+ Lisp_Object *subsequence
+ = alloca_array (Lisp_Object, min (ending2, len));
+ Elemcount counting = 0, ii = 0;
+
+ LIST_LOOP_2 (elt, sequence2)
+ {
+ if (counting == ending2)
+ {
+ break;
+ }
+
+ subsequence[ii++] = elt;
+ counting++;
+ }
+
+ check_sequence_range (sequence1, start1, end1,
+ /* The XINT (start2) is intentional here; we
+ called #'length after doing (nthcdr
+ start2 sequence2). */
+ make_int (XINT (start2) + len));
+ check_sequence_range (sequence2, start2, end2,
+ make_int (XINT (start2) + len));
+
+ while (starting1 < ending1
+ && starting2 < ending2 && !NILP (sequence1))
+ {
+ XSETCAR (sequence1, subsequence[starting2]);
+ sequence1 = XCDR (sequence1);
+ starting1++;
+ starting2++;
+ }
+ }
+ else if (STRINGP (sequence2))
+ {
+ Ibyte *p = XSTRING_DATA (sequence2),
+ *pend = p + XSTRING_LENGTH (sequence2), *pcursor,
+ *staging;
+ Bytecount ii = 0;
+
+ while (ii < starting2 && p < pend)
+ {
+ INC_IBYTEPTR (p);
+ ii++;
+ }
+
+ pcursor = p;
+
+ while (ii < ending2 && starting1 < ending1 && pcursor < pend)
+ {
+ INC_IBYTEPTR (pcursor);
+ starting1++;
+ ii++;
+ }
+
+ if (pcursor == pend)
+ {
+ check_sequence_range (sequence1, start1, end1, make_int (ii));
+ check_sequence_range (sequence2, start2, end2, make_int (ii));
+ }
+ else
+ {
+ assert ((pcursor - p) > 0);
+ staging = alloca_ibytes (pcursor - p);
+ memcpy (staging, p, pcursor - p);
+ replace_string_range (result, start1,
+ make_int (starting1),
+ staging, staging + (pcursor - p));
+ }
+ }
+ else
+ {
+ Elemcount seq_len = XINT (Flength (sequence2)), ii = 0,
+ subseq_len = min (min (ending1 - starting1, seq_len - starting1),
+ min (ending2 - starting2, seq_len - starting2));
+ Lisp_Object *subsequence = alloca_array (Lisp_Object, subseq_len);
+
+ check_sequence_range (sequence1, start1, end1, make_int (seq_len));
+ check_sequence_range (sequence2, start2, end2, make_int (seq_len));
+
+ while (starting2 < ending2 && ii < seq_len)
+ {
+ subsequence[ii] = Faref (sequence2, make_int (starting2));
+ ii++, starting2++;
+ }
+
+ ii = 0;
+
+ while (starting1 < ending1 && ii < seq_len)
+ {
+ Faset (sequence1, make_int (starting1), subsequence[ii]);
+ ii++, starting1++;
+ }
+ }
+ }
+ else if (sequence1_listp && sequence2_listp)
+ {
+ Lisp_Object sequence1_tortoise = sequence1,
+ sequence2_tortoise = sequence2;
+ Elemcount shortest_len = 0;
+
+ counting = startcounting = min (ending1, ending2);
+
+ while (counting-- > 0 && !NILP (sequence1) && !NILP (sequence2))
+ {
+ XSETCAR (sequence1,
+ CONSP (sequence2) ? XCAR (sequence2)
+: Fcar (sequence2));
+ sequence1 = CONSP (sequence1) ? XCDR (sequence1)
+: Fcdr (sequence1);
+ sequence2 = CONSP (sequence2) ? XCDR (sequence2)
+: Fcdr (sequence2);
+
+ shortest_len++;
+
+ if (startcounting - counting > CIRCULAR_LIST_SUSPICION_LENGTH)
+ {
+ if (counting & 1)
+ {
+ sequence1_tortoise = XCDR (sequence1_tortoise);
+ sequence2_tortoise = XCDR (sequence2_tortoise);
+ }
+
+ if (EQ (sequence1, sequence1_tortoise))
+ {
+ signal_circular_list_error (sequence1);
+ }
+
+ if (EQ (sequence2, sequence2_tortoise))
+ {
+ signal_circular_list_error (sequence2);
+ }
+ }
+ }
+
+ if (NILP (sequence1))
+ {
+ check_sequence_range (sequence1, start1, end1,
+ make_int (XINT (start1) + shortest_len));
+ }
+ else if (NILP (sequence2))
+ {
+ check_sequence_range (sequence2, start2, end2,
+ make_int (XINT (start2) + shortest_len));
+ }
+ }
+ else if (sequence1_listp)
+ {
+ if (STRINGP (sequence2))
+ {
+ Ibyte *s2_data = XSTRING_DATA (sequence2),
+ *s2_end = s2_data + XSTRING_LENGTH (sequence2);
+ Elemcount char_count = 0;
+ Lisp_Object character;
+
+ while (char_count < starting2 && s2_data < s2_end)
+ {
+ INC_IBYTEPTR (s2_data);
+ char_count++;
+ }
+
+ while (starting1 < ending1 && starting2 < ending2
+ && s2_data < s2_end && !NILP (sequence1))
+ {
+ character = make_char (itext_ichar (s2_data));
+ CONSP (sequence1) ?
+ XSETCAR (sequence1, character)
+: Fsetcar (sequence1, character);
+ sequence1 = XCDR (sequence1);
+ starting1++;
+ starting2++;
+ char_count++;
+ INC_IBYTEPTR (s2_data);
+ }
+
+ if (NILP (sequence1))
+ {
+ check_sequence_range (sequence1, start1, end1,
+ make_int (XINT (start1) + starting1));
+ }
+
+ if (s2_data == s2_end)
+ {
+ check_sequence_range (sequence2, start2, end2,
+ make_int (char_count));
+ }
+ }
+ else
+ {
+ Elemcount len2 = XINT (Flength (sequence2));
+ check_sequence_range (sequence2, start2, end2, make_int (len2));
+
+ ending2 = min (ending2, len2);
+ while (starting2 < ending2
+ && starting1 < ending1 && !NILP (sequence1))
+ {
+ CHECK_CONS (sequence1);
+ XSETCAR (sequence1, Faref (sequence2, make_int (starting2)));
+ sequence1 = XCDR (sequence1);
+ starting1++;
+ starting2++;
+ }
+
+ if (NILP (sequence1))
+ {
+ check_sequence_range (sequence1, start1, end1,
+ make_int (XINT (start1) + starting1));
+ }
+ }
+ }
+ else if (sequence2_listp)
+ {
+ if (STRINGP (sequence1))
+ {
+ Elemcount ii = 0, count, len = string_char_length (sequence1);
+ Ibyte *staging, *cursor;
+ Lisp_Object obj;
+
+ check_sequence_range (sequence1, start1, end1, make_int (len));
+ ending1 = min (ending1, len);
+ count = ending1 - starting1;
+ staging = cursor = alloca_ibytes (count * MAX_ICHAR_LEN);
+
+ while (ii < count && !NILP (sequence2))
+ {
+ obj = CONSP (sequence2) ? XCAR (sequence2)
+: Fcar (sequence2);
+
+ CHECK_CHAR_COERCE_INT (obj);
+ cursor += set_itext_ichar (cursor, XCHAR (obj));
+ ii++;
+ sequence2 = XCDR (sequence2);
+ }
+
+ if (NILP (sequence2))
+ {
+ check_sequence_range (sequence2, start2, end2,
+ make_int (XINT (start2) + ii));
+ }
+
+ replace_string_range (result, start1, make_int (XINT (start1) + ii),
+ staging, cursor);
+ }
+ else
+ {
+ Elemcount len = XINT (Flength (sequence1));
+
+ check_sequence_range (sequence1, start2, end1, make_int (len));
+ ending1 = min (ending2, min (ending1, len));
+
+ while (starting1 < ending1 && !NILP (sequence2))
+ {
+ Faset (sequence1, make_int (starting1),
+ CONSP (sequence2) ? XCAR (sequence2)
+: Fcar (sequence2));
+ sequence2 = XCDR (sequence2);
+ starting1++;
+ starting2++;
+ }
+
+ if (NILP (sequence2))
+ {
+ check_sequence_range (sequence2, start2, end2,
+ make_int (XINT (start2) + starting2));
+ }
+ }
+ }
+ else
+ {
+ if (STRINGP (sequence1) && STRINGP (sequence2))
+ {
+ Ibyte *p2 = XSTRING_DATA (sequence2),
+ *p2end = p2 + XSTRING_LENGTH (sequence2), *p2cursor;
+ Charcount ii = 0, len1 = string_char_length (sequence1);
+
+ while (ii < starting2 && p2 < p2end)
+ {
+ INC_IBYTEPTR (p2);
+ ii++;
+ }
+
+ p2cursor = p2;
+ ending1 = min (ending1, len1);
+
+ while (ii < ending2 && starting1 < ending1 && p2cursor < p2end)
+ {
+ INC_IBYTEPTR (p2cursor);
+ ii++;
+ starting1++;
+ }
+
+ if (p2cursor == p2end)
+ {
+ check_sequence_range (sequence2, start2, end2, make_int (ii));
+ }
+
+ /* This isn't great; any error message won't necessarily reflect
+ the END1 that was supplied to #'replace. */
+ replace_string_range (result, start1, make_int (starting1),
+ p2, p2cursor);
+ }
+ else if (STRINGP (sequence1))
+ {
+ Ibyte *staging, *cursor;
+ Elemcount count, len1 = string_char_length (sequence1);
+ Elemcount len2 = XINT (Flength (sequence2)), ii = 0;;
+ Lisp_Object obj;
+
+ check_sequence_range (sequence1, start1, end1, make_int (len1));
+ check_sequence_range (sequence2, start2, end2, make_int (len2));
+
+ ending1 = min (ending1, len1);
+ ending2 = min (ending2, len2);
+ count = min (ending1 - starting1, ending2 - starting2);
+ staging = cursor = alloca_ibytes (count * MAX_ICHAR_LEN);
+
+ ii = 0;
+ while (ii < count)
+ {
+ obj = Faref (sequence2, make_int (starting2));
+
+ CHECK_CHAR_COERCE_INT (obj);
+ cursor += set_itext_ichar (cursor, XCHAR (obj));
+ starting2++, ii++;
+ }
+
+ replace_string_range (result, start1,
+ make_int (XINT (start1) + count),
+ staging, cursor);
+ }
+ else if (STRINGP (sequence2))
+ {
+ Ibyte *p2 = XSTRING_DATA (sequence2),
+ *p2end = p2 + XSTRING_LENGTH (sequence2);
+ Elemcount len1 = XINT (Flength (sequence1)), ii = 0;
+
+ check_sequence_range (sequence1, start1, end1, make_int (len1));
+ ending1 = min (ending1, len1);
+
+ while (ii < starting2 && p2 < p2end)
+ {
+ INC_IBYTEPTR (p2);
+ ii++;
+ }
+
+ while (p2 < p2end && starting1 < ending1 && starting2 < ending2)
+ {
+ Faset (sequence1, make_int (starting1),
+ make_char (itext_ichar (p2)));
+ INC_IBYTEPTR (p2);
+ starting1++;
+ starting2++;
+ ii++;
+ }
+
+ if (p2 == p2end)
+ {
+ check_sequence_range (sequence2, start2, end2, make_int (ii));
+ }
+ }
+ else
+ {
+ Elemcount len1 = XINT (Flength (sequence1)),
+ len2 = XINT (Flength (sequence2));
+
+ check_sequence_range (sequence1, start1, end1, make_int (len1));
+ check_sequence_range (sequence2, start2, end2, make_int (len2));
+
+ ending1 = min (ending1, len1);
+ ending2 = min (ending2, len2);
+
+ while (starting1 < ending1 && starting2 < ending2)
+ {
+ Faset (sequence1, make_int (starting1),
+ Faref (sequence2, make_int (starting2)));
+ starting1++;
+ starting2++;
+ }
+ }
+ }
+
+ return result;
+}
Lisp_Object
add_suffix_to_symbol (Lisp_Object symbol, const Ascbyte *ascii_string)
@@ -5947,6 +6585,7 @@
DEFSYMBOL (Qbit_vector);
defsymbol (&QsortX, "sort*");
DEFSYMBOL (Qreduce);
+ DEFSYMBOL (Qreplace);
DEFSYMBOL (Qmapconcat);
defsymbol (&QmapcarX, "mapcar*");
@@ -5963,6 +6602,10 @@
DEFKEYWORD (Q_from_end);
DEFKEYWORD (Q_initial_value);
+ DEFKEYWORD (Q_start1);
+ DEFKEYWORD (Q_start2);
+ DEFKEYWORD (Q_end1);
+ DEFKEYWORD (Q_end2);
DEFSYMBOL (Qyes_or_no_p);
@@ -6062,6 +6705,7 @@
DEFSUBR (Freduce);
DEFSUBR (Freplace_list);
+ DEFSUBR (Freplace);
DEFSUBR (Fload_average);
DEFSUBR (Ffeaturep);
DEFSUBR (Frequire);
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/mailman/listinfo/xemacs-patches
[COMMIT] Add support for the X11 dead-stroke in x-compose.el.
14 years, 3 months
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1283715065 -3600
# Node ID dceee3855f15dbb5f66e965b04eb0e503fad8da5
# Parent 02c282ae97cb4acba2282536c0fcc100754a6f0e
Add support for the X11 dead-stroke in x-compose.el.
2010-09-05 Aidan Kehoe <kehoea(a)parhasard.net>
* x-compose.el (define-compose-map, compose-map)
(decide-on-bindings): Support the precomposed characters with
stroke here too, necessary for Polish and Danish, among others.
* x-init.el (x-initialize-compose): Add the appropriate map
autoloads and bindings here.
diff -r 02c282ae97cb -r dceee3855f15 lisp/ChangeLog
--- a/lisp/ChangeLog Sun Sep 05 20:12:53 2010 +0100
+++ b/lisp/ChangeLog Sun Sep 05 20:31:05 2010 +0100
@@ -1,3 +1,11 @@
+2010-09-05 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * x-compose.el (define-compose-map, compose-map)
+ (decide-on-bindings): Support the precomposed characters with
+ stroke here too, necessary for Polish and Danish, among others.
+ * x-init.el (x-initialize-compose): Add the appropriate map
+ autoloads and bindings here.
+
2010-09-03 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-extra.el (coerce):
diff -r 02c282ae97cb -r dceee3855f15 lisp/x-compose.el
--- a/lisp/x-compose.el Sun Sep 05 20:12:53 2010 +0100
+++ b/lisp/x-compose.el Sun Sep 05 20:31:05 2010 +0100
@@ -156,7 +156,7 @@
compose-cedilla-map compose-diaeresis-map compose-circumflex-map
compose-tilde-map compose-ring-map compose-caron-map compose-macron-map
compose-breve-map compose-dot-map compose-doubleacute-map
- compose-ogonek-map compose-hook-map compose-horn-map))
+ compose-ogonek-map compose-hook-map compose-horn-map compose-stroke-map))
(define-key compose-map 'acute compose-acute-map)
(define-key compose-map 'grave compose-grave-map)
@@ -171,6 +171,7 @@
(define-key compose-map 'ogonek compose-ogonek-map)
(define-key compose-map 'breve compose-breve-map)
(define-key compose-map 'abovedot compose-dot-map)
+(define-key compose-map 'stroke compose-stroke-map)
;;(define-key function-key-map [multi-key] compose-map)
@@ -195,6 +196,7 @@
(define-key compose-map [~] compose-tilde-map)
(define-key compose-map [degree] compose-ring-map)
(define-key compose-map [?*] compose-ring-map)
+(define-key compose-map [stroke] compose-stroke-map)
(loop
for (keysym character-code map)
@@ -564,7 +566,42 @@
(compose-horn-map [?O] #x01A0) ;; CAPITAL O WITH HORN
(compose-horn-map [?U] #x01AF) ;; CAPITAL U WITH HORN
(compose-horn-map [?o] #x01A1) ;; SMALL O WITH HORN
- (compose-horn-map [?u] #x01B0))) ;; SMALL U WITH HORN
+ (compose-horn-map [?u] #x01B0) ;; SMALL U WITH HORN
+ (compose-stroke-map [?A] #x023a) ;; CAPITAL A WITH STROKE
+ (compose-stroke-map [?a] #x2c65) ;; SMALL A WITH STROKE
+ (compose-stroke-map [?B] #x0243) ;; CAPITAL B WITH STROKE
+ (compose-stroke-map [?b] #x0180) ;; SMALL B WITH STROKE
+ (compose-stroke-map [?C] #x023b) ;; CAPITAL C WITH STROKE
+ (compose-stroke-map [?c] #x023c) ;; SMALL C WITH STROKE
+ (compose-stroke-map [?D] #x0110) ;; CAPITAL D WITH STROKE
+ (compose-stroke-map [?d] #x0111) ;; SMALL D WITH STROKE
+ (compose-stroke-map [?E] #x0246) ;; CAPITAL E WITH STROKE
+ (compose-stroke-map [?e] #x0247) ;; SMALL E WITH STROKE
+ (compose-stroke-map [?G] #x01e4) ;; CAPITAL G WITH STROKE
+ (compose-stroke-map [?g] #x01e5) ;; SMALL G WITH STROKE
+ (compose-stroke-map [?H] #x0126) ;; CAPITAL H WITH STROKE
+ (compose-stroke-map [?h] #x0127) ;; SMALL H WITH STROKE
+ (compose-stroke-map [?I] #x0197) ;; CAPITAL I WITH STROKE
+ (compose-stroke-map [?i] #x0268) ;; SMALL I WITH STROKE
+ (compose-stroke-map [?J] #x0248) ;; CAPITAL J WITH STROKE
+ (compose-stroke-map [?j] #x0249) ;; SMALL J WITH STROKE
+ (compose-stroke-map [?K] #xa740) ;; CAPITAL K WITH STROKE
+ (compose-stroke-map [?k] #xa741) ;; SMALL K WITH STROKE
+ (compose-stroke-map [?L] #x0141) ;; CAPITAL L WITH STROKE
+ (compose-stroke-map [?l] #x0142) ;; SMALL L WITH STROKE
+ (compose-stroke-map [?O] #x00d8) ;; CAPITAL O WITH STROKE
+ (compose-stroke-map [?o] #x00f8) ;; SMALL O WITH STROKE
+ (compose-stroke-map [?P] #x2c63) ;; CAPITAL P WITH STROKE
+ (compose-stroke-map [?p] #x1d7d) ;; SMALL P WITH STROKE
+ (compose-stroke-map [?R] #x024c) ;; CAPITAL R WITH STROKE
+ (compose-stroke-map [?r] #x024d) ;; SMALL R WITH STROKE
+ (compose-stroke-map [?T] #x0166) ;; CAPITAL T WITH STROKE
+ (compose-stroke-map [?t] #x0167) ;; SMALL T WITH STROKE
+ (compose-stroke-map [?Y] #x024e) ;; CAPITAL Y WITH STROKE
+ (compose-stroke-map [?y] #x024f) ;; SMALL Y WITH STROKE
+ (compose-stroke-map [?Z] #x01b5) ;; CAPITAL Z WITH STROKE
+ (compose-stroke-map [?z] #x01b6) ;; SMALL Z WITH STROKE
+))
;;; The rest of the compose-map. These are the composed characters
diff -r 02c282ae97cb -r dceee3855f15 lisp/x-init.el
--- a/lisp/x-init.el Sun Sep 05 20:12:53 2010 +0100
+++ b/lisp/x-init.el Sun Sep 05 20:31:05 2010 +0100
@@ -92,7 +92,7 @@
compose-ring-map compose-caron-map compose-macron-map
compose-breve-map compose-dot-map
compose-doubleacute-map compose-ogonek-map
- compose-hook-map compose-horn-map)
+ compose-hook-map compose-horn-map compose-stroke-map)
do (autoload map "x-compose" nil t 'keymap))
(loop
@@ -208,7 +208,8 @@
(dead-doubleacute compose-doubleacute-map)
(dead-ogonek compose-ogonek-map)
(dead-hook compose-hook-map)
- (dead-horn compose-horn-map))
+ (dead-horn compose-horn-map)
+ (dead-stroke compose-stroke-map))
;; Get the correct value for function-key-map
with function-key-map = (symbol-value-in-console 'function-key-map
--
“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://calypso.tux.org/mailman/listinfo/xemacs-patches
commit: Add support for the X11 dead-stroke in x-compose.el.
14 years, 3 months
Aidan Kehoe
changeset: 5260:dceee3855f15
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sun Sep 05 20:31:05 2010 +0100
files: lisp/ChangeLog lisp/x-compose.el lisp/x-init.el
description:
Add support for the X11 dead-stroke in x-compose.el.
2010-09-05 Aidan Kehoe <kehoea(a)parhasard.net>
* x-compose.el (define-compose-map, compose-map)
(decide-on-bindings): Support the precomposed characters with
stroke here too, necessary for Polish and Danish, among others.
* x-init.el (x-initialize-compose): Add the appropriate map
autoloads and bindings here.
diff -r 02c282ae97cb -r dceee3855f15 lisp/ChangeLog
--- a/lisp/ChangeLog Sun Sep 05 20:12:53 2010 +0100
+++ b/lisp/ChangeLog Sun Sep 05 20:31:05 2010 +0100
@@ -1,3 +1,11 @@
+2010-09-05 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * x-compose.el (define-compose-map, compose-map)
+ (decide-on-bindings): Support the precomposed characters with
+ stroke here too, necessary for Polish and Danish, among others.
+ * x-init.el (x-initialize-compose): Add the appropriate map
+ autoloads and bindings here.
+
2010-09-03 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-extra.el (coerce):
diff -r 02c282ae97cb -r dceee3855f15 lisp/x-compose.el
--- a/lisp/x-compose.el Sun Sep 05 20:12:53 2010 +0100
+++ b/lisp/x-compose.el Sun Sep 05 20:31:05 2010 +0100
@@ -156,7 +156,7 @@
compose-cedilla-map compose-diaeresis-map compose-circumflex-map
compose-tilde-map compose-ring-map compose-caron-map compose-macron-map
compose-breve-map compose-dot-map compose-doubleacute-map
- compose-ogonek-map compose-hook-map compose-horn-map))
+ compose-ogonek-map compose-hook-map compose-horn-map compose-stroke-map))
(define-key compose-map 'acute compose-acute-map)
(define-key compose-map 'grave compose-grave-map)
@@ -171,6 +171,7 @@
(define-key compose-map 'ogonek compose-ogonek-map)
(define-key compose-map 'breve compose-breve-map)
(define-key compose-map 'abovedot compose-dot-map)
+(define-key compose-map 'stroke compose-stroke-map)
;;(define-key function-key-map [multi-key] compose-map)
@@ -195,6 +196,7 @@
(define-key compose-map [~] compose-tilde-map)
(define-key compose-map [degree] compose-ring-map)
(define-key compose-map [?*] compose-ring-map)
+(define-key compose-map [stroke] compose-stroke-map)
(loop
for (keysym character-code map)
@@ -564,7 +566,42 @@
(compose-horn-map [?O] #x01A0) ;; CAPITAL O WITH HORN
(compose-horn-map [?U] #x01AF) ;; CAPITAL U WITH HORN
(compose-horn-map [?o] #x01A1) ;; SMALL O WITH HORN
- (compose-horn-map [?u] #x01B0))) ;; SMALL U WITH HORN
+ (compose-horn-map [?u] #x01B0) ;; SMALL U WITH HORN
+ (compose-stroke-map [?A] #x023a) ;; CAPITAL A WITH STROKE
+ (compose-stroke-map [?a] #x2c65) ;; SMALL A WITH STROKE
+ (compose-stroke-map [?B] #x0243) ;; CAPITAL B WITH STROKE
+ (compose-stroke-map [?b] #x0180) ;; SMALL B WITH STROKE
+ (compose-stroke-map [?C] #x023b) ;; CAPITAL C WITH STROKE
+ (compose-stroke-map [?c] #x023c) ;; SMALL C WITH STROKE
+ (compose-stroke-map [?D] #x0110) ;; CAPITAL D WITH STROKE
+ (compose-stroke-map [?d] #x0111) ;; SMALL D WITH STROKE
+ (compose-stroke-map [?E] #x0246) ;; CAPITAL E WITH STROKE
+ (compose-stroke-map [?e] #x0247) ;; SMALL E WITH STROKE
+ (compose-stroke-map [?G] #x01e4) ;; CAPITAL G WITH STROKE
+ (compose-stroke-map [?g] #x01e5) ;; SMALL G WITH STROKE
+ (compose-stroke-map [?H] #x0126) ;; CAPITAL H WITH STROKE
+ (compose-stroke-map [?h] #x0127) ;; SMALL H WITH STROKE
+ (compose-stroke-map [?I] #x0197) ;; CAPITAL I WITH STROKE
+ (compose-stroke-map [?i] #x0268) ;; SMALL I WITH STROKE
+ (compose-stroke-map [?J] #x0248) ;; CAPITAL J WITH STROKE
+ (compose-stroke-map [?j] #x0249) ;; SMALL J WITH STROKE
+ (compose-stroke-map [?K] #xa740) ;; CAPITAL K WITH STROKE
+ (compose-stroke-map [?k] #xa741) ;; SMALL K WITH STROKE
+ (compose-stroke-map [?L] #x0141) ;; CAPITAL L WITH STROKE
+ (compose-stroke-map [?l] #x0142) ;; SMALL L WITH STROKE
+ (compose-stroke-map [?O] #x00d8) ;; CAPITAL O WITH STROKE
+ (compose-stroke-map [?o] #x00f8) ;; SMALL O WITH STROKE
+ (compose-stroke-map [?P] #x2c63) ;; CAPITAL P WITH STROKE
+ (compose-stroke-map [?p] #x1d7d) ;; SMALL P WITH STROKE
+ (compose-stroke-map [?R] #x024c) ;; CAPITAL R WITH STROKE
+ (compose-stroke-map [?r] #x024d) ;; SMALL R WITH STROKE
+ (compose-stroke-map [?T] #x0166) ;; CAPITAL T WITH STROKE
+ (compose-stroke-map [?t] #x0167) ;; SMALL T WITH STROKE
+ (compose-stroke-map [?Y] #x024e) ;; CAPITAL Y WITH STROKE
+ (compose-stroke-map [?y] #x024f) ;; SMALL Y WITH STROKE
+ (compose-stroke-map [?Z] #x01b5) ;; CAPITAL Z WITH STROKE
+ (compose-stroke-map [?z] #x01b6) ;; SMALL Z WITH STROKE
+))
;;; The rest of the compose-map. These are the composed characters
diff -r 02c282ae97cb -r dceee3855f15 lisp/x-init.el
--- a/lisp/x-init.el Sun Sep 05 20:12:53 2010 +0100
+++ b/lisp/x-init.el Sun Sep 05 20:31:05 2010 +0100
@@ -92,7 +92,7 @@
compose-ring-map compose-caron-map compose-macron-map
compose-breve-map compose-dot-map
compose-doubleacute-map compose-ogonek-map
- compose-hook-map compose-horn-map)
+ compose-hook-map compose-horn-map compose-stroke-map)
do (autoload map "x-compose" nil t 'keymap))
(loop
@@ -208,7 +208,8 @@
(dead-doubleacute compose-doubleacute-map)
(dead-ogonek compose-ogonek-map)
(dead-hook compose-hook-map)
- (dead-horn compose-horn-map))
+ (dead-horn compose-horn-map)
+ (dead-stroke compose-stroke-map))
;; Get the correct value for function-key-map
with function-key-map = (symbol-value-in-console 'function-key-map
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/mailman/listinfo/xemacs-patches
[COMMIT] Read and print char table defaults, chartab.c
14 years, 3 months
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1283713973 -3600
# Node ID 02c282ae97cb4acba2282536c0fcc100754a6f0e
# Parent 1ed4cefddd122c1707463d21accc4b5c10bd6a90
Read and print char table defaults, chartab.c
2010-09-05 Aidan Kehoe <kehoea(a)parhasard.net>
* chartab.c (char_table_default_for_type,
chartab_default_validate): New.
(print_char_table, Freset_char_table, chartab_default_validate)
(chartab_instantiate, structure_type_create_chartab):
Accept keyword :default in the read syntax for char tables, and
print the default when it is not what was expected for the
time. Makes it a little easier to debug things.
diff -r 1ed4cefddd12 -r 02c282ae97cb src/ChangeLog
--- a/src/ChangeLog Sun Sep 05 19:22:37 2010 +0100
+++ b/src/ChangeLog Sun Sep 05 20:12:53 2010 +0100
@@ -1,3 +1,13 @@
+2010-09-05 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * chartab.c (char_table_default_for_type,
+ chartab_default_validate): New.
+ (print_char_table, Freset_char_table, chartab_default_validate)
+ (chartab_instantiate, structure_type_create_chartab):
+ Accept keyword :default in the read syntax for char tables, and
+ print the default when it is not what was expected for the
+ time. Makes it a little easier to debug things.
+
2010-09-05 Aidan Kehoe <kehoea(a)parhasard.net>
* editfns.c (Fformat_time_string):
diff -r 1ed4cefddd12 -r 02c282ae97cb src/chartab.c
--- a/src/chartab.c Sun Sep 05 19:22:37 2010 +0100
+++ b/src/chartab.c Sun Sep 05 20:12:53 2010 +0100
@@ -42,7 +42,7 @@
#include "chartab.h"
#include "syntax.h"
-Lisp_Object Qchar_tablep, Qchar_table;
+Lisp_Object Qchar_tablep, Qchar_table, Q_default;
Lisp_Object Vall_syntax_tables;
@@ -301,6 +301,30 @@
return Qnil; /* not reached */
}
+static Lisp_Object
+char_table_default_for_type (enum char_table_type type)
+{
+ switch (type)
+ {
+ case CHAR_TABLE_TYPE_CHAR:
+ return make_char (0);
+ break;
+ case CHAR_TABLE_TYPE_DISPLAY:
+ case CHAR_TABLE_TYPE_GENERIC:
+#ifdef MULE
+ case CHAR_TABLE_TYPE_CATEGORY:
+#endif /* MULE */
+ return Qnil;
+ break;
+
+ case CHAR_TABLE_TYPE_SYNTAX:
+ return make_integer (Sinherit);
+ break;
+ }
+ ABORT();
+ return Qzero;
+}
+
struct ptemap
{
Lisp_Object printcharfun;
@@ -336,8 +360,15 @@
arg.printcharfun = printcharfun;
arg.first = 1;
- write_fmt_string_lisp (printcharfun, "#s(char-table :type %s :data (",
- 1, char_table_type_to_symbol (ct->type));
+ write_fmt_string_lisp (printcharfun,
+ "#s(char-table :type %s", 1,
+ char_table_type_to_symbol (ct->type));
+ if (!(EQ (ct->default_, char_table_default_for_type (ct->type))))
+ {
+ write_fmt_string_lisp (printcharfun, " :default %S", 1, ct->default_);
+ }
+
+ write_ascstring (printcharfun, " :data (");
map_char_table (obj, &range, print_table_entry, &arg);
write_ascstring (printcharfun, "))");
@@ -492,37 +523,13 @@
(char_table))
{
Lisp_Char_Table *ct;
- Lisp_Object def;
CHECK_CHAR_TABLE (char_table);
ct = XCHAR_TABLE (char_table);
- switch (ct->type)
- {
- case CHAR_TABLE_TYPE_CHAR:
- def = make_char (0);
- break;
- case CHAR_TABLE_TYPE_DISPLAY:
- case CHAR_TABLE_TYPE_GENERIC:
-#ifdef MULE
- case CHAR_TABLE_TYPE_CATEGORY:
-#endif /* MULE */
- def = Qnil;
- break;
-
- case CHAR_TABLE_TYPE_SYNTAX:
- def = make_int (Sinherit);
- break;
-
- default:
- ABORT ();
- def = Qnil;
- break;
- }
-
/* Avoid doubly updating the syntax table by setting the default ourselves,
since set_char_table_default() also updates. */
- ct->default_ = def;
+ ct->default_ = char_table_default_for_type (ct->type);
fill_char_table (ct, Qunbound);
return Qnil;
@@ -1543,12 +1550,22 @@
return 1;
}
+static int
+chartab_default_validate (Lisp_Object UNUSED (keyword),
+ Lisp_Object UNUSED (value),
+ Error_Behavior UNUSED (errb))
+{
+ /* We can't yet validate this, since we don't know what the type of the
+ char table is. We do the validation below in chartab_instantiate(). */
+ return 1;
+}
+
static Lisp_Object
chartab_instantiate (Lisp_Object plist)
{
Lisp_Object chartab;
Lisp_Object type = Qgeneric;
- Lisp_Object dataval = Qnil;
+ Lisp_Object dataval = Qnil, default_ = Qunbound;
if (KEYWORDP (Fcar (plist)))
{
@@ -1562,6 +1579,10 @@
{
type = value;
}
+ else if (EQ (key, Q_default))
+ {
+ default_ = value;
+ }
else if (!KEYWORDP (key))
{
signal_error
@@ -1598,6 +1619,13 @@
#endif /* NEED_TO_HANDLE_21_4_CODE */
chartab = Fmake_char_table (type);
+ if (!UNBOUNDP (default_))
+ {
+ check_valid_char_table_value (default_, XCHAR_TABLE_TYPE (chartab),
+ ERROR_ME);
+ set_char_table_default (chartab, default_);
+ set_char_table_default (XCHAR_TABLE (chartab)->mirror_table, default_);
+ }
while (!NILP (dataval))
{
@@ -1872,6 +1900,7 @@
DEFSYMBOL (Qchar_table);
DEFSYMBOL_MULTIWORD_PREDICATE (Qchar_tablep);
+ DEFKEYWORD (Q_default);
DEFSUBR (Fchar_table_p);
DEFSUBR (Fchar_table_type_list);
@@ -1926,6 +1955,7 @@
define_structure_type_keyword (st, Q_type, chartab_type_validate);
define_structure_type_keyword (st, Q_data, chartab_data_validate);
+ define_structure_type_keyword (st, Q_default, chartab_default_validate);
}
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://calypso.tux.org/mailman/listinfo/xemacs-patches
commit: Read and print char table defaults, chartab.c
14 years, 3 months
Aidan Kehoe
changeset: 5259:02c282ae97cb
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sun Sep 05 20:12:53 2010 +0100
files: src/ChangeLog src/chartab.c
description:
Read and print char table defaults, chartab.c
2010-09-05 Aidan Kehoe <kehoea(a)parhasard.net>
* chartab.c (char_table_default_for_type,
chartab_default_validate): New.
(print_char_table, Freset_char_table, chartab_default_validate)
(chartab_instantiate, structure_type_create_chartab):
Accept keyword :default in the read syntax for char tables, and
print the default when it is not what was expected for the
time. Makes it a little easier to debug things.
diff -r 1ed4cefddd12 -r 02c282ae97cb src/ChangeLog
--- a/src/ChangeLog Sun Sep 05 19:22:37 2010 +0100
+++ b/src/ChangeLog Sun Sep 05 20:12:53 2010 +0100
@@ -1,3 +1,13 @@
+2010-09-05 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * chartab.c (char_table_default_for_type,
+ chartab_default_validate): New.
+ (print_char_table, Freset_char_table, chartab_default_validate)
+ (chartab_instantiate, structure_type_create_chartab):
+ Accept keyword :default in the read syntax for char tables, and
+ print the default when it is not what was expected for the
+ time. Makes it a little easier to debug things.
+
2010-09-05 Aidan Kehoe <kehoea(a)parhasard.net>
* editfns.c (Fformat_time_string):
diff -r 1ed4cefddd12 -r 02c282ae97cb src/chartab.c
--- a/src/chartab.c Sun Sep 05 19:22:37 2010 +0100
+++ b/src/chartab.c Sun Sep 05 20:12:53 2010 +0100
@@ -42,7 +42,7 @@
#include "chartab.h"
#include "syntax.h"
-Lisp_Object Qchar_tablep, Qchar_table;
+Lisp_Object Qchar_tablep, Qchar_table, Q_default;
Lisp_Object Vall_syntax_tables;
@@ -301,6 +301,30 @@
return Qnil; /* not reached */
}
+static Lisp_Object
+char_table_default_for_type (enum char_table_type type)
+{
+ switch (type)
+ {
+ case CHAR_TABLE_TYPE_CHAR:
+ return make_char (0);
+ break;
+ case CHAR_TABLE_TYPE_DISPLAY:
+ case CHAR_TABLE_TYPE_GENERIC:
+#ifdef MULE
+ case CHAR_TABLE_TYPE_CATEGORY:
+#endif /* MULE */
+ return Qnil;
+ break;
+
+ case CHAR_TABLE_TYPE_SYNTAX:
+ return make_integer (Sinherit);
+ break;
+ }
+ ABORT();
+ return Qzero;
+}
+
struct ptemap
{
Lisp_Object printcharfun;
@@ -336,8 +360,15 @@
arg.printcharfun = printcharfun;
arg.first = 1;
- write_fmt_string_lisp (printcharfun, "#s(char-table :type %s :data (",
- 1, char_table_type_to_symbol (ct->type));
+ write_fmt_string_lisp (printcharfun,
+ "#s(char-table :type %s", 1,
+ char_table_type_to_symbol (ct->type));
+ if (!(EQ (ct->default_, char_table_default_for_type (ct->type))))
+ {
+ write_fmt_string_lisp (printcharfun, " :default %S", 1, ct->default_);
+ }
+
+ write_ascstring (printcharfun, " :data (");
map_char_table (obj, &range, print_table_entry, &arg);
write_ascstring (printcharfun, "))");
@@ -492,37 +523,13 @@
(char_table))
{
Lisp_Char_Table *ct;
- Lisp_Object def;
CHECK_CHAR_TABLE (char_table);
ct = XCHAR_TABLE (char_table);
- switch (ct->type)
- {
- case CHAR_TABLE_TYPE_CHAR:
- def = make_char (0);
- break;
- case CHAR_TABLE_TYPE_DISPLAY:
- case CHAR_TABLE_TYPE_GENERIC:
-#ifdef MULE
- case CHAR_TABLE_TYPE_CATEGORY:
-#endif /* MULE */
- def = Qnil;
- break;
-
- case CHAR_TABLE_TYPE_SYNTAX:
- def = make_int (Sinherit);
- break;
-
- default:
- ABORT ();
- def = Qnil;
- break;
- }
-
/* Avoid doubly updating the syntax table by setting the default ourselves,
since set_char_table_default() also updates. */
- ct->default_ = def;
+ ct->default_ = char_table_default_for_type (ct->type);
fill_char_table (ct, Qunbound);
return Qnil;
@@ -1543,12 +1550,22 @@
return 1;
}
+static int
+chartab_default_validate (Lisp_Object UNUSED (keyword),
+ Lisp_Object UNUSED (value),
+ Error_Behavior UNUSED (errb))
+{
+ /* We can't yet validate this, since we don't know what the type of the
+ char table is. We do the validation below in chartab_instantiate(). */
+ return 1;
+}
+
static Lisp_Object
chartab_instantiate (Lisp_Object plist)
{
Lisp_Object chartab;
Lisp_Object type = Qgeneric;
- Lisp_Object dataval = Qnil;
+ Lisp_Object dataval = Qnil, default_ = Qunbound;
if (KEYWORDP (Fcar (plist)))
{
@@ -1561,6 +1578,10 @@
else if (EQ (key, Q_type))
{
type = value;
+ }
+ else if (EQ (key, Q_default))
+ {
+ default_ = value;
}
else if (!KEYWORDP (key))
{
@@ -1598,6 +1619,13 @@
#endif /* NEED_TO_HANDLE_21_4_CODE */
chartab = Fmake_char_table (type);
+ if (!UNBOUNDP (default_))
+ {
+ check_valid_char_table_value (default_, XCHAR_TABLE_TYPE (chartab),
+ ERROR_ME);
+ set_char_table_default (chartab, default_);
+ set_char_table_default (XCHAR_TABLE (chartab)->mirror_table, default_);
+ }
while (!NILP (dataval))
{
@@ -1872,6 +1900,7 @@
DEFSYMBOL (Qchar_table);
DEFSYMBOL_MULTIWORD_PREDICATE (Qchar_tablep);
+ DEFKEYWORD (Q_default);
DEFSUBR (Fchar_table_p);
DEFSUBR (Fchar_table_type_list);
@@ -1926,6 +1955,7 @@
define_structure_type_keyword (st, Q_type, chartab_type_validate);
define_structure_type_keyword (st, Q_data, chartab_data_validate);
+ define_structure_type_keyword (st, Q_default, chartab_default_validate);
}
void
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/mailman/listinfo/xemacs-patches
Re: [Q] Support Roman month numbers, #'format-time-string
14 years, 3 months
Aidan Kehoe
Ar an ceathrú lá de mí Méan Fómhair, scríobh Stephen J. Turnbull:
> QUERY
>
> Aidan Kehoe writes:
>
> > This change would be more useful in the C library, but I don’t have
> > commit access there.
>
> > +@item %\xe6 (the ISO-8859-1 lowercase ae character)
> > +This stands for the month as a lowercase Roman number (i-xii)
> > +@item %\xc6 (the ISO-8859-1 uppercase AE character)
> > +This stands for the month as an uppercase Roman number (I-XII)
>
> This is not necessarily true in non-Mule because of the unibyte font
> hack. What do you think about adding a note? Something like:
>
> In non-Mule (unibyte) XEmacs, \xe6 and \xc6 will be converted
> into literal byte values, and how they appear will depend on the
> registry of the font being used.
I won’t bother. There are lots of other places where we assume ISO-8859-1,
cf. the following on a Mule build:
(let ((string "\xa9\xe3\xf7"))
(mapcar* #'=
(mapcar #'char-syntax string)
(mapcar #'char-syntax (decode-coding-string string 'koi8-r))
(mapcar #'char-syntax (decode-coding-string string 'iso-8859-2))))
=> (nil t nil)
Or:
(let ((string "\xa9\xe3\xf7"))
(mapcar* #'=
(mapcar #'canoncase string)
(encode-coding-string
(map 'string #'canoncase (decode-coding-string string 'koi8-r))
'koi8-r)
(encode-coding-string
(map 'string #'canoncase
(decode-coding-string string 'iso-8859-2))
'iso-8859-2)))
=> (nil nil nil)
These both reflect differences that make non-Mule XEmacs unpleasant to use
with non-ISO-8859-1 fonts. If you’re doing this, you’re asking for
irritation, and this #'format-time-string tick is the least of them.
> > diff -r b6a398dbb403 -r 1537701f08a1 src/editfns.c
> > --- a/src/editfns.c Wed Sep 01 12:51:32 2010 +0100
> > +++ b/src/editfns.c Thu Sep 02 12:00:06 2010 +0100
> > @@ -1044,11 +1044,10 @@
> > %Y is replaced by the year with century. %z is replaced by the
> > time zone as a numeric offset (e.g +0530, -0800 etc.) %Z is
> > replaced by the time zone abbreviation.
> > +%\xe6 is replaced by the month as a lowercase Roman number (i-xii)
> > +%\xc6 is replaced by the month as an uppercase Roman number (I-XII)
>
> Does this actually work correctly? I worry a little about this
> inaccuracy (what the user sees in non-Mule with a font other than ISO
> 8859-1 is not going to work on Mule or default non-Mule).
It doesn’t work, there need to be two backslashes for every one that is to
appear in the output, and the documentation infrastructure doesn’t interpret
single backslashes in the same way the Lisp reader does. I’ve committed a
change to reflect that; thanks for your comments!
--
“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://calypso.tux.org/mailman/listinfo/xemacs-patches
Re: [COMMIT] Be better about key sequence syntax, po-mode.el
14 years, 3 months
Aidan Kehoe
Ar an cúigiú lá de mí Méan Fómhair, scríobh Mats Lidell:
> >>>>> Stephen J Turnbull <stephen(a)xemacs.org> writes:
>
> Stephen> You need to understand the LISP reader.
>
> Yes I understand that. And all of this can be found in the info pages
> for lispref? So I ought to do some RTFM then!
If you find something unclear in the Lispref, check the Common Lisp
documentation, especially Common Lisp The Language, but also the Hyperspec.
They’re both online, and carefully written, and a surprising amount of
what’s in there equally applies to XEmacs.
--
“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://calypso.tux.org/mailman/listinfo/xemacs-patches
[COMMIT] Add a couple of extra docstring backslashes, #'format-time-string
14 years, 3 months
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1283710957 -3600
# Node ID 1ed4cefddd122c1707463d21accc4b5c10bd6a90
# Parent 30bf66dd3ca0d987bf2ad8a05ea8843bf92d437d
Add a couple of extra docstring backslashes, #'format-time-string
2010-09-05 Aidan Kehoe <kehoea(a)parhasard.net>
* editfns.c (Fformat_time_string):
Use two backslashes so that there is at least one present in the
output of describe function, when describing the Roman month
number syntax in this function's docstring. Thanks for provoking
me to look at this, Stephen Turnbull.
diff -r 30bf66dd3ca0 -r 1ed4cefddd12 src/ChangeLog
--- a/src/ChangeLog Fri Sep 03 17:14:10 2010 +0100
+++ b/src/ChangeLog Sun Sep 05 19:22:37 2010 +0100
@@ -1,3 +1,11 @@
+2010-09-05 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * editfns.c (Fformat_time_string):
+ Use two backslashes so that there is at least one present in the
+ output of describe function, when describing the Roman month
+ number syntax in this function's docstring. Thanks for provoking
+ me to look at this, Stephen Turnbull.
+
2010-09-03 Aidan Kehoe <kehoea(a)parhasard.net>
* symsinit.h: Declare reinit_process_early() here, fixing the C++
diff -r 30bf66dd3ca0 -r 1ed4cefddd12 src/editfns.c
--- a/src/editfns.c Fri Sep 03 17:14:10 2010 +0100
+++ b/src/editfns.c Sun Sep 05 19:22:37 2010 +0100
@@ -1044,8 +1044,8 @@
%Y is replaced by the year with century.
%z is replaced by the time zone as a numeric offset (e.g +0530, -0800 etc.)
%Z is replaced by the time zone abbreviation.
-%\xe6 is replaced by the month as a lowercase Roman number (i-xii)
-%\xc6 is replaced by the month as an uppercase Roman number (I-XII)
+%\\xe6 is replaced by the month as a lowercase Roman number (i-xii)
+%\\xc6 is replaced by the month as an uppercase Roman number (I-XII)
The number of options reflects the `strftime' function.
*/
--
“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://calypso.tux.org/mailman/listinfo/xemacs-patches
commit: Add a couple of extra docstring backslashes, #'format-time-string
14 years, 3 months
Aidan Kehoe
changeset: 5258:1ed4cefddd12
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sun Sep 05 19:22:37 2010 +0100
files: src/ChangeLog src/editfns.c
description:
Add a couple of extra docstring backslashes, #'format-time-string
2010-09-05 Aidan Kehoe <kehoea(a)parhasard.net>
* editfns.c (Fformat_time_string):
Use two backslashes so that there is at least one present in the
output of describe function, when describing the Roman month
number syntax in this function's docstring. Thanks for provoking
me to look at this, Stephen Turnbull.
diff -r 30bf66dd3ca0 -r 1ed4cefddd12 src/ChangeLog
--- a/src/ChangeLog Fri Sep 03 17:14:10 2010 +0100
+++ b/src/ChangeLog Sun Sep 05 19:22:37 2010 +0100
@@ -1,3 +1,11 @@
+2010-09-05 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * editfns.c (Fformat_time_string):
+ Use two backslashes so that there is at least one present in the
+ output of describe function, when describing the Roman month
+ number syntax in this function's docstring. Thanks for provoking
+ me to look at this, Stephen Turnbull.
+
2010-09-03 Aidan Kehoe <kehoea(a)parhasard.net>
* symsinit.h: Declare reinit_process_early() here, fixing the C++
diff -r 30bf66dd3ca0 -r 1ed4cefddd12 src/editfns.c
--- a/src/editfns.c Fri Sep 03 17:14:10 2010 +0100
+++ b/src/editfns.c Sun Sep 05 19:22:37 2010 +0100
@@ -1044,8 +1044,8 @@
%Y is replaced by the year with century.
%z is replaced by the time zone as a numeric offset (e.g +0530, -0800 etc.)
%Z is replaced by the time zone abbreviation.
-%\xe6 is replaced by the month as a lowercase Roman number (i-xii)
-%\xc6 is replaced by the month as an uppercase Roman number (I-XII)
+%\\xe6 is replaced by the month as a lowercase Roman number (i-xii)
+%\\xc6 is replaced by the month as an uppercase Roman number (I-XII)
The number of options reflects the `strftime' function.
*/
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/mailman/listinfo/xemacs-patches
[COMMIT] Correct an error in my #'edmacro-parse-word syntax, thank you Smoketest
14 years, 3 months
Aidan Kehoe
I’ve checked that the current version of edmacro-parse-word doesn’t error on
basically every occurrence of (kbd "string") in the package source tree, so
we shouldn’t see any more build breaks from this change.
APPROVE COMMIT
NOTE: This patch has been committed.
xemacs-packages/xemacs-base/ChangeLog addition:
2010-09-03 Aidan Kehoe <kehoea(a)parhasard.net>
* edmacro.el (edmacro-parse-word):
Only #'read if WORD actually matched the regexp avoiding errors
when WORD is not valid Lisp syntax. Logic error on my part, caught
by the smoketest; thank you Mats Lidell!
XEmacs Packages source patch:
Diff command: cvs -q diff -Nu
Files affected: xemacs-packages/xemacs-base/edmacro.el
Index: xemacs-packages/xemacs-base/edmacro.el
===================================================================
RCS file: /cvsroot/xemacs/XEmacs/packages/xemacs-packages/xemacs-base/edmacro.el,v
retrieving revision 1.5
diff -u -r1.5 edmacro.el
--- xemacs-packages/xemacs-base/edmacro.el 2 Sep 2010 20:21:38 -0000 1.5
+++ xemacs-packages/xemacs-base/edmacro.el 3 Sep 2010 19:49:26 -0000
@@ -517,12 +517,13 @@
(t (intern (string arg))))))
(add
(cond
- ((prog1 nil
- (string-match "^\\\\[0-7]\\{1,3\\}$" word)
- ;; Octal value of a character. If it's numerically out of
- ;; range, allow the Lisp reader to error. If read succedds,
- ;; we handle the actual numeric value further down.
- (setq word (read (concat "\"" word "\"")))))
+ ((and (string-match "^\\\\[0-7]\\{1,3\\}$" word)
+ ;; Octal value of a character. If it's numerically out of
+ ;; range, allow the Lisp reader to error.
+ (setq word (read (concat "\"" word "\"")))
+ ;; This clause never succeeds, we want to handle the
+ ;; actual numeric value further down:
+ nil))
((string-match "^<<.+>>$" word)
;; Extended command.
(nconc
--
“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://calypso.tux.org/mailman/listinfo/xemacs-patches