X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/59062dce6704f1eca7888d2f46d6e056be3da5cc..61e1d1ca4f04460699287e66a57e722328a641be:/src/editfns.c diff --git a/src/editfns.c b/src/editfns.c index 7466639012..71b518acb7 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -56,6 +56,7 @@ Boston, MA 02110-1301, USA. */ #include "coding.h" #include "frame.h" #include "window.h" +#include "blockinput.h" #ifdef STDC_HEADERS #include @@ -315,7 +316,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)) @@ -497,15 +498,18 @@ get_pos_property (position, prop, object) BEG_LIMIT and END_LIMIT serve to limit the ranged of the returned results; they do not effect boundary behavior. - If MERGE_AT_BOUNDARY is nonzero, then if POS is at the very last - position of a field, then the end of the next field is returned - instead of the end of POS's field (since the end of a field is - actually also the beginning of the next input field, this behavior - is sometimes useful). Additionally in the MERGE_AT_BOUNDARY + If MERGE_AT_BOUNDARY is nonzero, then if POS is at the very first + position of a field, then the beginning of the previous field is + returned instead of the beginning of POS's field (since the end of a + field is actually also the beginning of the next input field, this + behavior is sometimes useful). Additionally in the MERGE_AT_BOUNDARY true case, if two fields are separated by a field with the special value `boundary', and POS lies within it, then the two separated fields are considered to be adjacent, and POS between them, when - finding the beginning and ending of the "merged" field. */ + finding the beginning and ending of the "merged" field. + + Either BEG or END may be 0, in which case the corresponding value + is not stored. */ static void find_field (pos, merge_at_boundary, beg_limit, beg, end_limit, end) @@ -671,14 +675,9 @@ is before LIMIT, then LIMIT will be returned instead. */) (pos, escape_from_edge, limit) Lisp_Object pos, escape_from_edge, limit; { - int beg, end; - find_field (pos, escape_from_edge, limit, &beg, Qnil, &end); - /* When pos is at a field boundary and escape_from_edge (merge_at_boundary) - is nil, find_field returns the *previous* field. In this case we return - end instead of beg. */ - return make_number (NILP (escape_from_edge) - && XFASTINT (pos) == end - && end != ZV ? end : beg); + int beg; + find_field (pos, escape_from_edge, limit, &beg, Qnil, 0); + return make_number (beg); } DEFUN ("field-end", Ffield_end, Sfield_end, 0, 3, 0, @@ -825,6 +824,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); @@ -838,6 +839,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, @@ -1285,7 +1288,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); } @@ -1339,9 +1344,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"); @@ -1377,7 +1390,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; @@ -1422,14 +1435,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, @@ -1447,12 +1457,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; @@ -1463,11 +1472,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 @@ -1687,7 +1694,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. */ @@ -2112,7 +2119,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]; @@ -2137,10 +2143,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); } } @@ -2682,6 +2685,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; @@ -2694,6 +2701,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); @@ -2731,7 +2740,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); @@ -2765,10 +2774,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)) { @@ -2777,6 +2790,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 @@ -2829,7 +2846,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); @@ -2880,7 +2897,7 @@ It returns the number of characters changed. */) 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, XINT (end), 0); cnt = 0; for (; pos < end_pos; ) @@ -3161,6 +3178,9 @@ The message also goes into the `*Messages*' buffer. 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'. @@ -3741,7 +3761,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])); @@ -3862,7 +3888,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++; @@ -4145,7 +4171,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); @@ -4201,8 +4227,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); @@ -4231,7 +4257,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); @@ -4262,7 +4288,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); @@ -4347,7 +4373,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. */);