X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/738429d120b11cc60687f1ffc3a85427397348ea..a2570ea9dff54e834b85b989aa31c4ca28c28de6:/src/editfns.c diff --git a/src/editfns.c b/src/editfns.c index 352892199e..8b0158c322 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -1,5 +1,5 @@ /* Lisp functions pertaining to editing. - Copyright (C) 1985, 1986, 1987, 1989, 1993 Free Software Foundation, Inc. + Copyright (C) 1985,86,87,89,93,94 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -20,7 +20,7 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #include -#include "config.h" +#include #ifdef VMS #include "vms-pwd.h" @@ -43,7 +43,7 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ Lisp_Object Vsystem_name; Lisp_Object Vuser_real_name; /* login name of current user ID */ Lisp_Object Vuser_full_name; /* full name of current user */ -Lisp_Object Vuser_name; /* user name from USER or LOGNAME. */ +Lisp_Object Vuser_name; /* user name from LOGNAME or USER */ void init_editfns () @@ -76,9 +76,9 @@ init_editfns () /* Get the effective user name, by consulting environment variables, or the effective uid if those are unset. */ - user_name = (char *) getenv ("USER"); + user_name = (char *) getenv ("LOGNAME"); if (!user_name) - user_name = (char *) getenv ("LOGNAME"); + user_name = (char *) getenv ("USER"); if (!user_name) { pw = (struct passwd *) getpwuid (geteuid ()); @@ -197,9 +197,11 @@ static Lisp_Object region_limit (beginningp) int beginningp; { + extern Lisp_Object Vmark_even_if_inactive; /* Defined in callint.c. */ register Lisp_Object m; - if (!NILP (Vtransient_mark_mode) && NILP (current_buffer->mark_active)) - error ("There is no region now"); + if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive) + && NILP (current_buffer->mark_active)) + Fsignal (Qmark_inactive, Qnil); m = Fmarker_position (current_buffer->mark); if (NILP (m)) error ("There is no region now"); if ((point < XFASTINT (m)) == beginningp) @@ -293,7 +295,7 @@ Lisp_Object save_excursion_restore (info) register Lisp_Object info; { - register Lisp_Object tem, tem1; + register Lisp_Object tem, tem1, omark, nmark; tem = Fmarker_buffer (Fcar (info)); /* If buffer being returned to is now deleted, avoid error */ @@ -307,20 +309,36 @@ save_excursion_restore (info) Fgoto_char (tem); unchain_marker (tem); tem = Fcar (Fcdr (info)); + omark = Fmarker_position (current_buffer->mark); Fset_marker (current_buffer->mark, tem, Fcurrent_buffer ()); + nmark = Fmarker_position (tem); unchain_marker (tem); tem = Fcdr (Fcdr (info)); +#if 0 /* We used to make the current buffer visible in the selected window + if that was true previously. That avoids some anomalies. + But it creates others, and it wasn't documented, and it is simpler + and cleaner never to alter the window/buffer connections. */ tem1 = Fcar (tem); if (!NILP (tem1) && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer)) Fswitch_to_buffer (Fcurrent_buffer (), Qnil); +#endif /* 0 */ tem1 = current_buffer->mark_active; current_buffer->mark_active = Fcdr (tem); - if (! NILP (current_buffer->mark_active)) - call1 (Vrun_hooks, intern ("activate-mark-hook")); - else if (! NILP (tem1)) - call1 (Vrun_hooks, intern ("deactivate-mark-hook")); + if (!NILP (Vrun_hooks)) + { + /* If mark is active now, and either was not active + or was at a different place, run the activate hook. */ + if (! NILP (current_buffer->mark_active)) + { + if (! EQ (omark, nmark)) + call1 (Vrun_hooks, intern ("activate-mark-hook")); + } + /* If mark has ceased to be active, run deactivate hook. */ + else if (! NILP (tem1)) + call1 (Vrun_hooks, intern ("deactivate-mark-hook")); + } return Qnil; } @@ -353,7 +371,7 @@ DEFUN ("buffer-size", Fbufsize, Sbufsize, 0, 0, 0, DEFUN ("point-min", Fpoint_min, Spoint_min, 0, 0, 0, "Return the minimum permissible value of point in the current buffer.\n\ -This is 1, unless a clipping restriction is in effect.") +This is 1, unless narrowing (a buffer restriction) is in effect.") () { Lisp_Object temp; @@ -363,7 +381,7 @@ This is 1, unless a clipping restriction is in effect.") DEFUN ("point-min-marker", Fpoint_min_marker, Spoint_min_marker, 0, 0, 0, "Return a marker to the minimum permissible value of point in this buffer.\n\ -This is the beginning, unless a clipping restriction is in effect.") +This is the beginning, unless narrowing (a buffer restriction) is in effect.") () { return buildmark (BEGV); @@ -371,8 +389,8 @@ This is the beginning, unless a clipping restriction is in effect.") DEFUN ("point-max", Fpoint_max, Spoint_max, 0, 0, 0, "Return the maximum permissible value of point in the current buffer.\n\ -This is (1+ (buffer-size)), unless a clipping restriction is in effect,\n\ -in which case it is less.") +This is (1+ (buffer-size)), unless narrowing (a buffer restriction)\n\ +is in effect, in which case it is less.") () { Lisp_Object temp; @@ -382,8 +400,8 @@ in which case it is less.") DEFUN ("point-max-marker", Fpoint_max_marker, Spoint_max_marker, 0, 0, 0, "Return a marker to the maximum permissible value of point in this buffer.\n\ -This is (1+ (buffer-size)), unless a clipping restriction is in effect,\n\ -in which case it is less.") +This is (1+ (buffer-size)), unless narrowing (a buffer restriction)\n\ +is in effect, in which case it is less.") () { return buildmark (ZV); @@ -476,7 +494,7 @@ If POS is out of range, the value is nil.") DEFUN ("user-login-name", Fuser_login_name, Suser_login_name, 0, 0, 0, "Return the name under which the user logged in, as a string.\n\ This is based on the effective uid, not the real uid.\n\ -Also, if the environment variable USER or LOGNAME is set,\n\ +Also, if the environment variable LOGNAME or USER is set,\n\ that determines the value of this function.") () { @@ -486,7 +504,8 @@ that determines the value of this function.") DEFUN ("user-real-login-name", Fuser_real_login_name, Suser_real_login_name, 0, 0, 0, "Return the name of the user's real uid, as a string.\n\ -Differs from `user-login-name' when running under `su'.") +This ignores the environment variables LOGNAME and USER, so it differs from\n\ +`user-login-name' when running under `su'.") () { return Vuser_real_name; @@ -520,6 +539,13 @@ DEFUN ("system-name", Fsystem_name, Ssystem_name, 0, 0, 0, return Vsystem_name; } +DEFUN ("emacs-pid", Femacs_pid, Semacs_pid, 0, 0, 0, + "Return the process ID of Emacs, as an integer.") + () +{ + return make_number (getpid ()); +} + DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0, "Return the current time, as the number of seconds since 12:00 AM January 1970.\n\ The time is returned as a list of three integers. The first has the\n\ @@ -597,26 +623,25 @@ and from `file-attributes'.") /* Yield A - B, measured in seconds. */ static long -difftm(a, b) +difftm (a, b) struct tm *a, *b; { int ay = a->tm_year + (TM_YEAR_ORIGIN - 1); int by = b->tm_year + (TM_YEAR_ORIGIN - 1); - return - ( - ( - ( - /* difference in day of year */ - a->tm_yday - b->tm_yday - /* + intervening leap days */ - + ((ay >> 2) - (by >> 2)) - - (ay/100 - by/100) - + ((ay/100 >> 2) - (by/100 >> 2)) - /* + difference in years * 365 */ - + (long)(ay-by) * 365 - )*24 + (a->tm_hour - b->tm_hour) - )*60 + (a->tm_min - b->tm_min) - )*60 + (a->tm_sec - b->tm_sec); + /* Some compilers can't handle this as a single return statement. */ + long days = ( + /* difference in day of year */ + a->tm_yday - b->tm_yday + /* + intervening leap days */ + + ((ay >> 2) - (by >> 2)) + - (ay/100 - by/100) + + ((ay/100 >> 2) - (by/100 >> 2)) + /* + difference in years * 365 */ + + (long)(ay-by) * 365 + ); + return (60*(60*(24*days + (a->tm_hour - b->tm_hour)) + + (a->tm_min - b->tm_min)) + + (a->tm_sec - b->tm_sec)); } DEFUN ("current-time-zone", Fcurrent_time_zone, Scurrent_time_zone, 0, 1, 0, @@ -634,7 +659,7 @@ Thus, you can use times obtained from `current-time'\n\ and from `file-attributes'.\n\ \n\ Some operating systems cannot provide all this information to Emacs;\n\ -in this case, current-time-zone will return a list containing nil for\n\ +in this case, `current-time-zone' returns a list containing nil for\n\ the data it can't find.") (specified_time) Lisp_Object specified_time; @@ -643,22 +668,29 @@ the data it can't find.") struct tm *t; if (lisp_time_argument (specified_time, &value) - && (t = gmtime(&value)) != 0) + && (t = gmtime (&value)) != 0) { - struct tm gmt = *t; /* Make a copy, in case localtime modifies *t. */ + struct tm gmt; long offset; char *s, buf[6]; - t = localtime(&value); - offset = difftm(t, &gmt); + + gmt = *t; /* Make a copy, in case localtime modifies *t. */ + t = localtime (&value); + offset = difftm (t, &gmt); s = 0; #ifdef HAVE_TM_ZONE if (t->tm_zone) - s = t->tm_zone; + s = (char *)t->tm_zone; +#else /* not HAVE_TM_ZONE */ +#ifdef HAVE_TZNAME + if (t->tm_isdst == 0 || t->tm_isdst == 1) + s = tzname[t->tm_isdst]; #endif +#endif /* not HAVE_TM_ZONE */ if (!s) { /* No local time zone name is available; use "+-NNNN" instead. */ - long am = (offset < 0 ? -offset : offset) / 60; + int am = (offset < 0 ? -offset : offset) / 60; sprintf (buf, "%c%02d%02d", (offset < 0 ? '-' : '+'), am/60, am%60); s = buf; } @@ -705,7 +737,43 @@ Any other markers at the point of insertion remain before the text.") } else if (XTYPE (tem) == Lisp_String) { - insert_from_string (tem, 0, XSTRING (tem)->size); + insert_from_string (tem, 0, XSTRING (tem)->size, 0); + } + else + { + tem = wrong_type_argument (Qchar_or_string_p, tem); + goto retry; + } + } + + return Qnil; +} + +DEFUN ("insert-and-inherit", Finsert_and_inherit, Sinsert_and_inherit, + 0, MANY, 0, + "Insert the arguments at point, inheriting properties from adjoining text.\n\ +Point moves forward so that it ends up after the inserted text.\n\ +Any other markers at the point of insertion remain before the text.") + (nargs, args) + int nargs; + register Lisp_Object *args; +{ + register int argnum; + register Lisp_Object tem; + char str[1]; + + for (argnum = 0; argnum < nargs; argnum++) + { + tem = args[argnum]; + retry: + if (XTYPE (tem) == Lisp_Int) + { + str[0] = XINT (tem); + insert (str, 1); + } + else if (XTYPE (tem) == Lisp_String) + { + insert_from_string (tem, 0, XSTRING (tem)->size, 1); } else { @@ -740,7 +808,44 @@ Any other markers at the point of insertion also end up after the text.") } else if (XTYPE (tem) == Lisp_String) { - insert_from_string_before_markers (tem, 0, XSTRING (tem)->size); + insert_from_string_before_markers (tem, 0, XSTRING (tem)->size, 0); + } + else + { + tem = wrong_type_argument (Qchar_or_string_p, tem); + goto retry; + } + } + + return Qnil; +} + +DEFUN ("insert-before-markers-and-inherit", + Finsert_and_inherit_before_markers, Sinsert_and_inherit_before_markers, + 0, MANY, 0, + "Insert text at point, relocating markers and inheriting properties.\n\ +Point moves forward so that it ends up after the inserted text.\n\ +Any other markers at the point of insertion also end up after the text.") + (nargs, args) + int nargs; + register Lisp_Object *args; +{ + register int argnum; + register Lisp_Object tem; + char str[1]; + + for (argnum = 0; argnum < nargs; argnum++) + { + tem = args[argnum]; + retry: + if (XTYPE (tem) == Lisp_Int) + { + str[0] = XINT (tem); + insert_before_markers (str, 1); + } + else if (XTYPE (tem) == Lisp_String) + { + insert_from_string_before_markers (tem, 0, XSTRING (tem)->size, 1); } else { @@ -788,7 +893,7 @@ Both arguments are required.") /* Return a Lisp_String containing the text of the current buffer from START to END. If text properties are in use and the current buffer - has properties in the range specifed, the resulting string will also + has properties in the range specified, the resulting string will also have them. We don't want to use plain old make_string here, because it calls @@ -803,7 +908,7 @@ Lisp_Object make_buffer_string (start, end) int start, end; { - Lisp_Object result; + Lisp_Object result, tem, tem1; if (start < GPT && GPT < end) move_gap (start); @@ -811,8 +916,13 @@ make_buffer_string (start, end) result = make_uninit_string (end - start); bcopy (&FETCH_CHAR (start), XSTRING (result)->data, end - start); - /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */ - copy_intervals_to_string (result, current_buffer, start, end - start); + tem = Fnext_property_change (make_number (start), Qnil, make_number (end)); + tem1 = Ftext_properties_at (make_number (start), Qnil); + +#ifdef USE_TEXT_PROPERTIES + if (XINT (tem) != end || !NILP (tem1)) + copy_intervals_to_string (result, current_buffer, start, end - start); +#endif return result; } @@ -842,7 +952,7 @@ DEFUN ("buffer-string", Fbuffer_string, Sbuffer_string, 0, 0, 0, DEFUN ("insert-buffer-substring", Finsert_buffer_substring, Sinsert_buffer_substring, 1, 3, 0, - "Insert before point a substring of the contents buffer BUFFER.\n\ + "Insert before point a substring of the contents of buffer BUFFER.\n\ BUFFER may be a buffer or a buffer name.\n\ Arguments START and END are character numbers specifying the substring.\n\ They default to the beginning and the end of BUFFER.") @@ -904,7 +1014,7 @@ They default to the beginning and the end of BUFFER.") /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */ graft_intervals_into_buffer (copy_intervals (bp->intervals, start, len), - opoint, bp); + opoint, len, current_buffer, 0); return Qnil; } @@ -1040,6 +1150,7 @@ and don't mark the buffer as really changed.") Lisp_Object start, end, fromchar, tochar, noundo; { register int pos, stop, look; + int changed = 0; validate_region (&start, &end); CHECK_NUMBER (fromchar, 2); @@ -1049,28 +1160,36 @@ and don't mark the buffer as really changed.") stop = XINT (end); look = XINT (fromchar); - modify_region (current_buffer, pos, stop); - if (! NILP (noundo)) - { - if (MODIFF - 1 == current_buffer->save_modified) - current_buffer->save_modified++; - if (MODIFF - 1 == current_buffer->auto_save_modified) - current_buffer->auto_save_modified++; - } - while (pos < stop) { if (FETCH_CHAR (pos) == look) { + if (! changed) + { + modify_region (current_buffer, XINT (start), stop); + + if (! NILP (noundo)) + { + if (MODIFF - 1 == current_buffer->save_modified) + current_buffer->save_modified++; + if (MODIFF - 1 == current_buffer->auto_save_modified) + current_buffer->auto_save_modified++; + } + + changed = 1; + } + if (NILP (noundo)) record_change (pos, 1); FETCH_CHAR (pos) = XINT (tochar); - if (NILP (noundo)) - signal_after_change (pos, 1, 1); } pos++; } + if (changed) + signal_after_change (XINT (start), + stop - XINT (start), stop - XINT (start)); + return Qnil; } @@ -1260,6 +1379,12 @@ use `save-excursion' outermost:\n\ return unbind_to (count, val); } +/* Buffer for the most recent text displayed by Fmessage. */ +static char *message_text; + +/* Allocated length of that buffer. */ +static int message_length; + DEFUN ("message", Fmessage, Smessage, 1, MANY, 0, "Print a one-line message at the bottom of the screen.\n\ The first argument is a control string.\n\ @@ -1283,7 +1408,19 @@ minibuffer contents show.") { register Lisp_Object val; val = Fformat (nargs, args); - message ("%s", XSTRING (val)->data); + /* Copy the data so that it won't move when we GC. */ + if (! message_text) + { + message_text = (char *)xmalloc (80); + message_length = 80; + } + if (XSTRING (val)->size > message_length) + { + message_length = XSTRING (val)->size; + message_text = (char *)xrealloc (message_text, message_length); + } + bcopy (XSTRING (val)->data, message_text, XSTRING (val)->size); + message2 (message_text, XSTRING (val)->size); return val; } } @@ -1335,7 +1472,7 @@ Use %% to put a single % into the output.") if (*format == '%') format++; else if (++n >= nargs) - ; + error ("not enough arguments for format string"); else if (*format == 'S') { /* For `S', prin1 the argument and then treat like a string. */ @@ -1352,13 +1489,15 @@ Use %% to put a single % into the output.") else if (XTYPE (args[n]) == Lisp_String) { string: + if (*format != 's' && *format != 'S') + error ("format specifier doesn't match argument type"); total += XSTRING (args[n])->size; } /* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */ else if (XTYPE (args[n]) == Lisp_Int && *format != 's') { #ifdef LISP_FLOAT_TYPE - /* The following loop issumes the Lisp type indicates + /* The following loop assumes the Lisp type indicates the proper way to pass the argument. So make sure we have a flonum if the argument should be a double. */ @@ -1387,29 +1526,34 @@ Use %% to put a single % into the output.") { register int nstrings = n + 1; + + /* Allocate twice as many strings as we have %-escapes; floats occupy + two slots, and we're not sure how many of those we have. */ register unsigned char **strings - = (unsigned char **) alloca (nstrings * sizeof (unsigned char *)); + = (unsigned char **) alloca (2 * nstrings * sizeof (unsigned char *)); + int i; + i = 0; for (n = 0; n < nstrings; n++) { if (n >= nargs) - strings[n] = (unsigned char *) ""; + strings[i++] = (unsigned char *) ""; else if (XTYPE (args[n]) == Lisp_Int) /* We checked above that the corresponding format effector isn't %s, which would cause MPV. */ - strings[n] = (unsigned char *) XINT (args[n]); + strings[i++] = (unsigned char *) XINT (args[n]); #ifdef LISP_FLOAT_TYPE else if (XTYPE (args[n]) == Lisp_Float) { union { double d; int half[2]; } u; u.d = XFLOAT (args[n])->data; - strings[n++] = (unsigned char *) u.half[0]; - strings[n] = (unsigned char *) u.half[1]; + strings[i++] = (unsigned char *) u.half[0]; + strings[i++] = (unsigned char *) u.half[1]; } #endif else - strings[n] = XSTRING (args[n])->data; + strings[i++] = XSTRING (args[n])->data; } /* Format it in bigger and bigger buf's until it all fits. */ @@ -1418,7 +1562,7 @@ Use %% to put a single % into the output.") buf = (char *) alloca (total + 1); buf[total - 1] = 0; - length = doprnt (buf, total + 1, strings[0], end, nargs, strings + 1); + length = doprnt (buf, total + 1, strings[0], end, i-1, strings + 1); if (buf[total - 1] == 0) break; @@ -1473,22 +1617,355 @@ Case is ignored if `case-fold-search' is non-nil in the current buffer.") return Qt; return Qnil; } - +/* Transpose the markers in two regions of the current buffer, and + adjust the ones between them if necessary (i.e.: if the regions + differ in size). + + Traverses the entire marker list of the buffer to do so, adding an + appropriate amount to some, subtracting from some, and leaving the + rest untouched. Most of this is copied from adjust_markers in insdel.c. + + It's caller's job to see that (start1 <= end1 <= start2 <= end2), + and that the buffer gap will not conflict with the markers. This + last requirement is odd and maybe should be taken out, but it works + for now because Ftranspose_regions does in fact guarantee that, in + addition to providing universal health-care coverage. */ + void -syms_of_editfns () +transpose_markers (start1, end1, start2, end2) + register int start1, end1, start2, end2; { - DEFVAR_LISP ("system-name", &Vsystem_name, - "The name of the machine Emacs is running on."); + register int amt1, amt2, diff, mpos; + register Lisp_Object marker; + register struct Lisp_Marker *m; + + /* Update point as if it were a marker. + Do this before adjusting the start/end values for the gap. */ + if (PT < start1) + ; + else if (PT < end1) + TEMP_SET_PT (PT + (end2 - end1)); + else if (PT < start2) + TEMP_SET_PT (PT + (end2 - start2) - (end1 - start1)); + else if (PT < end2) + TEMP_SET_PT (PT - (start2 - start1)); + + /* Internally, marker positions take the gap into account, so if the + * gap is before one or both of the regions, the region's limits + * must be adjusted to compensate. The caller guaranteed that the + * gap is not inside any of the regions, however, so this is fairly + * simple. + */ + if (GPT < start1) + { + register int gs = GAP_SIZE; + start1 += gs; end1 += gs; + start2 += gs; end2 += gs; + } + else if (GPT < start2) + { + /* If the regions are of equal size, the gap could, in theory, + * be somewhere between them. */ + register int gs = GAP_SIZE; + start2 += gs; end2 += gs; + } + + /* The difference between the region's lengths */ + diff = (end2 - start2) - (end1 - start1); - DEFVAR_LISP ("user-full-name", &Vuser_full_name, - "The full name of the user logged in."); + /* For shifting each marker in a region by the length of the other + * region plus the distance between the regions. + */ + amt1 = (end2 - start2) + (start2 - end1); + amt2 = (end1 - start1) + (start2 - end1); - DEFVAR_LISP ("user-name", &Vuser_name, - "The user's name, based on the effective uid."); + marker = current_buffer->markers; - DEFVAR_LISP ("user-real-name", &Vuser_real_name, - "The user's name, base upon the real uid."); + while (!NILP (marker)) + { + m = XMARKER (marker); + mpos = m->bufpos; + if (mpos >= start1 && mpos < end1) /* in region 1 */ + { + m->bufpos += amt1; + } + else if (mpos >= start2 && mpos < end2) /* in region 2 */ + { + m->bufpos -= amt2; + } + else if (mpos >= end1 && mpos < start2) /* between the regions */ + { + m->bufpos += diff; + } + marker = m->chain; + } +} + +DEFUN ("transpose-regions", Ftranspose_regions, Stranspose_regions, 4, 5, 0, + "Transpose region START1 to END1 with START2 to END2.\n\ +The regions may not be overlapping, because the size of the buffer is\n\ +never changed in a transposition.\n\ +\n\ +Optional fifth arg LEAVE_MARKERS, if non-nil, means don't transpose\n\ +any markers that happen to be located in the regions.\n\ +\n\ +Transposing beyond buffer boundaries is an error.") + (startr1, endr1, startr2, endr2, leave_markers) + Lisp_Object startr1, endr1, startr2, endr2, leave_markers; +{ + register int start1, end1, start2, end2, + gap, len1, len_mid, len2; + unsigned char *start1_addr, *start2_addr, *temp; + +#ifdef USE_TEXT_PROPERTIES + INTERVAL cur_intv, tmp_interval1, tmp_interval_mid, tmp_interval2; + cur_intv = current_buffer->intervals; +#endif /* USE_TEXT_PROPERTIES */ + + validate_region (&startr1, &endr1); + validate_region (&startr2, &endr2); + + start1 = XFASTINT (startr1); + end1 = XFASTINT (endr1); + start2 = XFASTINT (startr2); + end2 = XFASTINT (endr2); + gap = GPT; + + /* Swap the regions if they're reversed. */ + if (start2 < end1) + { + register int glumph = start1; + start1 = start2; + start2 = glumph; + glumph = end1; + end1 = end2; + end2 = glumph; + } + + len1 = end1 - start1; + len2 = end2 - start2; + + if (start2 < end1) + error ("transposed regions not properly ordered"); + else if (start1 == end1 || start2 == end2) + error ("transposed region may not be of length 0"); + + /* The possibilities are: + 1. Adjacent (contiguous) regions, or separate but equal regions + (no, really equal, in this case!), or + 2. Separate regions of unequal size. + + The worst case is usually No. 2. It means that (aside from + potential need for getting the gap out of the way), there also + needs to be a shifting of the text between the two regions. So + if they are spread far apart, we are that much slower... sigh. */ + + /* It must be pointed out that the really studly thing to do would + be not to move the gap at all, but to leave it in place and work + around it if necessary. This would be extremely efficient, + especially considering that people are likely to do + transpositions near where they are working interactively, which + is exactly where the gap would be found. However, such code + would be much harder to write and to read. So, if you are + reading this comment and are feeling squirrely, by all means have + a go! I just didn't feel like doing it, so I will simply move + the gap the minimum distance to get it out of the way, and then + deal with an unbroken array. */ + + /* Make sure the gap won't interfere, by moving it out of the text + we will operate on. */ + if (start1 < gap && gap < end2) + { + if (gap - start1 < end2 - gap) + move_gap (start1); + else + move_gap (end2); + } + + start1_addr = BUF_CHAR_ADDRESS (current_buffer, start1); + start2_addr = BUF_CHAR_ADDRESS (current_buffer, start2); + + /* Hmmm... how about checking to see if the gap is large + enough to use as the temporary storage? That would avoid an + allocation... interesting. Later, don't fool with it now. */ + + /* Working without memmove, for portability (sigh), so must be + careful of overlapping subsections of the array... */ + + if (end1 == start2) /* adjacent regions */ + { + modify_region (current_buffer, start1, end2); + record_change (start1, len1 + len2); + +#ifdef USE_TEXT_PROPERTIES + tmp_interval1 = copy_intervals (cur_intv, start1, len1); + tmp_interval2 = copy_intervals (cur_intv, start2, len2); + Fset_text_properties (start1, end2, Qnil, Qnil); +#endif /* USE_TEXT_PROPERTIES */ + + /* First region smaller than second. */ + if (len1 < len2) + { + /* We use alloca only if it is small, + because we want to avoid stack overflow. */ + if (len2 > 20000) + temp = (unsigned char *) xmalloc (len2); + else + temp = (unsigned char *) alloca (len2); + bcopy (start2_addr, temp, len2); + bcopy (start1_addr, start1_addr + len2, len1); + bcopy (temp, start1_addr, len2); + if (len2 > 20000) + free (temp); + } + else + /* First region not smaller than second. */ + { + if (len1 > 20000) + temp = (unsigned char *) xmalloc (len1); + else + temp = (unsigned char *) alloca (len1); + bcopy (start1_addr, temp, len1); + bcopy (start2_addr, start1_addr, len2); + bcopy (temp, start1_addr + len2, len1); + if (len1 > 20000) + free (temp); + } +#ifdef USE_TEXT_PROPERTIES + graft_intervals_into_buffer (tmp_interval1, start1 + len2, + len1, current_buffer, 0); + graft_intervals_into_buffer (tmp_interval2, start1, + len2, current_buffer, 0); +#endif /* USE_TEXT_PROPERTIES */ + } + /* Non-adjacent regions, because end1 != start2, bleagh... */ + else + { + if (len1 == len2) + /* Regions are same size, though, how nice. */ + { + modify_region (current_buffer, start1, end1); + modify_region (current_buffer, start2, end2); + record_change (start1, len1); + record_change (start2, len2); +#ifdef USE_TEXT_PROPERTIES + tmp_interval1 = copy_intervals (cur_intv, start1, len1); + tmp_interval2 = copy_intervals (cur_intv, start2, len2); + Fset_text_properties (start1, end1, Qnil, Qnil); + Fset_text_properties (start2, end2, Qnil, Qnil); +#endif /* USE_TEXT_PROPERTIES */ + + if (len1 > 20000) + temp = (unsigned char *) xmalloc (len1); + else + temp = (unsigned char *) alloca (len1); + bcopy (start1_addr, temp, len1); + bcopy (start2_addr, start1_addr, len2); + bcopy (temp, start2_addr, len1); + if (len1 > 20000) + free (temp); +#ifdef USE_TEXT_PROPERTIES + graft_intervals_into_buffer (tmp_interval1, start2, + len1, current_buffer, 0); + graft_intervals_into_buffer (tmp_interval2, start1, + len2, current_buffer, 0); +#endif /* USE_TEXT_PROPERTIES */ + } + + else if (len1 < len2) /* Second region larger than first */ + /* Non-adjacent & unequal size, area between must also be shifted. */ + { + len_mid = start2 - end1; + modify_region (current_buffer, start1, end2); + record_change (start1, (end2 - start1)); +#ifdef USE_TEXT_PROPERTIES + tmp_interval1 = copy_intervals (cur_intv, start1, len1); + tmp_interval_mid = copy_intervals (cur_intv, end1, len_mid); + tmp_interval2 = copy_intervals (cur_intv, start2, len2); + Fset_text_properties (start1, end2, Qnil, Qnil); +#endif /* USE_TEXT_PROPERTIES */ + + /* holds region 2 */ + if (len2 > 20000) + temp = (unsigned char *) xmalloc (len2); + else + temp = (unsigned char *) alloca (len2); + bcopy (start2_addr, temp, len2); + bcopy (start1_addr, start1_addr + len_mid + len2, len1); + safe_bcopy (start1_addr + len1, start1_addr + len2, len_mid); + bcopy (temp, start1_addr, len2); + if (len2 > 20000) + free (temp); +#ifdef USE_TEXT_PROPERTIES + graft_intervals_into_buffer (tmp_interval1, end2 - len1, + len1, current_buffer, 0); + graft_intervals_into_buffer (tmp_interval_mid, start1 + len2, + len_mid, current_buffer, 0); + graft_intervals_into_buffer (tmp_interval2, start1, + len2, current_buffer, 0); +#endif /* USE_TEXT_PROPERTIES */ + } + else + /* Second region smaller than first. */ + { + len_mid = start2 - end1; + record_change (start1, (end2 - start1)); + modify_region (current_buffer, start1, end2); + +#ifdef USE_TEXT_PROPERTIES + tmp_interval1 = copy_intervals (cur_intv, start1, len1); + tmp_interval_mid = copy_intervals (cur_intv, end1, len_mid); + tmp_interval2 = copy_intervals (cur_intv, start2, len2); + Fset_text_properties (start1, end2, Qnil, Qnil); +#endif /* USE_TEXT_PROPERTIES */ + + /* holds region 1 */ + if (len1 > 20000) + temp = (unsigned char *) xmalloc (len1); + else + temp = (unsigned char *) alloca (len1); + bcopy (start1_addr, temp, len1); + bcopy (start2_addr, start1_addr, len2); + bcopy (start1_addr + len1, start1_addr + len2, len_mid); + bcopy (temp, start1_addr + len2 + len_mid, len1); + if (len1 > 20000) + free (temp); +#ifdef USE_TEXT_PROPERTIES + graft_intervals_into_buffer (tmp_interval1, end2 - len1, + len1, current_buffer, 0); + graft_intervals_into_buffer (tmp_interval_mid, start1 + len2, + len_mid, current_buffer, 0); + graft_intervals_into_buffer (tmp_interval2, start1, + len2, current_buffer, 0); +#endif /* USE_TEXT_PROPERTIES */ + } + } + + /* todo: this will be slow, because for every transposition, we + traverse the whole friggin marker list. Possible solutions: + somehow get a list of *all* the markers across multiple + transpositions and do it all in one swell phoop. Or maybe modify + Emacs' marker code to keep an ordered list or tree. This might + be nicer, and more beneficial in the long run, but would be a + bunch of work. Plus the way they're arranged now is nice. */ + if (NILP (leave_markers)) + { + transpose_markers (start1, end1, start2, end2); + fix_overlays_in_range (start1, end2); + } + + return Qnil; +} + + +void +syms_of_editfns () +{ + staticpro (&Vuser_name); + staticpro (&Vuser_full_name); + staticpro (&Vuser_real_name); + staticpro (&Vsystem_name); defsubr (&Schar_equal); defsubr (&Sgoto_char); @@ -1521,6 +1998,8 @@ syms_of_editfns () defsubr (&Schar_after); defsubr (&Sinsert); defsubr (&Sinsert_before_markers); + defsubr (&Sinsert_and_inherit); + defsubr (&Sinsert_and_inherit_before_markers); defsubr (&Sinsert_char); defsubr (&Suser_login_name); @@ -1528,6 +2007,7 @@ syms_of_editfns () defsubr (&Suser_uid); defsubr (&Suser_real_uid); defsubr (&Suser_full_name); + defsubr (&Semacs_pid); defsubr (&Scurrent_time); defsubr (&Scurrent_time_string); defsubr (&Scurrent_time_zone); @@ -1543,4 +2023,5 @@ syms_of_editfns () defsubr (&Swiden); defsubr (&Snarrow_to_region); defsubr (&Ssave_restriction); + defsubr (&Stranspose_regions); }