X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/fa056b08ee30e3716413c7baf80df0b42cec95c3..4ed925c6687e25373e8d75e68b9072f1170d571a:/src/editfns.c diff --git a/src/editfns.c b/src/editfns.c index e67e56d2ef..4578af6973 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -1,7 +1,7 @@ /* Lisp functions pertaining to editing. Copyright (C) 1985, 1986, 1987, 1989, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, - 2005 Free Software Foundation, Inc. + 2005, 2006 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -37,6 +37,8 @@ Boston, MA 02110-1301, USA. */ #include #endif +#include "lisp.h" + /* systime.h includes which, on some systems, is required for ; thus systime.h must be included before */ @@ -48,10 +50,9 @@ Boston, MA 02110-1301, USA. */ #include -#include "lisp.h" #include "intervals.h" #include "buffer.h" -#include "charset.h" +#include "character.h" #include "coding.h" #include "frame.h" #include "window.h" @@ -71,7 +72,15 @@ Boston, MA 02110-1301, USA. */ extern char **environ; #endif -extern Lisp_Object make_time P_ ((time_t)); +#define TM_YEAR_BASE 1900 + +/* Nonzero if TM_YEAR is a struct tm's tm_year value that causes + asctime to have well-defined behavior. */ +#ifndef TM_YEAR_IN_ASCTIME_RANGE +# define TM_YEAR_IN_ASCTIME_RANGE(tm_year) \ + (1000 - TM_YEAR_BASE <= (tm_year) && (tm_year) <= 9999 - TM_YEAR_BASE) +#endif + extern size_t emacs_strftimeu P_ ((char *, size_t, const char *, const struct tm *, int)); static int tm_diff P_ ((struct tm *, struct tm *)); @@ -197,9 +206,7 @@ usage: (char-to-string CHAR) */) CHECK_NUMBER (character); - len = (SINGLE_BYTE_CHAR_P (XFASTINT (character)) - ? (*str = (unsigned char)(XFASTINT (character)), 1) - : char_to_string (XFASTINT (character), str)); + len = CHAR_STRING (XFASTINT (character), str); return make_string_from_bytes (str, 1, len); } @@ -482,7 +489,7 @@ get_pos_property (position, prop, object) } /* Find the field surrounding POS in *BEG and *END. If POS is nil, - the value of point is used instead. If BEG or END null, + the value of point is used instead. If BEG or END is null, means don't store the beginning or end of the field. BEG_LIMIT and END_LIMIT serve to limit the ranged of the returned @@ -526,7 +533,9 @@ find_field (pos, merge_at_boundary, beg_limit, beg, end_limit, end) = (XFASTINT (pos) > BEGV ? get_char_property_and_overlay (make_number (XINT (pos) - 1), Qfield, Qnil, NULL) - : Qnil); + /* Using nil here would be a more obvious choice, but it would + fail when the buffer starts with a non-sticky field. */ + : after_field); /* See if we need to handle the case where MERGE_AT_BOUNDARY is nil and POS is at beginning of a field, which can also be interpreted @@ -717,6 +726,8 @@ Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil. */) { /* If non-zero, then the original point, before re-positioning. */ int orig_point = 0; + int fwd; + Lisp_Object prev_old, prev_new; if (NILP (new_pos)) /* Use the current point, and afterwards, set it. */ @@ -725,23 +736,40 @@ Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil. */) XSETFASTINT (new_pos, PT); } + CHECK_NUMBER_COERCE_MARKER (new_pos); + CHECK_NUMBER_COERCE_MARKER (old_pos); + + fwd = (XFASTINT (new_pos) > XFASTINT (old_pos)); + + prev_old = make_number (XFASTINT (old_pos) - 1); + prev_new = make_number (XFASTINT (new_pos) - 1); + if (NILP (Vinhibit_field_text_motion) && !EQ (new_pos, old_pos) && (!NILP (Fget_char_property (new_pos, Qfield, Qnil)) - || !NILP (Fget_char_property (old_pos, Qfield, Qnil))) + || !NILP (Fget_char_property (old_pos, Qfield, Qnil)) + /* To recognize field boundaries, we must also look at the + previous positions; we could use `get_pos_property' + instead, but in itself that would fail inside non-sticky + fields (like comint prompts). */ + || (XFASTINT (new_pos) > BEGV + && !NILP (Fget_char_property (prev_new, Qfield, Qnil))) + || (XFASTINT (old_pos) > BEGV + && !NILP (Fget_char_property (prev_old, Qfield, Qnil)))) && (NILP (inhibit_capture_property) - || NILP (Fget_char_property(old_pos, inhibit_capture_property, Qnil)))) - /* NEW_POS is not within the same field as OLD_POS; try to - move NEW_POS so that it is. */ + /* Field boundaries are again a problem; but now we must + decide the case exactly, so we need to call + `get_pos_property' as well. */ + || (NILP (get_pos_property (old_pos, inhibit_capture_property, Qnil)) + && (XFASTINT (old_pos) <= BEGV + || NILP (Fget_char_property (old_pos, inhibit_capture_property, Qnil)) + || NILP (Fget_char_property (prev_old, inhibit_capture_property, Qnil)))))) + /* It is possible that NEW_POS is not within the same field as + OLD_POS; try to move NEW_POS so that it is. */ { - int fwd, shortage; + int shortage; Lisp_Object field_bound; - CHECK_NUMBER_COERCE_MARKER (new_pos); - CHECK_NUMBER_COERCE_MARKER (old_pos); - - fwd = (XFASTINT (new_pos) > XFASTINT (old_pos)); - if (fwd) field_bound = Ffield_end (old_pos, escape_from_edge, new_pos); else @@ -782,9 +810,10 @@ DEFUN ("line-beginning-position", With argument N not nil or 1, move forward N - 1 lines first. If scan reaches end of buffer, return that position. -The scan does not cross a field boundary unless doing so would move -beyond there to a different line; if N is nil or 1, and scan starts at a -field boundary, the scan stops as soon as it starts. To ignore field +This function constrains the returned position to the current field +unless that would be on a different line than the original, +unconstrained result. If N is nil or 1, and a front-sticky field +starts at point, the scan stops as soon as it starts. To ignore field boundaries bind `inhibit-field-text-motion' to t. This function does not move point. */) @@ -792,6 +821,8 @@ This function does not move point. */) Lisp_Object n; { int orig, orig_byte, end; + int count = SPECPDL_INDEX (); + specbind (Qinhibit_point_motion_hooks, Qt); if (NILP (n)) XSETFASTINT (n, 1); @@ -805,6 +836,8 @@ This function does not move point. */) SET_PT_BOTH (orig, orig_byte); + unbind_to (count, Qnil); + /* Return END constrained to the current input field. */ return Fconstrain_to_field (make_number (end), make_number (orig), XINT (n) != 1 ? Qt : Qnil, @@ -816,9 +849,10 @@ DEFUN ("line-end-position", Fline_end_position, Sline_end_position, 0, 1, 0, With argument N not nil or 1, move forward N - 1 lines first. If scan reaches end of buffer, return that position. -The scan does not cross a field boundary unless doing so would move -beyond there to a different line; if N is nil or 1, and scan starts at a -field boundary, the scan stops as soon as it starts. To ignore field +This function constrains the returned position to the current field +unless that would be on a different line than the original, +unconstrained result. If N is nil or 1, and a rear-sticky field ends +at point, the scan stops as soon as it starts. To ignore field boundaries bind `inhibit-field-text-motion' to t. This function does not move point. */) @@ -1699,7 +1733,9 @@ DOW and ZONE.) */) XSETFASTINT (list_args[2], decoded_time->tm_hour); XSETFASTINT (list_args[3], decoded_time->tm_mday); XSETFASTINT (list_args[4], decoded_time->tm_mon + 1); - XSETINT (list_args[5], decoded_time->tm_year + 1900); + /* On 64-bit machines an int is narrower than EMACS_INT, thus the + cast below avoids overflow in int arithmetics. */ + XSETINT (list_args[5], TM_YEAR_BASE + (EMACS_INT) decoded_time->tm_year); XSETFASTINT (list_args[6], decoded_time->tm_wday); list_args[7] = (decoded_time->tm_isdst)? Qt : Qnil; @@ -1755,7 +1791,7 @@ usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */) tm.tm_hour = XINT (args[2]); tm.tm_mday = XINT (args[3]); tm.tm_mon = XINT (args[4]) - 1; - tm.tm_year = XINT (args[5]) - 1900; + tm.tm_year = XINT (args[5]) - TM_YEAR_BASE; tm.tm_isdst = -1; if (CONSP (zone)) @@ -1806,7 +1842,8 @@ usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */) DEFUN ("current-time-string", Fcurrent_time_string, Scurrent_time_string, 0, 1, 0, doc: /* Return the current time, as a human-readable string. Programs can use this function to decode a time, -since the number of columns in each field is fixed. +since the number of columns in each field is fixed +if the year is in the range 1000-9999. The format is `Sun Sep 16 01:03:52 1973'. However, see also the functions `decode-time' and `format-time-string' which provide a much more powerful and general facility. @@ -1820,20 +1857,24 @@ but this is considered obsolete. */) Lisp_Object specified_time; { time_t value; - char buf[30]; + struct tm *tm; register char *tem; if (! lisp_time_argument (specified_time, &value, NULL)) - value = -1; - tem = (char *) ctime (&value); + error ("Invalid time specification"); - strncpy (buf, tem, 24); - buf[24] = 0; + /* Convert to a string, checking for out-of-range time stamps. + Don't use 'ctime', as that might dump core if VALUE is out of + range. */ + tm = localtime (&value); + if (! (tm && TM_YEAR_IN_ASCTIME_RANGE (tm->tm_year) && (tem = asctime (tm)))) + error ("Specified time is not representable"); - return build_string (buf); -} + /* Remove the trailing newline. */ + tem[strlen (tem) - 1] = '\0'; -#define TM_YEAR_BASE 1900 + return build_string (tem); +} /* Yield A - B, measured in seconds. This function is copied from the GNU C Library. */ @@ -2081,7 +2122,7 @@ general_insert_function (insert_func, insert_from_string_func, len = CHAR_STRING (XFASTINT (val), str); else { - str[0] = (SINGLE_BYTE_CHAR_P (XINT (val)) + str[0] = (ASCII_CHAR_P (XINT (val)) ? XINT (val) : multibyte_char_to_unibyte (XINT (val), Qnil)); len = 1; @@ -2252,6 +2293,29 @@ from adjoining text, if those properties are sticky. */) return Qnil; } +DEFUN ("insert-byte", Finsert_byte, Sinsert_byte, 2, 3, 0, + doc: /* Insert COUNT (second arg) copies of BYTE (first arg). +Both arguments are required. +BYTE is a number of the range 0..255. + +If BYTE is 128..255 and the current buffer is multibyte, the +corresponding eight-bit character is inserted. + +Point, and before-insertion markers, are relocated as in the function `insert'. +The optional third arg INHERIT, if non-nil, says to inherit text properties +from adjoining text, if those properties are sticky. */) + (byte, count, inherit) + Lisp_Object byte, count, inherit; +{ + CHECK_NUMBER (byte); + if (XINT (byte) < 0 || XINT (byte) > 255) + args_out_of_range_3 (byte, make_number (0), make_number (255)); + if (XINT (byte) >= 128 + && ! NILP (current_buffer->enable_multibyte_characters)) + XSETFASTINT (byte, BYTE8_TO_CHAR (XINT (byte))); + return Finsert_char (byte, count, inherit); +} + /* Making strings from buffer contents. */ @@ -2472,9 +2536,9 @@ determines whether case is significant or ignored. */) { register int begp1, endp1, begp2, endp2, temp; register struct buffer *bp1, *bp2; - register Lisp_Object *trt + register Lisp_Object trt = (!NILP (current_buffer->case_fold_search) - ? XCHAR_TABLE (current_buffer->case_canon_table)->contents : 0); + ? current_buffer->case_canon_table : Qnil); int chars = 0; int i1, i2, i1_byte, i2_byte; @@ -2593,10 +2657,10 @@ determines whether case is significant or ignored. */) i2++; } - if (trt) + if (!NILP (trt)) { - c1 = XINT (trt[c1]); - c2 = XINT (trt[c2]); + c1 = CHAR_TABLE_TRANSLATE (trt, c1); + c2 = CHAR_TABLE_TRANSLATE (trt, c2); } if (c1 < c2) return make_number (- 1 - chars); @@ -2799,12 +2863,73 @@ Both characters must have the same length of multi-byte form. */) return Qnil; } + +static Lisp_Object check_translation P_ ((int, int, int, Lisp_Object)); + +/* Helper function for Ftranslate_region_internal. + + Check if a character sequence at POS (POS_BYTE) matches an element + of VAL. VAL is a list (([FROM-CHAR ...] . TO) ...). If a matching + element is found, return it. Otherwise return Qnil. */ + +static Lisp_Object +check_translation (pos, pos_byte, end, val) + int pos, pos_byte, end; + Lisp_Object val; +{ + int buf_size = 16, buf_used = 0; + int *buf = alloca (sizeof (int) * buf_size); + + for (; CONSP (val); val = XCDR (val)) + { + Lisp_Object elt; + int len, i; + + elt = XCAR (val); + if (! CONSP (elt)) + continue; + elt = XCAR (elt); + if (! VECTORP (elt)) + continue; + len = ASIZE (elt); + if (len <= end - pos) + { + for (i = 0; i < len; i++) + { + if (buf_used <= i) + { + unsigned char *p = BYTE_POS_ADDR (pos_byte); + int len; + + if (buf_used == buf_size) + { + int *newbuf; + + buf_size += 16; + newbuf = alloca (sizeof (int) * buf_size); + memcpy (newbuf, buf, sizeof (int) * buf_used); + buf = newbuf; + } + buf[buf_used++] = STRING_CHAR_AND_LENGTH (p, 0, len); + pos_byte += len; + } + if (XINT (AREF (elt, i)) != buf[i]) + break; + } + if (i == len) + return XCAR (val); + } + } + return Qnil; +} + + DEFUN ("translate-region-internal", Ftranslate_region_internal, Stranslate_region_internal, 3, 3, 0, doc: /* Internal use only. From START to END, translate characters according to TABLE. -TABLE is a string; the Nth character in it is the mapping -for the character with code N. +TABLE is a string or a char-table; the Nth character in it is the +mapping for the character with code N. It returns the number of characters changed. */) (start, end, table) Lisp_Object start; @@ -2818,10 +2943,13 @@ It returns the number of characters changed. */) int pos, pos_byte, end_pos; int multibyte = !NILP (current_buffer->enable_multibyte_characters); int string_multibyte; + Lisp_Object val; validate_region (&start, &end); if (CHAR_TABLE_P (table)) { + if (! EQ (XCHAR_TABLE (table)->purpose, Qtranslation_table)) + error ("Not a translation table"); size = MAX_CHAR; tt = NULL; } @@ -2832,14 +2960,14 @@ It returns the number of characters changed. */) if (! multibyte && (SCHARS (table) < SBYTES (table))) table = string_make_unibyte (table); string_multibyte = SCHARS (table) < SBYTES (table); - size = SCHARS (table); + size = SBYTES (table); tt = SDATA (table); } pos = XINT (start); pos_byte = CHAR_TO_BYTE (pos); end_pos = XINT (end); - modify_region (current_buffer, pos, XINT (end)); + modify_region (current_buffer, pos, end_pos); cnt = 0; for (; pos < end_pos; ) @@ -2848,6 +2976,7 @@ It returns the number of characters changed. */) unsigned char *str, buf[MAX_MULTIBYTE_LENGTH]; int len, str_len; int oc; + Lisp_Object val; if (multibyte) oc = STRING_CHAR_AND_LENGTH (p, MAX_MULTIBYTE_LENGTH, len); @@ -2862,7 +2991,7 @@ It returns the number of characters changed. */) if (string_multibyte) { str = tt + string_char_to_byte (table, oc); - nc = STRING_CHAR_AND_LENGTH (str, MAX_MULTIBYTE_LENGTH, + nc = STRING_CHAR_AND_LENGTH (str, MAX_MULTIBYTE_LENGTH, str_len); } else @@ -2870,7 +2999,7 @@ It returns the number of characters changed. */) nc = tt[oc]; if (! ASCII_BYTE_P (nc) && multibyte) { - str_len = CHAR_STRING (nc, buf); + str_len = BYTE8_STRING (nc, buf); str = buf; } else @@ -2882,28 +3011,34 @@ It returns the number of characters changed. */) } else { - Lisp_Object val; int c; nc = oc; val = CHAR_TABLE_REF (table, oc); - if (INTEGERP (val) + if (CHARACTERP (val) && (c = XINT (val), CHAR_VALID_P (c, 0))) { nc = c; str_len = CHAR_STRING (nc, buf); str = buf; } + else if (VECTORP (val) || (CONSP (val))) + { + /* VAL is [TO_CHAR ...] or (([FROM-CHAR ...] . TO) ...) + where TO is TO-CHAR or [TO-CHAR ...]. */ + nc = -1; + } } - if (nc != oc) + if (nc != oc && nc >= 0) { + /* Simple one char to one char translation. */ if (len != str_len) { Lisp_Object string; /* This is less efficient, because it moves the gap, - but it should multibyte characters correctly. */ + but it should handle multibyte characters correctly. */ string = make_multibyte_string (str, 1, str_len); replace_range (pos, pos + 1, string, 1, 0, 1); len = str_len; @@ -2918,6 +3053,46 @@ It returns the number of characters changed. */) } ++cnt; } + else if (nc < 0) + { + Lisp_Object string; + + if (CONSP (val)) + { + val = check_translation (pos, pos_byte, end_pos, val); + if (NILP (val)) + { + pos_byte += len; + pos++; + continue; + } + /* VAL is ([FROM-CHAR ...] . TO). */ + len = ASIZE (XCAR (val)); + val = XCDR (val); + } + else + len = 1; + + if (VECTORP (val)) + { + int i; + + string = Fmake_string (make_number (ASIZE (val)), + AREF (val, 0)); + for (i = 1; i < ASIZE (val); i++) + Faset (string, make_number (i), AREF (val, i)); + } + else + { + string = Fmake_string (make_number (1), val); + } + replace_range (pos, pos + len, string, 1, 0, 1); + pos_byte += SBYTES (string); + pos += SCHARS (string); + cnt += SCHARS (string); + end_pos += SCHARS (string) - len; + continue; + } } pos_byte += len; pos++; @@ -3124,7 +3299,7 @@ If the first argument is nil or the empty string, the function clears any existing message; this lets the minibuffer contents show. See also `current-message'. -usage: (message STRING &rest ARGS) */) +usage: (message FORMAT-STRING &rest ARGS) */) (nargs, args) int nargs; Lisp_Object *args; @@ -3154,7 +3329,7 @@ to be formatted under control of the string. See `format' for details. If the first argument is nil or the empty string, clear any existing message; let the minibuffer contents show. -usage: (message-box STRING &rest ARGS) */) +usage: (message-box FORMAT-STRING &rest ARGS) */) (nargs, args) int nargs; Lisp_Object *args; @@ -3216,7 +3391,7 @@ to be formatted under control of the string. See `format' for details. If the first argument is nil or the empty string, clear any existing message; let the minibuffer contents show. -usage: (message-or-box STRING &rest ARGS) */) +usage: (message-or-box FORMAT-STRING &rest ARGS) */) (nargs, args) int nargs; Lisp_Object *args; @@ -3281,8 +3456,8 @@ usage: (propertize STRING &rest PROPERTIES) */) : SBYTES (STRING)) DEFUN ("format", Fformat, Sformat, 1, MANY, 0, - doc: /* Format a string out of a control-string and arguments. -The first argument is a control string. + doc: /* Format a string out of a format-string and arguments. +The first argument is a format control string. The other arguments are substituted into it to make the result, a string. It may contain %-sequences meaning to substitute the next argument. %s means print a string argument. Actually, prints any object, with `princ'. @@ -3424,7 +3599,9 @@ usage: (format STRING &rest OBJECTS) */) digits to print after the '.' for floats, or the max. number of chars to print from a string. */ - while (index ("-0# ", *format)) + while (format != end + && (*format == '-' || *format == '0' || *format == '#' + || * format == ' ')) ++format; if (*format >= '0' && *format <= '9') @@ -3507,8 +3684,8 @@ usage: (format STRING &rest OBJECTS) */) thissize = 30; if (*format == 'c') { - if (! SINGLE_BYTE_CHAR_P (XINT (args[n])) - /* Note: No one can remember why we have to treat + if (! ASCII_CHAR_P (XINT (args[n])) + /* Note: No one can remeber why we have to treat the character 0 as a multibyte character here. But, until it causes a real problem, let's don't change it. */ @@ -3660,7 +3837,7 @@ usage: (format STRING &rest OBJECTS) */) ++nchars; } - start = nchars; + info[n].start = start = nchars; nchars += nchars_string; end = nchars; @@ -3675,6 +3852,8 @@ usage: (format STRING &rest OBJECTS) */) nbytes, STRING_MULTIBYTE (args[n]), multibyte); + info[n].end = nchars; + if (negative) while (padding-- > 0) { @@ -3711,9 +3890,9 @@ usage: (format STRING &rest OBJECTS) */) else p += this_nchars; nchars += this_nchars; + info[n].end = nchars; } - info[n].end = nchars; } else if (STRING_MULTIBYTE (args[0])) { @@ -3892,8 +4071,20 @@ Case is ignored if `case-fold-search' is non-nil in the current buffer. */) /* Do these in separate statements, then compare the variables. because of the way DOWNCASE uses temp variables. */ - i1 = DOWNCASE (XFASTINT (c1)); - i2 = DOWNCASE (XFASTINT (c2)); + i1 = XFASTINT (c1); + if (NILP (current_buffer->enable_multibyte_characters) + && ! ASCII_CHAR_P (i1)) + { + MAKE_CHAR_MULTIBYTE (i1); + } + i2 = XFASTINT (c2); + if (NILP (current_buffer->enable_multibyte_characters) + && ! ASCII_CHAR_P (i2)) + { + MAKE_CHAR_MULTIBYTE (i2); + } + i1 = DOWNCASE (i1); + i2 = DOWNCASE (i2); return (i1 == i2 ? Qt : Qnil); } @@ -4373,6 +4564,7 @@ functions if all the text being accessed has this property. */); defsubr (&Sinsert_and_inherit); defsubr (&Sinsert_and_inherit_before_markers); defsubr (&Sinsert_char); + defsubr (&Sinsert_byte); defsubr (&Suser_login_name); defsubr (&Suser_real_login_name);