X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/aac18aa43680c793f9c8211c3f4a8d663463a918..e35ae98e41ee3c7b511aa351455683aff26fc3cd:/src/editfns.c diff --git a/src/editfns.c b/src/editfns.c index c4f8b95d81..79a88604d8 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -52,10 +52,11 @@ Boston, MA 02110-1301, USA. */ #include "intervals.h" #include "buffer.h" -#include "charset.h" +#include "character.h" #include "coding.h" #include "frame.h" #include "window.h" +#include "blockinput.h" #ifdef STDC_HEADERS #include @@ -74,6 +75,13 @@ extern char **environ; #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 *)); @@ -199,9 +207,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); } @@ -308,7 +314,7 @@ region_limit (beginningp) if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive) && NILP (current_buffer->mark_active)) - Fsignal (Qmark_inactive, Qnil); + xsignal0 (Qmark_inactive); m = Fmarker_position (current_buffer->mark); if (NILP (m)) @@ -484,7 +490,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 @@ -816,6 +822,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); @@ -829,6 +837,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, @@ -1276,7 +1286,9 @@ with that uid, or nil if there is no such user. */) return Vuser_login_name; CHECK_NUMBER (uid); + BLOCK_INPUT; pw = (struct passwd *) getpwuid (XINT (uid)); + UNBLOCK_INPUT; return (pw ? build_string (pw->pw_name) : Qnil); } @@ -1330,9 +1342,17 @@ name, or nil if there is no such user. */) if (NILP (uid)) return Vuser_full_name; else if (NUMBERP (uid)) - pw = (struct passwd *) getpwuid ((uid_t) XFLOATINT (uid)); + { + BLOCK_INPUT; + pw = (struct passwd *) getpwuid ((uid_t) XFLOATINT (uid)); + UNBLOCK_INPUT; + } else if (STRINGP (uid)) - pw = (struct passwd *) getpwnam (SDATA (uid)); + { + BLOCK_INPUT; + pw = (struct passwd *) getpwnam (SDATA (uid)); + UNBLOCK_INPUT; + } else error ("Invalid UID specification"); @@ -1368,7 +1388,7 @@ name, or nil if there is no such user. */) } DEFUN ("system-name", Fsystem_name, Ssystem_name, 0, 0, 0, - doc: /* Return the name of the machine you are running on, as a string. */) + doc: /* Return the host name of the machine you are running on, as a string. */) () { return Vsystem_name; @@ -1413,14 +1433,11 @@ resolution finer than a second. */) () { EMACS_TIME t; - Lisp_Object result[3]; EMACS_GET_TIME (t); - XSETINT (result[0], (EMACS_SECS (t) >> 16) & 0xffff); - XSETINT (result[1], (EMACS_SECS (t) >> 0) & 0xffff); - XSETINT (result[2], EMACS_USECS (t)); - - return Flist (3, result); + return list3 (make_number ((EMACS_SECS (t) >> 16) & 0xffff), + make_number ((EMACS_SECS (t) >> 0) & 0xffff), + make_number (EMACS_USECS (t))); } DEFUN ("get-internal-run-time", Fget_internal_run_time, Sget_internal_run_time, @@ -1438,12 +1455,11 @@ systems that do not provide resolution finer than a second. */) { #ifdef HAVE_GETRUSAGE struct rusage usage; - Lisp_Object result[3]; int secs, usecs; if (getrusage (RUSAGE_SELF, &usage) < 0) /* This shouldn't happen. What action is appropriate? */ - Fsignal (Qerror, Qnil); + xsignal0 (Qerror); /* Sum up user time and system time. */ secs = usage.ru_utime.tv_sec + usage.ru_stime.tv_sec; @@ -1454,11 +1470,9 @@ systems that do not provide resolution finer than a second. */) secs++; } - XSETINT (result[0], (secs >> 16) & 0xffff); - XSETINT (result[1], (secs >> 0) & 0xffff); - XSETINT (result[2], usecs); - - return Flist (3, result); + return list3 (make_number ((secs >> 16) & 0xffff), + make_number ((secs >> 0) & 0xffff), + make_number (usecs)); #else return Fcurrent_time (); #endif @@ -1678,7 +1692,7 @@ For example, to produce full ISO 8601 format, use "%Y-%m-%dT%T%z". */) SBYTES (format_string), tm, ut); if ((result > 0 && result < size) || (result == 0 && buf[0] == '\0')) - return code_convert_string_norecord (make_string (buf, result), + return code_convert_string_norecord (make_unibyte_string (buf, result), Vlocale_coding_system, 0); /* If buffer was too small, make it bigger and try again. */ @@ -1724,6 +1738,8 @@ 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); + /* 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; @@ -1831,7 +1847,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. @@ -1845,22 +1862,23 @@ 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)) error ("Invalid time specification"); + + /* 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 && -999 - TM_YEAR_BASE <= tm->tm_year - && tm->tm_year <= 9999 - TM_YEAR_BASE)) + if (! (tm && TM_YEAR_IN_ASCTIME_RANGE (tm->tm_year) && (tem = asctime (tm)))) error ("Specified time is not representable"); - tem = asctime (tm); - strncpy (buf, tem, 24); - buf[24] = 0; + /* Remove the trailing newline. */ + tem[strlen (tem) - 1] = '\0'; - return build_string (buf); + return build_string (tem); } /* Yield A - B, measured in seconds. @@ -2099,7 +2117,6 @@ general_insert_function (insert_func, insert_from_string_func, for (argnum = 0; argnum < nargs; argnum++) { val = args[argnum]; - retry: if (INTEGERP (val)) { unsigned char str[MAX_MULTIBYTE_LENGTH]; @@ -2109,7 +2126,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; @@ -2124,10 +2141,7 @@ general_insert_function (insert_func, insert_from_string_func, inherit); } else - { - val = wrong_type_argument (Qchar_or_string_p, val); - goto retry; - } + wrong_type_argument (Qchar_or_string_p, val); } } @@ -2280,6 +2294,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. */ @@ -2669,6 +2706,10 @@ Both characters must have the same length of multi-byte form. */) Lisp_Object start, end, fromchar, tochar, noundo; { register int pos, pos_byte, stop, i, len, end_byte; + /* Keep track of the first change in the buffer: + if 0 we haven't found it yet. + if < 0 we've found it and we've run the before-change-function. + if > 0 we've actually performed it and the value is its position. */ int changed = 0; unsigned char fromstr[MAX_MULTIBYTE_LENGTH], tostr[MAX_MULTIBYTE_LENGTH]; unsigned char *p; @@ -2681,6 +2722,8 @@ Both characters must have the same length of multi-byte form. */) int last_changed = 0; int multibyte_p = !NILP (current_buffer->enable_multibyte_characters); + restart: + validate_region (&start, &end); CHECK_NUMBER (fromchar); CHECK_NUMBER (tochar); @@ -2718,7 +2761,7 @@ Both characters must have the same length of multi-byte form. */) That's faster than getting rid of things, and it prevents even the entry for a first change. Also inhibit locking the file. */ - if (!NILP (noundo)) + if (!changed && !NILP (noundo)) { record_unwind_protect (subst_char_in_region_unwind, current_buffer->undo_list); @@ -2752,10 +2795,14 @@ Both characters must have the same length of multi-byte form. */) && (len == 2 || (p[2] == fromstr[2] && (len == 3 || p[3] == fromstr[3])))))) { - if (! changed) + if (changed < 0) + /* We've already seen this and run the before-change-function; + this time we only need to record the actual position. */ + changed = pos; + else if (!changed) { - changed = pos; - modify_region (current_buffer, changed, XINT (end)); + changed = -1; + modify_region (current_buffer, pos, XINT (end), 0); if (! NILP (noundo)) { @@ -2764,6 +2811,10 @@ Both characters must have the same length of multi-byte form. */) if (MODIFF - 1 == current_buffer->auto_save_modified) current_buffer->auto_save_modified++; } + + /* The before-change-function may have moved the gap + or even modified the buffer so we should start over. */ + goto restart; } /* Take care of the case where the new character @@ -2816,7 +2867,7 @@ Both characters must have the same length of multi-byte form. */) pos++; } - if (changed) + if (changed > 0) { signal_after_change (changed, last_changed - changed, last_changed - changed); @@ -2827,12 +2878,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; @@ -2846,10 +2958,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; } @@ -2860,14 +2975,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, 0); cnt = 0; for (; pos < end_pos; ) @@ -2876,6 +2991,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); @@ -2890,7 +3006,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 @@ -2898,7 +3014,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 @@ -2910,28 +3026,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; @@ -2946,6 +3068,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++; @@ -3141,13 +3303,17 @@ static char *message_text; static int message_length; DEFUN ("message", Fmessage, Smessage, 1, MANY, 0, - doc: /* Print a one-line message at the bottom of the screen. + doc: /* Display a message at the bottom of the screen. The message also goes into the `*Messages*' buffer. \(In keyboard macros, that's all it does.) +Return the message. The first argument is a format control string, and the rest are data to be formatted under control of the string. See `format' for details. +Note: Use (message "%s" VALUE) to print the value of expressions and +variables to avoid accidentally interpreting `%' as format specifiers. + 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'. @@ -3537,8 +3703,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. */ @@ -3728,7 +3894,13 @@ usage: (format STRING &rest OBJECTS) */) this_format[format - this_format_start] = 0; if (INTEGERP (args[n])) - sprintf (p, this_format, XINT (args[n])); + { + if (format[-1] == 'd') + sprintf (p, this_format, XINT (args[n])); + /* Don't sign-extend for octal or hex printing. */ + else + sprintf (p, this_format, XUINT (args[n])); + } else sprintf (p, this_format, XFLOAT_DATA (args[n])); @@ -3849,7 +4021,7 @@ usage: (format STRING &rest OBJECTS) */) /* Likewise adjust the property end position. */ pos = XINT (XCAR (XCDR (item))); - for (; bytepos < pos; bytepos++) + for (; position < pos; bytepos++) { if (! discarded[bytepos]) position++, translated++; @@ -3924,8 +4096,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); } @@ -4132,7 +4316,7 @@ Transposing beyond buffer boundaries is an error. */) if (end1 == start2) /* adjacent regions */ { - modify_region (current_buffer, start1, end2); + modify_region (current_buffer, start1, end2, 0); record_change (start1, len1 + len2); tmp_interval1 = copy_intervals (cur_intv, start1, len1); @@ -4188,8 +4372,8 @@ Transposing beyond buffer boundaries is an error. */) { USE_SAFE_ALLOCA; - modify_region (current_buffer, start1, end1); - modify_region (current_buffer, start2, end2); + modify_region (current_buffer, start1, end1, 0); + modify_region (current_buffer, start2, end2, 0); record_change (start1, len1); record_change (start2, len2); tmp_interval1 = copy_intervals (cur_intv, start1, len1); @@ -4218,7 +4402,7 @@ Transposing beyond buffer boundaries is an error. */) { USE_SAFE_ALLOCA; - modify_region (current_buffer, start1, end2); + modify_region (current_buffer, start1, end2, 0); record_change (start1, (end2 - start1)); tmp_interval1 = copy_intervals (cur_intv, start1, len1); tmp_interval_mid = copy_intervals (cur_intv, end1, len_mid); @@ -4249,7 +4433,7 @@ Transposing beyond buffer boundaries is an error. */) USE_SAFE_ALLOCA; record_change (start1, (end2 - start1)); - modify_region (current_buffer, start1, end2); + modify_region (current_buffer, start1, end2, 0); tmp_interval1 = copy_intervals (cur_intv, start1, len1); tmp_interval_mid = copy_intervals (cur_intv, end1, len_mid); @@ -4334,7 +4518,7 @@ functions if all the text being accessed has this property. */); Vbuffer_access_fontified_property = Qnil; DEFVAR_LISP ("system-name", &Vsystem_name, - doc: /* The name of the machine Emacs is running on. */); + doc: /* The host name of the machine Emacs is running on. */); DEFVAR_LISP ("user-full-name", &Vuser_full_name, doc: /* The full name of the user logged in. */); @@ -4405,6 +4589,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);