/* Lisp functions pertaining to editing.
- Copyright (C) 1985, 1986, 1987, 1989 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1986, 1987, 1989, 1993 Free Software Foundation, Inc.
This file is part of GNU Emacs.
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
-#include "config.h"
+#include <sys/types.h>
+
+#include <config.h>
+
+#ifdef VMS
+#include "vms-pwd.h"
+#else
#include <pwd.h>
+#endif
+
#include "lisp.h"
+#include "intervals.h"
#include "buffer.h"
#include "window.h"
-#ifdef NEED_TIME_H
-#include <time.h>
-#else /* not NEED_TIME_H */
-#ifdef HAVE_TIMEVAL
-#include <sys/time.h>
-#endif /* HAVE_TIMEVAL */
-#endif /* not NEED_TIME_H */
+#include "systime.h"
#define min(a, b) ((a) < (b) ? (a) : (b))
#define max(a, b) ((a) > (b) ? (a) : (b))
void
init_editfns ()
{
- unsigned char *user_name;
+ char *user_name;
register unsigned char *p, *q, *r;
struct passwd *pw; /* password entry for the current user */
extern char *index ();
pw = (struct passwd *) getpwuid (getuid ());
Vuser_real_name = build_string (pw ? pw->pw_name : "unknown");
- user_name = (unsigned char *) getenv ("USER");
+ /* Get the effective user name, by consulting environment variables,
+ or the effective uid if those are unset. */
+ user_name = (char *) getenv ("USER");
if (!user_name)
- user_name = (unsigned char *) getenv ("LOGNAME");
- if (user_name)
- Vuser_name = build_string (user_name);
- else
- Vuser_name = Vuser_real_name;
+ user_name = (char *) getenv ("LOGNAME");
+ if (!user_name)
+ {
+ pw = (struct passwd *) getpwuid (geteuid ());
+ user_name = (char *) (pw ? pw->pw_name : "unknown");
+ }
+ Vuser_name = build_string (user_name);
+ /* If the user name claimed in the environment vars differs from
+ the real uid, use the claimed name to find the full name. */
tem = Fstring_equal (Vuser_name, Vuser_real_name);
- if (!NULL (tem))
- pw = (struct passwd *) getpwnam (user_name);
+ if (NILP (tem))
+ pw = (struct passwd *) getpwnam (XSTRING (Vuser_name)->data);
p = (unsigned char *) (pw ? USER_FULL_NAME : "unknown");
q = (unsigned char *) index (p, ',');
r = (char *) alloca (strlen (p) + XSTRING (Vuser_name)->size + 1);
bcopy (p, r, q - p);
r[q - p] = 0;
- strcat (r, XSTRING (user_name)->data);
+ strcat (r, XSTRING (Vuser_name)->data);
r[q - p] = UPCASE (r[q - p]);
strcat (r, q + 1);
Vuser_full_name = build_string (r);
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 (Vmark_even_if_inactive)
+ && NILP (current_buffer->mark_active))
+ Fsignal (Qmark_inactive, Qnil);
m = Fmarker_position (current_buffer->mark);
- if (NULL (m)) error ("There is no region now");
+ if (NILP (m)) error ("There is no region now");
if ((point < XFASTINT (m)) == beginningp)
return (make_number (point));
else
(pos)
Lisp_Object pos;
{
- if (NULL (pos))
+ if (NILP (pos))
{
current_buffer->mark = Qnil;
return Qnil;
}
CHECK_NUMBER_COERCE_MARKER (pos, 0);
- if (NULL (current_buffer->mark))
+ if (NILP (current_buffer->mark))
current_buffer->mark = Fmake_marker ();
Fset_marker (current_buffer->mark, pos, Qnil);
Lisp_Object
save_excursion_save ()
{
- register int visible = XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer;
+ register int visible = (XBUFFER (XWINDOW (selected_window)->buffer)
+ == current_buffer);
return Fcons (Fpoint_marker (),
- Fcons (Fcopy_marker (current_buffer->mark), visible ? Qt : Qnil));
+ Fcons (Fcopy_marker (current_buffer->mark),
+ 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 */
/* Otherwise could get error here while unwinding to top level
and crash */
/* In that case, Fmarker_buffer returns nil now. */
- if (NULL (tem))
+ if (NILP (tem))
return Qnil;
Fset_buffer (tem);
tem = Fcar (info);
Fset_marker (current_buffer->mark, tem, Fcurrent_buffer ());
unchain_marker (tem);
tem = Fcdr (Fcdr (info));
- if (!NULL (tem) && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer))
+#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"));
return Qnil;
}
"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;
{
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;
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);
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;
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);
}
-DEFUN ("following-char", Ffollchar, Sfollchar, 0, 0, 0,
- "Return the character following point, as a number.")
+DEFUN ("following-char", Ffollowing_char, Sfollowing_char, 0, 0, 0,
+ "Return the character following point, as a number.\n\
+At the end of the buffer or accessible region, return 0.")
()
{
Lisp_Object temp;
- XFASTINT (temp) = FETCH_CHAR (point);
+ if (point >= ZV)
+ XFASTINT (temp) = 0;
+ else
+ XFASTINT (temp) = FETCH_CHAR (point);
return temp;
}
-DEFUN ("preceding-char", Fprevchar, Sprevchar, 0, 0, 0,
- "Return the character preceding point, as a number.")
+DEFUN ("preceding-char", Fprevious_char, Sprevious_char, 0, 0, 0,
+ "Return the character preceding point, as a number.\n\
+At the beginning of the buffer or accessible region, return 0.")
()
{
Lisp_Object temp;
return Vsystem_name;
}
-DEFUN ("current-time-string", Fcurrent_time_string, Scurrent_time_string, 0, 0, 0,
+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\
+most significant 16 bits of the seconds, while the second has the\n\
+least significant 16 bits. The third integer gives the microsecond\n\
+count.\n\
+\n\
+The microsecond count is zero on systems that do not provide\n\
+resolution finer than a second.")
+ ()
+{
+ EMACS_TIME t;
+ Lisp_Object result[3];
+
+ EMACS_GET_TIME (t);
+ XSET (result[0], Lisp_Int, (EMACS_SECS (t) >> 16) & 0xffff);
+ XSET (result[1], Lisp_Int, (EMACS_SECS (t) >> 0) & 0xffff);
+ XSET (result[2], Lisp_Int, EMACS_USECS (t));
+
+ return Flist (3, result);
+}
+\f
+
+static int
+lisp_time_argument (specified_time, result)
+ Lisp_Object specified_time;
+ time_t *result;
+{
+ if (NILP (specified_time))
+ return time (result) != -1;
+ 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);
+ *result = (XINT (high) << 16) + (XINT (low) & 0xffff);
+ return *result >> 16 == XINT (high);
+ }
+}
+
+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,\n\
-if we can figure out a reasonably easy way to get that information.")
- ()
+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);
+ time_t value;
char buf[30];
- register char *tem = (char *) ctime (¤t_time);
+ register char *tem;
+
+ if (! lisp_time_argument (specified_time, &value))
+ value = -1;
+ tem = (char *) ctime (&value);
strncpy (buf, tem, 24);
buf[24] = 0;
return build_string (buf);
}
-#ifdef unix
+#define TM_YEAR_ORIGIN 1900
-DEFUN ("set-default-file-mode", Fset_default_file_mode, Sset_default_file_mode, 1, 1, "p",
- "Set Unix `umask' value to ARGUMENT, and return old value.\n\
-The `umask' value is the default protection mode for new files.")
- (nmask)
- Lisp_Object nmask;
+/* Yield A - B, measured in seconds. */
+static long
+difftm(a, b)
+ struct tm *a, *b;
{
- CHECK_NUMBER (nmask, 0);
- return make_number (umask (XINT (nmask)));
+ 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);
}
-DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "",
- "Tell Unix to finish all pending disk updates.")
- ()
+DEFUN ("current-time-zone", Fcurrent_time_zone, Scurrent_time_zone, 0, 1, 0,
+ "Return the offset and name for the local time zone.\n\
+This returns a list of the form (OFFSET NAME).\n\
+OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).\n\
+ A negative value means west of Greenwich.\n\
+NAME is a string giving the name of the time zone.\n\
+If an argument is given, it specifies when the time zone offset is determined\n\
+instead of using 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'.\n\
+\n\
+Some operating systems cannot provide all this information to Emacs;\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;
{
- sync ();
- return Qnil;
+ time_t value;
+ struct tm *t;
+
+ if (lisp_time_argument (specified_time, &value)
+ && (t = gmtime (&value)) != 0)
+ {
+ struct tm gmt;
+ long offset;
+ char *s, buf[6];
+
+ 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;
+#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. */
+ int am = (offset < 0 ? -offset : offset) / 60;
+ sprintf (buf, "%c%02d%02d", (offset < 0 ? '-' : '+'), am/60, am%60);
+ s = buf;
+ }
+ return Fcons (make_number (offset), Fcons (build_string (s), Qnil));
+ }
+ else
+ return Fmake_list (2, Qnil);
}
-#endif /* unix */
\f
void
insert1 (arg)
Finsert (1, &arg);
}
+
+/* Callers passing one argument to Finsert need not gcpro the
+ argument "array", since the only element of the array will
+ not be used after calling insert or insert_from_string, so
+ we don't care if it gets trashed. */
+
DEFUN ("insert", Finsert, Sinsert, 0, MANY, 0,
"Insert the arguments, either strings or characters, at point.\n\
Point moves forward so that it ends up after the inserted text.\n\
register int argnum;
register Lisp_Object tem;
char str[1];
- struct gcpro gcpro1;
- GCPRO1 (*args);
- gcpro1.nvars = nargs;
+ 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, 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++)
{
}
else if (XTYPE (tem) == Lisp_String)
{
- insert_from_string (tem, 0, XSTRING (tem)->size);
+ insert_from_string (tem, 0, XSTRING (tem)->size, 1);
}
else
{
}
}
- UNGCPRO;
return Qnil;
}
register int argnum;
register Lisp_Object tem;
char str[1];
- struct gcpro gcpro1;
- GCPRO1 (*args);
- gcpro1.nvars = nargs;
+ 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, 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++)
{
}
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, 1);
}
else
{
}
}
- UNGCPRO;
return Qnil;
}
\f
}
\f
-/* Return a string with the contents of the current region */
+/* Making strings from buffer contents. */
+
+/* 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 specified, 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
+ compacted. make_string has no way of knowing that the data has
+ been moved, and thus copies the wrong data into the string. This
+ 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;
+{
+ Lisp_Object result, tem;
+
+ if (start < GPT && GPT < end)
+ move_gap (start);
+
+ result = make_uninit_string (end - start);
+ bcopy (&FETCH_CHAR (start), XSTRING (result)->data, end - start);
+
+ tem = Fnext_property_change (make_number (start), Qnil, make_number (end));
+
+#ifdef USE_TEXT_PROPERTIES
+ if (XINT (tem) != end)
+ copy_intervals_to_string (result, current_buffer, start, end - start);
+#endif
+
+ return result;
+}
DEFUN ("buffer-substring", Fbuffer_substring, Sbuffer_substring, 2, 2, 0,
"Return the contents of part of the current buffer as a string.\n\
Lisp_Object b, e;
{
register int beg, end;
- Lisp_Object result;
validate_region (&b, &e);
beg = XINT (b);
end = XINT (e);
- if (beg < GPT && end > GPT)
- move_gap (beg);
-
- /* Plain old make_string calls make_uninit_string, which can cause
- the buffer arena to be compacted. make_string has no way of
- knowing that the data has been moved, and thus copies the wrong
- data into the string. This doesn't effect most of the other
- users of make_string, so it should be left as is. */
- result = make_uninit_string (end - beg);
- bcopy (&FETCH_CHAR (beg), XSTRING (result)->data, end - beg);
-
- return result;
+ return make_buffer_string (beg, end);
}
DEFUN ("buffer-string", Fbuffer_string, Sbuffer_string, 0, 0, 0,
"Return the contents of the current buffer as a string.")
()
{
- if (BEGV < GPT && ZV > GPT)
- move_gap (BEGV);
- return make_string (BEGV_ADDR, ZV - BEGV);
+ return make_buffer_string (BEGV, ZV);
}
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.")
(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 (NULL (b))
+ if (NILP (b))
beg = BUF_BEGV (bp);
else
{
CHECK_NUMBER_COERCE_MARKER (b, 0);
beg = XINT (b);
}
- if (NULL (e))
+ if (NILP (e))
end = BUF_ZV (bp);
else
{
}
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. */
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)))
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, len, current_buffer, 0);
+
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);
+}
\f
DEFUN ("subst-char-in-region", Fsubst_char_in_region,
Ssubst_char_in_region, 4, 5, 0,
Lisp_Object start, end, fromchar, tochar, noundo;
{
register int pos, stop, look;
+ int changed = 0;
validate_region (&start, &end);
CHECK_NUMBER (fromchar, 2);
stop = XINT (end);
look = XINT (fromchar);
- modify_region (pos, stop);
- if (! NULL (noundo))
+ if (! NILP (noundo))
{
if (MODIFF - 1 == current_buffer->save_modified)
current_buffer->save_modified++;
{
if (FETCH_CHAR (pos) == look)
{
- if (NULL (noundo))
+ if (! changed)
+ {
+ modify_region (current_buffer, XINT (start), stop);
+ changed = 1;
+ }
+
+ if (NILP (noundo))
record_change (pos, 1);
FETCH_CHAR (pos) = XINT (tochar);
- if (NULL (noundo))
- signal_after_change (pos, 1, 1);
}
pos++;
}
+ if (changed)
+ signal_after_change (XINT (start),
+ stop - XINT (start), stop - XINT (start));
+
return Qnil;
}
pos = XINT (start);
stop = XINT (end);
- modify_region (pos, stop);
+ modify_region (current_buffer, pos, stop);
cnt = 0;
for (; pos < stop; ++pos)
BEGV = BEG;
SET_BUF_ZV (current_buffer, Z);
clip_changed = 1;
+ /* Changing the buffer bounds invalidates any recorded current column. */
+ invalidate_current_column ();
return Qnil;
}
if (point > XFASTINT (e))
SET_PT (XFASTINT (e));
clip_changed = 1;
+ /* Changing the buffer bounds invalidates any recorded current column. */
+ invalidate_current_column ();
return Qnil;
}
%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;
-
-#ifdef MULTI_SCREEN
- extern Lisp_Object Vglobal_minibuffer_screen;
-
- if (XTYPE (Vglobal_minibuffer_screen) == Lisp_Screen)
- Fmake_screen_visible (Vglobal_minibuffer_screen);
-#endif
-
- 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,
%d means print as number in decimal (%o octal, %x hex).\n\
%c means print a number as a single character.\n\
%S means print any object as an s-expression (using prin1).\n\
-The argument used for %d, %o, %x or %c must be a number.")
+ The argument used for %d, %o, %x or %c must be a number.\n\
+Use %% to put a single % into the output.")
(nargs, args)
int nargs;
register Lisp_Object *args;
/* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */
else if (XTYPE (args[n]) == Lisp_Int && *format != 's')
{
- /* The following loop issumes the Lisp type indicates
+#ifdef LISP_FLOAT_TYPE
+ /* 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. */
if (*format == 'e' || *format == 'f' || *format == 'g')
args[n] = Ffloat (args[n]);
+#endif
total += 10;
}
+#ifdef LISP_FLOAT_TYPE
else if (XTYPE (args[n]) == Lisp_Float && *format != 's')
{
if (! (*format == 'e' || *format == 'f' || *format == 'g'))
args[n] = Ftruncate (args[n]);
total += 20;
}
+#endif
else
{
/* Anything but a string, convert to a string using princ. */
{
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. */
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;
CHECK_NUMBER (c1, 0);
CHECK_NUMBER (c2, 1);
- if (!NULL (current_buffer->case_fold_search)
- ? downcase[0xff & XFASTINT (c1)] == downcase[0xff & XFASTINT (c2)]
+ if (!NILP (current_buffer->case_fold_search)
+ ? (downcase[0xff & XFASTINT (c1)] == downcase[0xff & XFASTINT (c2)]
+ && (XFASTINT (c1) & ~0xff) == (XFASTINT (c2) & ~0xff))
: XINT (c1) == XINT (c2))
return Qt;
return Qnil;
}
-#ifndef MAINTAIN_ENVIRONMENT /* it is done in environ.c in that case */
-DEFUN ("getenv", Fgetenv, Sgetenv, 1, 2, 0,
- "Return the value of environment variable VAR, as a string.\n\
-VAR should be a string. Value is nil if VAR is undefined in the environment.")
- (str)
- Lisp_Object str;
-{
- register char *val;
- CHECK_STRING (str, 0);
- val = (char *) egetenv (XSTRING (str)->data);
- if (!val)
- return Qnil;
- return build_string (val);
-}
-#endif /* MAINTAIN_ENVIRONMENT */
\f
void
syms_of_editfns ()
{
- DEFVAR_LISP ("system-name", &Vsystem_name,
- "The name of the machine Emacs is running on.");
-
- DEFVAR_LISP ("user-full-name", &Vuser_full_name,
- "The full name of the user logged in.");
-
- DEFVAR_LISP ("user-name", &Vuser_name,
- "The user's name, based on the effective uid.");
-
- DEFVAR_LISP ("user-real-name", &Vuser_real_name,
- "The user's name, base upon the real uid.");
+ staticpro (&Vuser_name);
+ staticpro (&Vuser_full_name);
+ staticpro (&Vuser_real_name);
+ staticpro (&Vsystem_name);
defsubr (&Schar_equal);
defsubr (&Sgoto_char);
defsubr (&Seobp);
defsubr (&Sbolp);
defsubr (&Seolp);
- defsubr (&Sfollchar);
- defsubr (&Sprevchar);
+ defsubr (&Sfollowing_char);
+ defsubr (&Sprevious_char);
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);
defsubr (&Suser_uid);
defsubr (&Suser_real_uid);
defsubr (&Suser_full_name);
+ defsubr (&Scurrent_time);
defsubr (&Scurrent_time_string);
+ defsubr (&Scurrent_time_zone);
defsubr (&Ssystem_name);
- defsubr (&Sset_default_file_mode);
- defsubr (&Sunix_sync);
defsubr (&Smessage);
defsubr (&Sformat);
-#ifndef MAINTAIN_ENVIRONMENT /* in environ.c */
- defsubr (&Sgetenv);
-#endif
defsubr (&Sinsert_buffer_substring);
+ defsubr (&Scompare_buffer_substrings);
defsubr (&Ssubst_char_in_region);
defsubr (&Stranslate_region);
defsubr (&Sdelete_region);