X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/0e2c9c702ce48cb20ee4afbf2796035cc7effda5..e01091534dfa6cbd4e756666cce196287d905512:/src/editfns.c diff --git a/src/editfns.c b/src/editfns.c index cf7efd5a95..86d292f297 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -1,5 +1,5 @@ /* Lisp functions pertaining to editing. - Copyright (C) 1985, 1986, 1987, 1989, 1992 Free Software Foundation, Inc. + Copyright (C) 1985, 1986, 1987, 1989, 1993 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -27,6 +27,7 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #endif #include "lisp.h" +#include "intervals.h" #include "buffer.h" #include "window.h" @@ -195,6 +196,8 @@ region_limit (beginningp) int beginningp; { register Lisp_Object m; + if (!NILP (Vtransient_mark_mode) && NILP (current_buffer->mark_active)) + error ("There is no region now"); m = Fmarker_position (current_buffer->mark); if (NILP (m)) error ("There is no region now"); if ((point < XFASTINT (m)) == beginningp) @@ -280,14 +283,15 @@ save_excursion_save () return Fcons (Fpoint_marker (), Fcons (Fcopy_marker (current_buffer->mark), - visible ? Qt : Qnil)); + Fcons (visible ? Qt : Qnil, + current_buffer->mark_active))); } Lisp_Object save_excursion_restore (info) register Lisp_Object info; { - register Lisp_Object tem; + register Lisp_Object tem, tem1; tem = Fmarker_buffer (Fcar (info)); /* If buffer being returned to is now deleted, avoid error */ @@ -304,9 +308,17 @@ save_excursion_restore (info) Fset_marker (current_buffer->mark, tem, Fcurrent_buffer ()); unchain_marker (tem); tem = Fcdr (Fcdr (info)); - if (!NILP (tem) + tem1 = Fcar (tem); + if (!NILP (tem1) && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer)) Fswitch_to_buffer (Fcurrent_buffer (), Qnil); + + 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")); return Qnil; } @@ -314,7 +326,8 @@ DEFUN ("save-excursion", Fsave_excursion, Ssave_excursion, 0, UNEVALLED, 0, "Save point, mark, and current buffer; execute BODY; restore those things.\n\ Executes BODY just like `progn'.\n\ The values of point, mark and the current buffer are restored\n\ -even in case of abnormal exit (throw or error).") +even in case of abnormal exit (throw or error).\n\ +The state of activation of the mark is also restored.") (args) Lisp_Object args; { @@ -528,16 +541,40 @@ resolution finer than a second.") } -DEFUN ("current-time-string", Fcurrent_time_string, Scurrent_time_string, 0, 0, 0, +DEFUN ("current-time-string", Fcurrent_time_string, Scurrent_time_string, 0, 1, 0, "Return the current time, as a human-readable string.\n\ -Programs can use it too, since the number of columns in each field is fixed.\n\ +Programs can use this function to decode a time,\n\ +since the number of columns in each field is fixed.\n\ The format is `Sun Sep 16 01:03:52 1973'.\n\ -In a future Emacs version, the time zone may be added at the end.") - () +If an argument is given, it specifies a time to format\n\ +instead of the current time. The argument should have the form:\n\ + (HIGH . LOW)\n\ +or the form:\n\ + (HIGH LOW . IGNORED).\n\ +Thus, you can use times obtained from `current-time'\n\ +and from `file-attributes'.") + (specified_time) + Lisp_Object specified_time; { - long current_time = time ((long *) 0); + long value; char buf[30]; - register char *tem = (char *) ctime (¤t_time); + register char *tem; + + if (NILP (specified_time)) + value = time ((long *) 0); + else + { + Lisp_Object high, low; + high = Fcar (specified_time); + CHECK_NUMBER (high, 0); + low = Fcdr (specified_time); + if (XTYPE (low) == Lisp_Cons) + low = Fcar (low); + CHECK_NUMBER (low, 0); + value = ((XINT (high) << 16) + (XINT (low) & 0xffff)); + } + + tem = (char *) ctime (&value); strncpy (buf, tem, 24); buf[24] = 0; @@ -550,7 +587,7 @@ DEFUN ("current-time-zone", Fcurrent_time_zone, Scurrent_time_zone, 0, 0, 0, This returns a list of the form (OFFSET SAVINGS-FLAG STANDARD SAVINGS).\n\ OFFSET is an integer specifying how many minutes east of Greenwich the\n\ current time zone is located. A negative value means west of\n\ - Greenwich. Note that this describes the standard time; If daylight\n\ + Greenwich. Note that this describes the standard time; if daylight\n\ savings time is in effect, it does not affect this value.\n\ SAVINGS-FLAG is non-nil iff daylight savings time or some other sort\n\ of seasonal time adjustment is in effect.\n\ @@ -559,8 +596,11 @@ STANDARD is a string giving the name of the time zone when no seasonal\n\ SAVINGS is a string giving the name of the time zone when there is a\n\ seasonal time adjustment in effect.\n\ If the local area does not use a seasonal time adjustment,\n\ -SAVINGS-FLAG will always be nil, and STANDARD and SAVINGS will be the\n\ -same.") +SAVINGS-FLAG is always nil, and STANDARD and SAVINGS are equal.\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\ +the data it can't find.") () { #ifdef EMACS_CURRENT_TIME_ZONE @@ -576,8 +616,7 @@ same.") Fcons (build_string (savings), Qnil)))); #else - error - ("current-time-zone has not been implemented on this operating system."); + return Fmake_list (4, Qnil); #endif } @@ -700,7 +739,9 @@ Both arguments are required.") /* Making strings from buffer contents. */ /* Return a Lisp_String containing the text of the current buffer from - START to END. + START to END. If text properties are in use and the current buffer + has properties in the range specifed, the resulting string will also + have them. We don't want to use plain old make_string here, because it calls make_uninit_string, which can cause the buffer arena to be @@ -709,6 +750,7 @@ Both arguments are required.") doesn't effect most of the other users of make_string, so it should be left as is. But we should use this function when conjuring buffer substrings. */ + Lisp_Object make_buffer_string (start, end) int start, end; @@ -721,6 +763,9 @@ 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); + return result; } @@ -756,11 +801,14 @@ They default to the beginning and the end of BUFFER.") (buf, b, e) Lisp_Object buf, b, e; { - register int beg, end, exch; + register int beg, end, temp, len, opoint, start; register struct buffer *bp; + Lisp_Object buffer; - buf = Fget_buffer (buf); - bp = XBUFFER (buf); + buffer = Fget_buffer (buf); + if (NILP (buffer)) + nsberror (buf); + bp = XBUFFER (buffer); if (NILP (b)) beg = BUF_BEGV (bp); @@ -778,7 +826,7 @@ They default to the beginning and the end of BUFFER.") } if (beg > end) - exch = beg, beg = end, end = exch; + temp = beg, beg = end, end = temp; /* Move the gap or create enough gap in the current buffer. */ @@ -787,6 +835,10 @@ They default to the beginning and the end of BUFFER.") if (GAP_SIZE < end - beg) make_gap (end - beg - GAP_SIZE); + len = end - beg; + start = beg; + opoint = point; + if (!(BUF_BEGV (bp) <= beg && beg <= end && end <= BUF_ZV (bp))) @@ -802,8 +854,134 @@ They default to the beginning and the end of BUFFER.") if (beg < end) insert (BUF_CHAR_ADDRESS (bp, beg), end - beg); + /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */ + graft_intervals_into_buffer (copy_intervals (bp->intervals, start, len), + opoint, bp); + return Qnil; } + +DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings, Scompare_buffer_substrings, + 6, 6, 0, + "Compare two substrings of two buffers; return result as number.\n\ +the value is -N if first string is less after N-1 chars,\n\ ++N if first string is greater after N-1 chars, or 0 if strings match.\n\ +Each substring is represented as three arguments: BUFFER, START and END.\n\ +That makes six args in all, three for each substring.\n\n\ +The value of `case-fold-search' in the current buffer\n\ +determines whether case is significant or ignored.") + (buffer1, start1, end1, buffer2, start2, end2) + Lisp_Object buffer1, start1, end1, buffer2, start2, end2; +{ + register int begp1, endp1, begp2, endp2, temp, len1, len2, length, i; + register struct buffer *bp1, *bp2; + register unsigned char *trt + = (!NILP (current_buffer->case_fold_search) + ? XSTRING (current_buffer->case_canon_table)->data : 0); + + /* Find the first buffer and its substring. */ + + if (NILP (buffer1)) + bp1 = current_buffer; + else + { + Lisp_Object buf1; + buf1 = Fget_buffer (buffer1); + if (NILP (buf1)) + nsberror (buffer1); + bp1 = XBUFFER (buf1); + } + + if (NILP (start1)) + begp1 = BUF_BEGV (bp1); + else + { + CHECK_NUMBER_COERCE_MARKER (start1, 1); + begp1 = XINT (start1); + } + if (NILP (end1)) + endp1 = BUF_ZV (bp1); + else + { + CHECK_NUMBER_COERCE_MARKER (end1, 2); + endp1 = XINT (end1); + } + + if (begp1 > endp1) + temp = begp1, begp1 = endp1, endp1 = temp; + + if (!(BUF_BEGV (bp1) <= begp1 + && begp1 <= endp1 + && endp1 <= BUF_ZV (bp1))) + args_out_of_range (start1, end1); + + /* Likewise for second substring. */ + + if (NILP (buffer2)) + bp2 = current_buffer; + else + { + Lisp_Object buf2; + buf2 = Fget_buffer (buffer2); + if (NILP (buf2)) + nsberror (buffer2); + bp2 = XBUFFER (buffer2); + } + + if (NILP (start2)) + begp2 = BUF_BEGV (bp2); + else + { + CHECK_NUMBER_COERCE_MARKER (start2, 4); + begp2 = XINT (start2); + } + if (NILP (end2)) + endp2 = BUF_ZV (bp2); + else + { + CHECK_NUMBER_COERCE_MARKER (end2, 5); + endp2 = XINT (end2); + } + + if (begp2 > endp2) + temp = begp2, begp2 = endp2, endp2 = temp; + + if (!(BUF_BEGV (bp2) <= begp2 + && begp2 <= endp2 + && endp2 <= BUF_ZV (bp2))) + args_out_of_range (start2, end2); + + len1 = endp1 - begp1; + len2 = endp2 - begp2; + length = len1; + if (len2 < length) + length = len2; + + for (i = 0; i < length; i++) + { + int c1 = *BUF_CHAR_ADDRESS (bp1, begp1 + i); + int c2 = *BUF_CHAR_ADDRESS (bp2, begp2 + i); + if (trt) + { + c1 = trt[c1]; + c2 = trt[c2]; + } + if (c1 < c2) + return make_number (- 1 - i); + if (c1 > c2) + return make_number (i + 1); + } + + /* The strings match as far as they go. + If one is shorter, that one is less. */ + if (length < len1) + return make_number (length + 1); + else if (length < len2) + return make_number (- length - 1); + + /* Same length too => they are equal. */ + return make_number (0); +} DEFUN ("subst-char-in-region", Fsubst_char_in_region, Ssubst_char_in_region, 4, 5, 0, @@ -823,7 +1001,7 @@ and don't mark the buffer as really changed.") stop = XINT (end); look = XINT (fromchar); - modify_region (pos, stop); + modify_region (current_buffer, pos, stop); if (! NILP (noundo)) { if (MODIFF - 1 == current_buffer->save_modified) @@ -873,7 +1051,7 @@ for the character with code N. Returns the number of characters changed.") pos = XINT (start); stop = XINT (end); - modify_region (pos, stop); + modify_region (current_buffer, pos, stop); cnt = 0; for (; pos < stop; ++pos) @@ -1041,16 +1219,25 @@ It may contain %s or %d or %c to print successive following arguments.\n\ %s means print an argument as a string, %d means print as number in decimal,\n\ %c means print a number as a single character.\n\ The argument used by %s must be a string or a symbol;\n\ -the argument used by %d or %c must be a number.") +the argument used by %d or %c must be a number.\n\ +If the first argument is nil, clear any existing message; let the\n\ +minibuffer contents show.") (nargs, args) int nargs; Lisp_Object *args; { - register Lisp_Object val; - - val = Fformat (nargs, args); - message ("%s", XSTRING (val)->data); - return val; + if (NILP (args[0])) + { + message (0); + return Qnil; + } + else + { + register Lisp_Object val; + val = Fformat (nargs, args); + message ("%s", XSTRING (val)->data); + return val; + } } DEFUN ("format", Fformat, Sformat, 1, MANY, 0, @@ -1232,7 +1419,8 @@ Case is ignored if `case-fold-search' is non-nil in the current buffer.") CHECK_NUMBER (c2, 1); if (!NILP (current_buffer->case_fold_search) - ? downcase[0xff & XFASTINT (c1)] == downcase[0xff & XFASTINT (c2)] + ? (downcase[0xff & XFASTINT (c1)] == downcase[0xff & XFASTINT (c2)] + && (XFASTINT (c1) & ~0xff) == (XFASTINT (c2) & ~0xff)) : XINT (c1) == XINT (c2)) return Qt; return Qnil; @@ -1300,6 +1488,7 @@ syms_of_editfns () defsubr (&Sformat); defsubr (&Sinsert_buffer_substring); + defsubr (&Scompare_buffer_substrings); defsubr (&Ssubst_char_in_region); defsubr (&Stranslate_region); defsubr (&Sdelete_region);