changeset 305:75f54c84f733

Initial revision

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/editfns.c	Sat Jun 29 22:03:10 1991 +0000
@@ -0,0 +1,1265 @@
+/* Lisp functions pertaining to editing.
+   Copyright (C) 1985, 1986, 1987, 1989 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 1, or (at your option)
+any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+
+#include "config.h"
+#include <pwd.h>
+#include "lisp.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 */
+
+#define min(a, b) ((a) < (b) ? (a) : (b))
+#define max(a, b) ((a) > (b) ? (a) : (b))
+
+/* Some static data, and a function to initialize it for each run */
+
+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.  */
+
+void
+init_editfns ()
+{
+  unsigned char *user_name;
+  register unsigned char *p, *q, *r;
+  struct passwd *pw;	/* password entry for the current user */
+  extern char *index ();
+  Lisp_Object tem;
+
+  /* Set up system_name even when dumping.  */
+
+  Vsystem_name = build_string (get_system_name ());
+  p = XSTRING (Vsystem_name)->data;
+  while (*p)
+    {
+      if (*p == ' ' || *p == '\t')
+	*p = '-';
+      p++;
+    }
+
+#ifndef CANNOT_DUMP
+  /* Don't bother with this on initial start when just dumping out */
+  if (!initialized)
+    return;
+#endif /* not CANNOT_DUMP */
+
+  pw = (struct passwd *) getpwuid (getuid ());
+  Vuser_real_name = build_string (pw ? pw->pw_name : "unknown");
+
+  user_name = (unsigned 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;
+
+  tem = Fstring_equal (Vuser_name, Vuser_real_name);
+  if (!NULL (tem))
+    pw = (struct passwd *) getpwnam (user_name);
+  
+  p = (unsigned char *) (pw ? USER_FULL_NAME : "unknown");
+  q = (unsigned char *) index (p, ',');
+  Vuser_full_name = make_string (p, q ? q - p : strlen (p));
+  
+#ifdef AMPERSAND_FULL_NAME
+  p = XSTRING (Vuser_full_name)->data;
+  q = (char *) index (p, '&');
+  /* Substitute the login name for the &, upcasing the first character.  */
+  if (q)
+    {
+      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);
+      r[q - p] = UPCASE (r[q - p]);
+      strcat (r, q + 1);
+      Vuser_full_name = build_string (r);
+    }
+#endif /* AMPERSAND_FULL_NAME */
+}
+
+DEFUN ("char-to-string", Fchar_to_string, Schar_to_string, 1, 1, 0,
+  "Convert arg CHAR to a one-character string containing that character.")
+  (n)
+     Lisp_Object n;
+{
+  char c;
+  CHECK_NUMBER (n, 0);
+
+  c = XINT (n);
+  return make_string (&c, 1);
+}
+
+DEFUN ("string-to-char", Fstring_to_char, Sstring_to_char, 1, 1, 0,
+  "Convert arg STRING to a character, the first character of that string.")
+  (str)
+     register Lisp_Object str;
+{
+  register Lisp_Object val;
+  register struct Lisp_String *p;
+  CHECK_STRING (str, 0);
+
+  p = XSTRING (str);
+  if (p->size)
+    XFASTINT (val) = ((unsigned char *) p->data)[0];
+  else
+    XFASTINT (val) = 0;
+  return val;
+}
+
+static Lisp_Object
+buildmark (val)
+     int val;
+{
+  register Lisp_Object mark;
+  mark = Fmake_marker ();
+  Fset_marker (mark, make_number (val), Qnil);
+  return mark;
+}
+
+DEFUN ("point", Fpoint, Spoint, 0, 0, 0,
+  "Return value of point, as an integer.\n\
+Beginning of buffer is position (point-min)")
+  ()
+{
+  Lisp_Object temp;
+  XFASTINT (temp) = point;
+  return temp;
+}
+
+DEFUN ("point-marker", Fpoint_marker, Spoint_marker, 0, 0, 0,
+   "Return value of point, as a marker object.")
+  ()
+{
+  return buildmark (point);
+}
+
+int
+clip_to_bounds (lower, num, upper)
+     int lower, num, upper;
+{
+  if (num < lower)
+    return lower;
+  else if (num > upper)
+    return upper;
+  else
+    return num;
+}
+
+DEFUN ("goto-char", Fgoto_char, Sgoto_char, 1, 1, "NGoto char: ",
+  "Set point to POSITION, a number or marker.\n\
+Beginning of buffer is position (point-min), end is (point-max).")
+  (n)
+     register Lisp_Object n;
+{
+  CHECK_NUMBER_COERCE_MARKER (n, 0);
+
+  SET_PT (clip_to_bounds (BEGV, XINT (n), ZV));
+  return n;
+}
+
+static Lisp_Object
+region_limit (beginningp)
+     int beginningp;
+{
+  register Lisp_Object m;
+  m = Fmarker_position (current_buffer->mark);
+  if (NULL (m)) error ("There is no region now");
+  if ((point < XFASTINT (m)) == beginningp)
+    return (make_number (point));
+  else
+    return (m);
+}
+
+DEFUN ("region-beginning", Fregion_beginning, Sregion_beginning, 0, 0, 0,
+  "Return position of beginning of region, as an integer.")
+  ()
+{
+  return (region_limit (1));
+}
+
+DEFUN ("region-end", Fregion_end, Sregion_end, 0, 0, 0,
+  "Return position of end of region, as an integer.")
+  ()
+{
+  return (region_limit (0));
+}
+
+#if 0 /* now in lisp code */
+DEFUN ("mark", Fmark, Smark, 0, 0, 0,
+  "Return this buffer's mark value as integer, or nil if no mark.\n\
+If you are using this in an editing command, you are most likely making\n\
+a mistake; see the documentation of `set-mark'.")
+  ()
+{
+  return Fmarker_position (current_buffer->mark);
+}
+#endif /* commented out code */
+
+DEFUN ("mark-marker", Fmark_marker, Smark_marker, 0, 0, 0,
+  "Return this buffer's mark, as a marker object.\n\
+Watch out!  Moving this marker changes the mark position.\n\
+If you set the marker not to point anywhere, the buffer will have no mark.")
+  ()
+{
+  return current_buffer->mark;
+}
+
+#if 0 /* this is now in lisp code */
+DEFUN ("set-mark", Fset_mark, Sset_mark, 1, 1, 0,
+  "Set this buffer's mark to POS.  Don't use this function!\n\
+That is to say, don't use this function unless you want\n\
+the user to see that the mark has moved, and you want the previous\n\
+mark position to be lost.\n\
+\n\
+Normally, when a new mark is set, the old one should go on the stack.\n\
+This is why most applications should use push-mark, not set-mark.\n\
+\n\
+Novice programmers often try to use the mark for the wrong purposes.\n\
+The mark saves a location for the user's convenience.\n\
+Most editing commands should not alter the mark.\n\
+To remember a location for internal use in the Lisp program,\n\
+store it in a Lisp variable.  Example:\n\
+\n\
+   (let ((beg (point))) (forward-line 1) (delete-region beg (point))).")
+  (pos)
+     Lisp_Object pos;
+{
+  if (NULL (pos))
+    {
+      current_buffer->mark = Qnil;
+      return Qnil;
+    }
+  CHECK_NUMBER_COERCE_MARKER (pos, 0);
+
+  if (NULL (current_buffer->mark))
+    current_buffer->mark = Fmake_marker ();
+
+  Fset_marker (current_buffer->mark, pos, Qnil);
+  return pos;
+}
+#endif /* commented-out code */
+
+Lisp_Object
+save_excursion_save ()
+{
+  register int visible = XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer;
+
+  return Fcons (Fpoint_marker (),
+		Fcons (Fcopy_marker (current_buffer->mark), visible ? Qt : Qnil));
+}
+
+Lisp_Object
+save_excursion_restore (info)
+     register Lisp_Object info;
+{
+  register Lisp_Object tem;
+
+  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))
+    return Qnil;
+  Fset_buffer (tem);
+  tem = Fcar (info);
+  Fgoto_char (tem);
+  unchain_marker (tem);
+  tem = Fcar (Fcdr (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))
+    Fswitch_to_buffer (Fcurrent_buffer (), Qnil);
+  return Qnil;
+}
+
+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).")
+  (args)
+     Lisp_Object args;
+{
+  register Lisp_Object val;
+  int count = specpdl_ptr - specpdl;
+
+  record_unwind_protect (save_excursion_restore, save_excursion_save ());
+			 
+  val = Fprogn (args);
+  return unbind_to (count, val);
+}
+
+DEFUN ("buffer-size", Fbufsize, Sbufsize, 0, 0, 0,
+  "Return the number of characters in the current buffer.")
+  ()
+{
+  Lisp_Object temp;
+  XFASTINT (temp) = Z - BEG;
+  return temp;
+}
+
+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.")
+  ()
+{
+  Lisp_Object temp;
+  XFASTINT (temp) = BEGV;
+  return 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.")
+  ()
+{
+  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.")
+  ()
+{
+  Lisp_Object temp;
+  XFASTINT (temp) = ZV;
+  return 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.")
+  ()
+{
+  return buildmark (ZV);
+}
+
+DEFUN ("following-char", Ffollchar, Sfollchar, 0, 0, 0,
+  "Return the character following point, as a number.")
+  ()
+{
+  Lisp_Object temp;
+  XFASTINT (temp) = FETCH_CHAR (point);
+  return temp;
+}
+
+DEFUN ("preceding-char", Fprevchar, Sprevchar, 0, 0, 0,
+  "Return the character preceding point, as a number.")
+  ()
+{
+  Lisp_Object temp;
+  if (point <= BEGV)
+    XFASTINT (temp) = 0;
+  else
+    XFASTINT (temp) = FETCH_CHAR (point - 1);
+  return temp;
+}
+
+DEFUN ("bobp", Fbobp, Sbobp, 0, 0, 0,
+  "Return T if point is at the beginning of the buffer.\n\
+If the buffer is narrowed, this means the beginning of the narrowed part.")
+  ()
+{
+  if (point == BEGV)
+    return Qt;
+  return Qnil;
+}
+
+DEFUN ("eobp", Feobp, Seobp, 0, 0, 0,
+  "Return T if point is at the end of the buffer.\n\
+If the buffer is narrowed, this means the end of the narrowed part.")
+  ()
+{
+  if (point == ZV)
+    return Qt;
+  return Qnil;
+}
+
+DEFUN ("bolp", Fbolp, Sbolp, 0, 0, 0,
+  "Return T if point is at the beginning of a line.")
+  ()
+{
+  if (point == BEGV || FETCH_CHAR (point - 1) == '\n')
+    return Qt;
+  return Qnil;
+}
+
+DEFUN ("eolp", Feolp, Seolp, 0, 0, 0,
+  "Return T if point is at the end of a line.\n\
+`End of a line' includes point being at the end of the buffer.")
+  ()
+{
+  if (point == ZV || FETCH_CHAR (point) == '\n')
+    return Qt;
+  return Qnil;
+}
+
+DEFUN ("char-after", Fchar_after, Schar_after, 1, 1, 0,
+  "Return character in current buffer at position POS.\n\
+POS is an integer or a buffer pointer.\n\
+If POS is out of range, the value is nil.")
+  (pos)
+     Lisp_Object pos;
+{
+  register Lisp_Object val;
+  register int n;
+
+  CHECK_NUMBER_COERCE_MARKER (pos, 0);
+
+  n = XINT (pos);
+  if (n < BEGV || n >= ZV) return Qnil;
+
+  XFASTINT (val) = FETCH_CHAR (n);
+  return val;
+}
+
+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\
+that determines the value of this function.")
+  ()
+{
+  return Vuser_name;
+}
+
+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'.")
+  ()
+{
+  return Vuser_real_name;
+}
+
+DEFUN ("user-uid", Fuser_uid, Suser_uid, 0, 0, 0,
+  "Return the effective uid of Emacs, as an integer.")
+  ()
+{
+  return make_number (geteuid ());
+}
+
+DEFUN ("user-real-uid", Fuser_real_uid, Suser_real_uid, 0, 0, 0,
+  "Return the real uid of Emacs, as an integer.")
+  ()
+{
+  return make_number (getuid ());
+}
+
+DEFUN ("user-full-name", Fuser_full_name, Suser_full_name, 0, 0, 0,
+  "Return the full name of the user logged in, as a string.")
+  ()
+{
+  return Vuser_full_name;
+}
+
+DEFUN ("system-name", Fsystem_name, Ssystem_name, 0, 0, 0,
+  "Return the name of the machine you are running on, as a string.")
+  ()
+{
+  return Vsystem_name;
+}
+
+DEFUN ("current-time-string", Fcurrent_time_string, Scurrent_time_string, 0, 0, 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\
+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.")
+  ()
+{
+  long current_time = time ((long *) 0);
+  char buf[30];
+  register char *tem = (char *) ctime (&current_time);
+
+  strncpy (buf, tem, 24);
+  buf[24] = 0;
+
+  return build_string (buf);
+}
+
+#ifdef unix
+
+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;
+{
+  CHECK_NUMBER (nmask, 0);
+  return make_number (umask (XINT (nmask)));
+}
+
+DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "",
+  "Tell Unix to finish all pending disk updates.")
+  ()
+{
+  sync ();
+  return Qnil;
+}
+
+#endif /* unix */
+
+void
+insert1 (arg)
+     Lisp_Object arg;
+{
+  Finsert (1, &arg);
+}
+
+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\
+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];
+  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);
+	}
+      else
+	{
+	  tem = wrong_type_argument (Qchar_or_string_p, tem);
+	  goto retry;
+	}
+    }
+
+  UNGCPRO;
+  return Qnil;
+}
+
+DEFUN ("insert-before-markers", Finsert_before_markers, Sinsert_before_markers, 0, MANY, 0,
+  "Insert strings or characters at point, relocating markers after the text.\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];
+  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);
+	}
+      else
+	{
+	  tem = wrong_type_argument (Qchar_or_string_p, tem);
+	  goto retry;
+	}
+    }
+
+  UNGCPRO;
+  return Qnil;
+}
+
+DEFUN ("insert-char", Finsert_char, Sinsert_char, 2, 2, 0,
+  "Insert COUNT (second arg) copies of CHAR (first arg).\n\
+Point and all markers are affected as in the function `insert'.\n\
+Both arguments are required.")
+  (chr, count)
+       Lisp_Object chr, count;
+{
+  register unsigned char *string;
+  register int strlen;
+  register int i, n;
+
+  CHECK_NUMBER (chr, 0);
+  CHECK_NUMBER (count, 1);
+
+  n = XINT (count);
+  if (n <= 0)
+    return Qnil;
+  strlen = min (n, 256);
+  string = (unsigned char *) alloca (strlen);
+  for (i = 0; i < strlen; i++)
+    string[i] = XFASTINT (chr);
+  while (n >= strlen)
+    {
+      insert (string, strlen);
+      n -= strlen;
+    }
+  if (n > 0)
+    insert (string, n);
+  return Qnil;
+}
+
+
+/* Return a string with the contents of the current region */
+
+DEFUN ("buffer-substring", Fbuffer_substring, Sbuffer_substring, 2, 2, 0,
+  "Return the contents of part of the current buffer as a string.\n\
+The two arguments START and END are character positions;\n\
+they can be in either order.")
+  (b, e)
+     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;
+}
+
+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);
+}
+
+DEFUN ("insert-buffer-substring", Finsert_buffer_substring, Sinsert_buffer_substring,
+  1, 3, 0,
+  "Insert before point a substring of the contents 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 struct buffer *bp;
+
+  buf = Fget_buffer (buf);
+  bp = XBUFFER (buf);
+
+  if (NULL (b))
+    beg = BUF_BEGV (bp);
+  else
+    {
+      CHECK_NUMBER_COERCE_MARKER (b, 0);
+      beg = XINT (b);
+    }
+  if (NULL (e))
+    end = BUF_ZV (bp);
+  else
+    {
+      CHECK_NUMBER_COERCE_MARKER (e, 1);
+      end = XINT (e);
+    }
+
+  if (beg > end)
+    exch = beg, beg = end, end = exch;
+
+  /* Move the gap or create enough gap in the current buffer.  */
+
+  if (point != GPT)
+    move_gap (point);
+  if (GAP_SIZE < end - beg)
+    make_gap (end - beg - GAP_SIZE);
+
+  if (!(BUF_BEGV (bp) <= beg
+	&& beg <= end
+        && end <= BUF_ZV (bp)))
+    args_out_of_range (b, e);
+
+  /* Now the actual insertion will not do any gap motion,
+     so it matters not if BUF is the current buffer.  */
+  if (beg < BUF_GPT (bp))
+    {
+      insert (BUF_CHAR_ADDRESS (bp, beg), min (end, BUF_GPT (bp)) - beg);
+      beg = min (end, BUF_GPT (bp));
+    }
+  if (beg < end)
+    insert (BUF_CHAR_ADDRESS (bp, beg), end - beg);
+
+  return Qnil;
+}
+
+DEFUN ("subst-char-in-region", Fsubst_char_in_region,
+  Ssubst_char_in_region, 4, 5, 0,
+  "From START to END, replace FROMCHAR with TOCHAR each time it occurs.\n\
+If optional arg NOUNDO is non-nil, don't record this change for undo\n\
+and don't mark the buffer as really changed.")
+  (start, end, fromchar, tochar, noundo)
+     Lisp_Object start, end, fromchar, tochar, noundo;
+{
+  register int pos, stop, look;
+
+  validate_region (&start, &end);
+  CHECK_NUMBER (fromchar, 2);
+  CHECK_NUMBER (tochar, 3);
+
+  pos = XINT (start);
+  stop = XINT (end);
+  look = XINT (fromchar);
+
+  modify_region (pos, stop);
+  if (! NULL (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 (NULL (noundo))
+	    record_change (pos, 1);
+	  FETCH_CHAR (pos) = XINT (tochar);
+	  if (NULL (noundo))
+	    signal_after_change (pos, 1, 1);
+	}
+      pos++;
+    }
+
+  return Qnil;
+}
+
+DEFUN ("translate-region", Ftranslate_region, Stranslate_region, 3, 3, 0,
+  "From START to END, translate characters according to TABLE.\n\
+TABLE is a string; the Nth character in it is the mapping\n\
+for the character with code N.  Returns the number of characters changed.")
+  (start, end, table)
+     Lisp_Object start;
+     Lisp_Object end;
+     register Lisp_Object table;
+{
+  register int pos, stop;	/* Limits of the region. */
+  register unsigned char *tt;	/* Trans table. */
+  register int oc;		/* Old character. */
+  register int nc;		/* New character. */
+  int cnt;			/* Number of changes made. */
+  Lisp_Object z;		/* Return. */
+  int size;			/* Size of translate table. */
+
+  validate_region (&start, &end);
+  CHECK_STRING (table, 2);
+
+  size = XSTRING (table)->size;
+  tt = XSTRING (table)->data;
+
+  pos = XINT (start);
+  stop = XINT (end);
+  modify_region (pos, stop);
+
+  cnt = 0;
+  for (; pos < stop; ++pos)
+    {
+      oc = FETCH_CHAR (pos);
+      if (oc < size)
+	{
+	  nc = tt[oc];
+	  if (nc != oc)
+	    {
+	      record_change (pos, 1);
+	      FETCH_CHAR (pos) = nc;
+	      signal_after_change (pos, 1, 1);
+	      ++cnt;
+	    }
+	}
+    }
+
+  XFASTINT (z) = cnt;
+  return (z);
+}
+
+DEFUN ("delete-region", Fdelete_region, Sdelete_region, 2, 2, "r",
+  "Delete the text between point and mark.\n\
+When called from a program, expects two arguments,\n\
+positions (integers or markers) specifying the stretch to be deleted.")
+  (b, e)
+     Lisp_Object b, e;
+{
+  validate_region (&b, &e);
+  del_range (XINT (b), XINT (e));
+  return Qnil;
+}
+
+DEFUN ("widen", Fwiden, Swiden, 0, 0, "",
+  "Remove restrictions (narrowing) from current buffer.\n\
+This allows the buffer's full text to be seen and edited.")
+  ()
+{
+  BEGV = BEG;
+  SET_BUF_ZV (current_buffer, Z);
+  clip_changed = 1;
+  return Qnil;
+}
+
+DEFUN ("narrow-to-region", Fnarrow_to_region, Snarrow_to_region, 2, 2, "r",
+  "Restrict editing in this buffer to the current region.\n\
+The rest of the text becomes temporarily invisible and untouchable\n\
+but is not deleted; if you save the buffer in a file, the invisible\n\
+text is included in the file.  \\[widen] makes all visible again.\n\
+See also `save-restriction'.\n\
+\n\
+When calling from a program, pass two arguments; positions (integers\n\
+or markers) bounding the text that should remain visible.")
+  (b, e)
+     register Lisp_Object b, e;
+{
+  register int i;
+
+  CHECK_NUMBER_COERCE_MARKER (b, 0);
+  CHECK_NUMBER_COERCE_MARKER (e, 1);
+
+  if (XINT (b) > XINT (e))
+    {
+      i = XFASTINT (b);
+      b = e;
+      XFASTINT (e) = i;
+    }
+
+  if (!(BEG <= XINT (b) && XINT (b) <= XINT (e) && XINT (e) <= Z))
+    args_out_of_range (b, e);
+
+  BEGV = XFASTINT (b);
+  SET_BUF_ZV (current_buffer, XFASTINT (e));
+  if (point < XFASTINT (b))
+    SET_PT (XFASTINT (b));
+  if (point > XFASTINT (e))
+    SET_PT (XFASTINT (e));
+  clip_changed = 1;
+  return Qnil;
+}
+
+Lisp_Object
+save_restriction_save ()
+{
+  register Lisp_Object bottom, top;
+  /* Note: I tried using markers here, but it does not win
+     because insertion at the end of the saved region
+     does not advance mh and is considered "outside" the saved region. */
+  XFASTINT (bottom) = BEGV - BEG;
+  XFASTINT (top) = Z - ZV;
+
+  return Fcons (Fcurrent_buffer (), Fcons (bottom, top));
+}
+
+Lisp_Object
+save_restriction_restore (data)
+     Lisp_Object data;
+{
+  register struct buffer *buf;
+  register int newhead, newtail;
+  register Lisp_Object tem;
+
+  buf = XBUFFER (XCONS (data)->car);
+
+  data = XCONS (data)->cdr;
+
+  tem = XCONS (data)->car;
+  newhead = XINT (tem);
+  tem = XCONS (data)->cdr;
+  newtail = XINT (tem);
+  if (newhead + newtail > BUF_Z (buf) - BUF_BEG (buf))
+    {
+      newhead = 0;
+      newtail = 0;
+    }
+  BUF_BEGV (buf) = BUF_BEG (buf) + newhead;
+  SET_BUF_ZV (buf, BUF_Z (buf) - newtail);
+  clip_changed = 1;
+
+  /* If point is outside the new visible range, move it inside. */
+  SET_BUF_PT (buf,
+	      clip_to_bounds (BUF_BEGV (buf), BUF_PT (buf), BUF_ZV (buf)));
+
+  return Qnil;
+}
+
+DEFUN ("save-restriction", Fsave_restriction, Ssave_restriction, 0, UNEVALLED, 0,
+  "Execute BODY, saving and restoring current buffer's restrictions.\n\
+The buffer's restrictions make parts of the beginning and end invisible.\n\
+\(They are set up with `narrow-to-region' and eliminated with `widen'.)\n\
+This special form, `save-restriction', saves the current buffer's restrictions\n\
+when it is entered, and restores them when it is exited.\n\
+So any `narrow-to-region' within BODY lasts only until the end of the form.\n\
+The old restrictions settings are restored\n\
+even in case of abnormal exit (throw or error).\n\
+\n\
+The value returned is the value of the last form in BODY.\n\
+\n\
+`save-restriction' can get confused if, within the BODY, you widen\n\
+and then make changes outside the area within the saved restrictions.\n\
+\n\
+Note: if you are using both `save-excursion' and `save-restriction',\n\
+use `save-excursion' outermost:\n\
+    (save-excursion (save-restriction ...))")
+  (body)
+     Lisp_Object body;
+{
+  register Lisp_Object val;
+  int count = specpdl_ptr - specpdl;
+
+  record_unwind_protect (save_restriction_restore, save_restriction_save ());
+  val = Fprogn (body);
+  return unbind_to (count, val);
+}
+
+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\
+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.")
+  (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;
+}
+
+DEFUN ("format", Fformat, Sformat, 1, MANY, 0,
+  "Format a string out of a control-string and arguments.\n\
+The first argument is a control string.\n\
+The other arguments are substituted into it to make the result, a string.\n\
+It may contain %-sequences meaning to substitute the next argument.\n\
+%s means print a string argument.  Actually, prints any object, with `princ'.\n\
+%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.")
+  (nargs, args)
+     int nargs;
+     register Lisp_Object *args;
+{
+  register int n;		/* The number of the next arg to substitute */
+  register int total = 5;	/* An estimate of the final length */
+  char *buf;
+  register unsigned char *format, *end;
+  int length;
+  extern char *index ();
+  /* It should not be necessary to GCPRO ARGS, because
+     the caller in the interpreter should take care of that.  */
+
+  CHECK_STRING (args[0], 0);
+  format = XSTRING (args[0])->data;
+  end = format + XSTRING (args[0])->size;
+
+  n = 0;
+  while (format != end)
+    if (*format++ == '%')
+      {
+	int minlen;
+
+	/* Process a numeric arg and skip it.  */
+	minlen = atoi (format);
+	if (minlen > 0)
+	  total += minlen;
+	else
+	  total -= minlen;
+	while ((*format >= '0' && *format <= '9')
+	       || *format == '-' || *format == ' ' || *format == '.')
+	  format++;
+
+	if (*format == '%')
+	  format++;
+	else if (++n >= nargs)
+	  ;
+	else if (*format == 'S')
+	  {
+	    /* For `S', prin1 the argument and then treat like a string.  */
+	    register Lisp_Object tem;
+	    tem = Fprin1_to_string (args[n], Qnil);
+	    args[n] = tem;
+	    goto string;
+	  }
+	else if (XTYPE (args[n]) == Lisp_Symbol)
+	  {
+	    XSET (args[n], Lisp_String, XSYMBOL (args[n])->name);
+	    goto string;
+	  }
+	else if (XTYPE (args[n]) == Lisp_String)
+	  {
+	  string:
+	    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')
+	  {
+	    /* The following loop issumes 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]);
+	    total += 10;
+	  }
+	else if (XTYPE (args[n]) == Lisp_Float && *format != 's')
+	  {
+	    if (! (*format == 'e' || *format == 'f' || *format == 'g'))
+	      args[n] = Ftruncate (args[n]);
+	    total += 20;
+	  }
+	else
+	  {
+	    /* Anything but a string, convert to a string using princ.  */
+	    register Lisp_Object tem;
+	    tem = Fprin1_to_string (args[n], Qt);
+	    args[n] = tem;
+	    goto string;
+	  }
+      }
+
+  {
+    register int nstrings = n + 1;
+    register unsigned char **strings
+      = (unsigned char **) alloca (nstrings * sizeof (unsigned char *));
+
+    for (n = 0; n < nstrings; n++)
+      {
+	if (n >= nargs)
+	  strings[n] = (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]);
+	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];
+	  }
+	else
+	  strings[n] = XSTRING (args[n])->data;
+      }
+
+    /* Format it in bigger and bigger buf's until it all fits. */
+    while (1)
+      {
+	buf = (char *) alloca (total + 1);
+	buf[total - 1] = 0;
+
+	length = doprnt (buf, total + 1, strings[0], end, nargs, strings + 1);
+	if (buf[total - 1] == 0)
+	  break;
+
+	total *= 2;
+      }
+  }
+
+  /*   UNGCPRO;  */
+  return make_string (buf, length);
+}
+
+/* VARARGS 1 */
+Lisp_Object
+#ifdef NO_ARG_ARRAY
+format1 (string1, arg0, arg1, arg2, arg3, arg4)
+     int arg0, arg1, arg2, arg3, arg4;
+#else
+format1 (string1)
+#endif
+     char *string1;
+{
+  char buf[100];
+#ifdef NO_ARG_ARRAY
+  int args[5];
+  args[0] = arg0;
+  args[1] = arg1;
+  args[2] = arg2;
+  args[3] = arg3;
+  args[4] = arg4;
+  doprnt (buf, sizeof buf, string1, 0, 5, args);
+#else
+  doprnt (buf, sizeof buf, string1, 0, 5, &string1 + 1);
+#endif
+  return build_string (buf);
+}
+
+DEFUN ("char-equal", Fchar_equal, Schar_equal, 2, 2, 0,
+  "Return t if two characters match, optionally ignoring case.\n\
+Both arguments must be characters (i.e. integers).\n\
+Case is ignored if `case-fold-search' is non-nil in the current buffer.")
+  (c1, c2)
+     register Lisp_Object c1, c2;
+{
+  unsigned char *downcase = DOWNCASE_TABLE;
+  CHECK_NUMBER (c1, 0);
+  CHECK_NUMBER (c2, 1);
+
+  if (!NULL (current_buffer->case_fold_search)
+      ? downcase[0xff & XFASTINT (c1)] == downcase[0xff & XFASTINT (c2)]
+      : 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 */
+
+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.");
+
+  defsubr (&Schar_equal);
+  defsubr (&Sgoto_char);
+  defsubr (&Sstring_to_char);
+  defsubr (&Schar_to_string);
+  defsubr (&Sbuffer_substring);
+  defsubr (&Sbuffer_string);
+
+  defsubr (&Spoint_marker);
+  defsubr (&Smark_marker);
+  defsubr (&Spoint);
+  defsubr (&Sregion_beginning);
+  defsubr (&Sregion_end);
+/*  defsubr (&Smark); */
+/*  defsubr (&Sset_mark); */
+  defsubr (&Ssave_excursion);
+
+  defsubr (&Sbufsize);
+  defsubr (&Spoint_max);
+  defsubr (&Spoint_min);
+  defsubr (&Spoint_min_marker);
+  defsubr (&Spoint_max_marker);
+
+  defsubr (&Sbobp);
+  defsubr (&Seobp);
+  defsubr (&Sbolp);
+  defsubr (&Seolp);
+  defsubr (&Sfollchar);
+  defsubr (&Sprevchar);
+  defsubr (&Schar_after);
+  defsubr (&Sinsert);
+  defsubr (&Sinsert_before_markers);
+  defsubr (&Sinsert_char);
+
+  defsubr (&Suser_login_name);
+  defsubr (&Suser_real_login_name);
+  defsubr (&Suser_uid);
+  defsubr (&Suser_real_uid);
+  defsubr (&Suser_full_name);
+  defsubr (&Scurrent_time_string);
+  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 (&Ssubst_char_in_region);
+  defsubr (&Stranslate_region);
+  defsubr (&Sdelete_region);
+  defsubr (&Swiden);
+  defsubr (&Snarrow_to_region);
+  defsubr (&Ssave_restriction);
+}