4.3BSD - /usr/src/new/emacs/src/editfns.c

   1: /* Lisp functions pertaining to editing.
   2:    Copyright (C) 1985 Richard M. Stallman.
   3: 
   4: This file is part of GNU Emacs.
   5: 
   6: GNU Emacs is distributed in the hope that it will be useful,
   7: but WITHOUT ANY WARRANTY.  No author or distributor
   8: accepts responsibility to anyone for the consequences of using it
   9: or for whether it serves any particular purpose or works at all,
  10: unless he says so in writing.  Refer to the GNU Emacs General Public
  11: License for full details.
  12: 
  13: Everyone is granted permission to copy, modify and redistribute
  14: GNU Emacs, but only under the conditions described in the
  15: GNU Emacs General Public License.   A copy of this license is
  16: supposed to have been given to you along with GNU Emacs so you
  17: can know your rights and responsibilities.  It should be in a
  18: file named COPYING.  Among other things, the copyright notice
  19: and this notice must be preserved on all copies.  */
  20: 
  21: 
  22: #include "config.h"
  23: #include <pwd.h>
  24: #include "lisp.h"
  25: #include "buffer.h"
  26: #include "window.h"
  27: 
  28: #define min(a, b) ((a) < (b) ? (a) : (b))
  29: #define max(a, b) ((a) > (b) ? (a) : (b))
  30: 
  31: Lisp_Object ml_apply ();
  32: 
  33: /* Some static data, and a function to initialize it for each run */
  34: 
  35: static char user_real_name[12]; /* login ID of current user */
  36: static char user_full_name[50]; /* full name of current user */
  37: 
  38: static char system_name[40];
  39: static char *user_name;
  40: 
  41: void
  42: init_editfns ()
  43: {
  44:   register char *p, *q, *r;
  45:   register int c;
  46:   int first;
  47:   struct passwd *pw;    /* password entry for the current user */
  48:   extern char *index ();
  49: 
  50:   /* Don't bother with this on initial start when just dumping out */
  51:   if (!NULL (Vpurify_flag))
  52:     return;
  53: 
  54:   pw = (struct passwd *) getpwuid (getuid ());
  55:   strncpy (user_real_name, pw->pw_name, sizeof user_real_name);
  56: 
  57:   user_name = (char *) getenv ("USER");
  58: #ifdef USG
  59:   if (!user_name)
  60:     user_name = (char *) getenv ("LOGNAME");        /* USG equivalent */
  61: #endif
  62:   if (!user_name)
  63:     user_name = user_real_name;
  64: 
  65:   if (strcmp (user_name, user_real_name))
  66:     pw = (struct passwd *) getpwnam (user_name);
  67: 
  68: #ifndef AMPERSAND_FULL_NAME
  69:   if (pw == 0)
  70:     strcpy (user_full_name, "unknown");
  71:   else
  72:     strncpy (user_full_name, USER_FULL_NAME, sizeof user_full_name);
  73:   p = index (user_full_name, ',');
  74:   if (p) *p = 0;
  75: #else
  76:   if (pw == 0)
  77:     p = "unknown";
  78:   else
  79:     p = USER_FULL_NAME;
  80:   q = user_full_name; r = user_name; first = 1;
  81: 
  82:   for (; (*p != 0) && (*p != ','); p++)
  83:     {
  84:       if (*p == '&')
  85:     {
  86:       if (*r != 0)
  87:         {
  88:           *q = *r++;
  89:           if ((*q >= 'a') && (*q <= 'z'))
  90:         *q -= 32;
  91:           for (q++; *r != 0; r++)
  92:         {
  93:           if (q == &user_full_name[sizeof user_full_name - 1])
  94:             break;
  95:           *q++ = *r;
  96:         }
  97:         }
  98:     }
  99:       else
 100:     *q++ = *p;
 101:       if (q == &user_full_name[sizeof user_full_name - 2])
 102:     break;
 103:     }
 104:   *q = 0;
 105: #endif /* AMPERSAND_FULL_NAME */
 106: 
 107:   p = (char *) get_system_name ();
 108:   if (p == 0 || *p == 0)
 109:     p = "Bogus System Name";
 110:   strncpy (system_name, p, sizeof system_name);
 111:   p = system_name;
 112:   while (*p)
 113:     {
 114:       if (*p < ' ')
 115:     *p = 0;
 116:       else
 117:     if (*p == ' ')
 118:       *p = '-';
 119:       p++;
 120:     }
 121: }
 122: 
 123: DEFUN ("char-to-string", Fchar_to_string, Schar_to_string, 1, 1, 0,
 124:   "Convert arg CHAR to a string containing that character.")
 125:   (n)
 126:      Lisp_Object n;
 127: {
 128:   char c;
 129:   CHECK_NUMBER (n, 0);
 130: 
 131:   c = XINT (n);
 132:   return make_string (&c, 1);
 133: }
 134: 
 135: DEFUN ("string-to-char", Fstring_to_char, Sstring_to_char, 1, 1, 0,
 136:   "Convert arg STRING to a character, the first character of that string.")
 137:   (str)
 138:      Lisp_Object str;
 139: {
 140:   Lisp_Object val;
 141:   CHECK_STRING (str, 0);
 142: 
 143:   if (XSTRING (str)->size)
 144:     XFASTINT (val) = ((unsigned char *) XSTRING (str)->data)[0];
 145:   else
 146:     XFASTINT (val) = 0;
 147:   return val;
 148: }
 149: 
 150: static Lisp_Object
 151: buildmark (val)
 152: {
 153:   Lisp_Object mark;
 154:   mark = Fmake_marker ();
 155:   Fset_marker (mark, make_number (val), Qnil);
 156:   return mark;
 157: }
 158: 
 159: DEFSIMPLE ("point", Fpoint, Spoint,
 160:   "Return value of point, as an integer.\n\
 161: Beginning of buffer is position (point-min)",
 162:        Lisp_Int, XSETINT, point)
 163: 
 164: DEFUN ("point-marker", Fpoint_marker, Spoint_marker, 0, 0, 0,
 165:    "Return value of point, as a marker object.")
 166:   ()
 167: {
 168:   return buildmark (point);
 169: }
 170: 
 171: DEFUN ("goto-char", Fgoto_char, Sgoto_char, 1, 1, "nGoto char: ",
 172:   "One arg, a number.  Set point to that number.\n\
 173: Beginning of buffer is position (point-min), end is (point-max).")
 174:   (n)
 175:      Lisp_Object n;
 176: {
 177:   int charno;
 178:   CHECK_NUMBER_COERCE_MARKER (n, 0);
 179:   charno = XINT (n);
 180:   if (charno < FirstCharacter) charno = FirstCharacter;
 181:   if (charno > NumCharacters) charno = NumCharacters + 1;
 182:   SetPoint (charno);
 183:   return n;
 184: }
 185: 
 186: DEFUN ("region-beginning", Fregion_beginning, Sregion_beginning, 0, 0, 0,
 187:   "Return position of beginning of region, as an integer.")
 188:   ()
 189: {
 190:   register int tem;
 191:   if (NULL (bf_cur->mark))
 192:     error ("There is no region now");
 193:   tem = marker_position (bf_cur->mark);
 194:   return make_number (min (point, tem));
 195: }
 196: 
 197: DEFUN ("region-end", Fregion_end, Sregion_end, 0, 0, 0,
 198:   "Return position of end of region, as an integer.")
 199:   ()
 200: {
 201:   register int tem;
 202:   if (NULL (bf_cur->mark))
 203:     error ("There is no region now");
 204:   tem = marker_position (bf_cur->mark);
 205:   return make_number (max (point, tem));
 206: }
 207: 
 208: DEFUN ("mark", Fmark, Smark, 0, 0, 0,
 209:   "Return this buffer's mark value as integer, or nil if no mark.")
 210:   ()
 211: {
 212:   if (!NULL (bf_cur->mark))
 213:     return Fmarker_position (bf_cur->mark);
 214:   return Qnil;
 215: }
 216: 
 217: DEFUN ("mark-marker", Fmark_marker, Smark_marker, 0, 0, 0,
 218:   "Return this buffer's mark, as a marker object, or nil if no mark.\n\
 219: Watch out!  Moving this marker changes the buffer's mark.")
 220:   ()
 221: {
 222:   return bf_cur->mark;
 223: }
 224: 
 225: DEFUN ("set-mark", Fset_mark, Sset_mark, 1, 1, "",
 226:   "Set this buffer's mark to POS;\n\
 227: Argument is character position, or nil to clear out the mark.")
 228:   (pos)
 229:      Lisp_Object pos;
 230: {
 231:   if (NULL (pos))
 232:     {
 233:       bf_cur->mark = Qnil;
 234:       return Qnil;
 235:     }
 236:   CHECK_NUMBER_COERCE_MARKER (pos, 0);
 237: 
 238:   if (NULL (bf_cur->mark))
 239:     bf_cur->mark = Fmake_marker ();
 240: 
 241:   Fset_marker (bf_cur->mark, pos, Qnil);
 242:   return pos;
 243: }
 244: 
 245: Lisp_Object
 246: save_excursion_save ()
 247: {
 248:   Lisp_Object oldpoint, oldmark;
 249:   int visible = XBUFFER (XWINDOW (selected_window)->buffer) == bf_cur;
 250: 
 251:   oldpoint = Fpoint_marker ();
 252: 
 253:   if (!NULL (bf_cur->mark))
 254:     oldmark = Fcopy_marker (bf_cur->mark);
 255:   else
 256:     oldmark = Qnil;
 257: 
 258:   return Fcons (oldpoint, Fcons (oldmark, visible ? Qt : Qnil));
 259: }
 260: 
 261: Lisp_Object
 262: save_excursion_restore (info)
 263:      Lisp_Object info;
 264: {
 265:   Lisp_Object tem;
 266: 
 267:   tem = Fmarker_buffer (Fcar (info));
 268:   /* If buffer being returned to is now deleted, avoid error */
 269:   /* Otherwise could get error here while unwinding to top level
 270:      and crash */
 271:   /* In that case, Fmarker_buffer returns nil now.  */
 272:   if (NULL (tem))
 273:     return Qnil;
 274:   Fset_buffer (tem);
 275:   Fgoto_char (Fcar (info));
 276:   unchain_marker (Fcar (info));
 277:   tem = Fcar (Fcdr (info));
 278:   Fset_mark (tem);
 279:   if (!NULL (tem))
 280:     unchain_marker (tem);
 281:   tem = Fcdr (Fcdr (info));
 282:   if (!NULL (tem) && bf_cur != XBUFFER (XWINDOW (selected_window)->buffer))
 283:     Fswitch_to_buffer (Fcurrent_buffer (), Qnil);
 284:   return Qnil;
 285: }
 286: 
 287: DEFUN ("save-excursion", Fsave_excursion, Ssave_excursion, 0, UNEVALLED, 0,
 288:   "Save point (and mark), execute BODY, then restore point and mark.\n\
 289: Executes BODY just like PROGN.  Point and mark values are restored\n\
 290: even in case of abnormal exit (throw or error).")
 291:   (args)
 292:      Lisp_Object args;
 293: {
 294:   Lisp_Object val;
 295:   int count = specpdl_ptr - specpdl;
 296: 
 297:   record_unwind_protect (save_excursion_restore, save_excursion_save ());
 298: 
 299:   val = Fprogn (args);
 300:   unbind_to (count);
 301:   return val;
 302: }
 303: 
 304: DEFSIMPLE ("buffer-size", Fbufsize, Sbufsize,
 305:        "Return the number of characters in the current buffer.",
 306:        Lisp_Int, XSETINT, bf_s1 + bf_s2)
 307: 
 308: DEFSIMPLE ("point-min", Fpoint_min, Spoint_min,
 309:        "Return the minimum permissible value of point in the current buffer.\n\
 310: This is 1, unless a clipping restriction is in effect.",
 311:        Lisp_Int, XSETINT, FirstCharacter)
 312: 
 313: DEFUN ("point-min-marker", Fpoint_min_marker, Spoint_min_marker, 0, 0, 0,
 314:   "Return a marker to the beginning of the currently visible part of the buffer.\n\
 315: This is the beginning, unless a clipping restriction is in effect.")
 316:   ()
 317: {
 318:   return buildmark (FirstCharacter);
 319: }
 320: 
 321: DEFSIMPLE ("point-max", Fpoint_max, Spoint_max,
 322:   "Return the maximum permissible value of point in the current buffer.\n\
 323: This is (1+ (buffer-size)), unless a clipping restriction is in effect,\n\
 324: in which case it is less.",
 325:        Lisp_Int, XSETINT, NumCharacters+1)
 326: 
 327: DEFUN ("point-max-marker", Fpoint_max_marker, Spoint_max_marker, 0, 0, 0,
 328:   "Return a marker to the end of the currently visible part of the buffer.\n\
 329: This is the actual end, unless a clipping restriction is in effect.")
 330:   ()
 331: {
 332:   return buildmark (NumCharacters+1);
 333: }
 334: 
 335: DEFSIMPLE ("following-char", Ffollchar, Sfollchar,
 336:        "Return the character following point, as a number.",
 337:        Lisp_Int, XSETINT, point>NumCharacters ? 0 : CharAt(point))
 338: DEFSIMPLE ("preceding-char", Fprevchar, Sprevchar,
 339:        "Return the character preceding point, as a number.",
 340:        Lisp_Int, XSETINT, point<=FirstCharacter ? 0 : CharAt(point-1))
 341: 
 342: DEFPRED ("bobp", Fbobp, Sbobp,
 343:   "Return T if point is at the beginning of the buffer.\n\
 344: If the buffer is narrowed, this means the beginning of the narrowed part.",
 345:      point<=FirstCharacter)
 346: DEFPRED ("eobp", Feobp, Seobp,
 347:   "Return T if point is at the end of the buffer.\n\
 348: If the buffer is narrowed, this means the end of the narrowed part.",
 349:      point>NumCharacters)
 350: DEFPRED ("bolp", Fbolp, Sbolp,
 351:   "Return T if point is at the beginning of a line.",
 352:      point<=FirstCharacter || CharAt(point-1)=='\n')
 353: DEFPRED ("eolp", Feolp, Seolp,
 354:   "Return T if point is at the end of a line.\n\
 355: `End of a line' includes point being at the end of the buffer.",
 356:      point>NumCharacters || CharAt(point)=='\n')
 357: 
 358: DEFUN ("char-after", Fchar_after, Schar_after, 1, 1, 0,
 359:   "One arg, POS, a number.  Return the character in the current buffer\n\
 360: at position POS.\n\
 361: If POS is out of range, the value is NIL.")
 362:   (pos)
 363:      Lisp_Object pos;
 364: {
 365:   Lisp_Object val;
 366:   CHECK_NUMBER_COERCE_MARKER (pos, 0);
 367:   if (XINT (pos) < FirstCharacter || XINT (pos) > NumCharacters) return Qnil;
 368: 
 369:   XFASTINT (val) = CharAt(XINT (pos));
 370:   return val;
 371: }
 372: 
 373: DEFUN ("user-login-name", Fuser_login_name, Suser_login_name, 0, 0, "",
 374:   "Return the name under which user logged in, as a string.")
 375:   ()
 376: {
 377:   return build_string (user_name);
 378: }
 379: 
 380: DEFUN ("user-real-login-name", Fuser_real_login_name, Suser_real_login_name,
 381:   0, 0, "",
 382:   "Return the name of the user's real uid, as a string.\n\
 383: Differs from user-login-name when running under su.")
 384:   ()
 385: {
 386:   return build_string (user_real_name);
 387: }
 388: 
 389: DEFUN ("user-full-name", Fuser_full_name, Suser_full_name, 0, 0, "",
 390:   "Return the full name of the user logged in, as a string.")
 391:   ()
 392: {
 393:   return build_string (user_full_name);
 394: }
 395: 
 396: DEFUN ("system-name", Fsystem_name, Ssystem_name, 0, 0, "",
 397:   "Return the name of the machine you are running on, as a string.")
 398:   ()
 399: {
 400:   return build_string (system_name);
 401: }
 402: 
 403: DEFUN ("current-time-string", Fcurrent_time_string, Scurrent_time_string, 0, 0, 0,
 404:   "Return the current time, as a human-readable string.")
 405:   ()
 406: {
 407:   long now = time ( (long *) 0);
 408:   char *tem = (char *) ctime (&now);
 409:   tem [24] = 0;
 410:   return build_string (tem);
 411: }
 412: 
 413: DEFUN ("insert", Finsert, Sinsert, 0, MANY, 0,
 414:   "Any number of args, strings or chars.  Insert them after point, moving point forward.")
 415:   (nargs, args)
 416:      int nargs;
 417:      Lisp_Object *args;
 418: {
 419:   int argnum;
 420:   Lisp_Object tem;
 421:   char str[1];
 422: 
 423:   for (argnum = 0; argnum < nargs; argnum++)
 424:     {
 425:       tem = args[argnum];
 426:     retry:
 427:       if (XTYPE (tem) == Lisp_Int)
 428:     {
 429:       str[0] = XINT (tem);
 430:       InsCStr (str, 1);
 431:     }
 432:       else if (XTYPE (tem) == Lisp_String)
 433:     {
 434:       InsCStr (XSTRING (tem)->data, XSTRING (tem)->size);
 435:     }
 436:       else
 437:     {
 438:       tem = wrong_type_argument (Qchar_or_string_p, tem);
 439:       goto retry;
 440:     }
 441:     }
 442:   return Qnil;
 443: }
 444: 
 445: DEFUN ("insert-before-markers", Finsert_before_markers, Sinsert_before_markers, 0, MANY, 0,
 446:   "Any number of args, strings or chars.  Insert them after point,\n\
 447: moving point forward.  Also, any markers pointing at the insertion point\n\
 448: get relocated to point after the newly inserted text.")
 449:   (nargs, args)
 450:      int nargs;
 451:      Lisp_Object *args;
 452: {
 453:   int argnum;
 454:   Lisp_Object tem;
 455:   char str[1];
 456: 
 457:   for (argnum = 0; argnum < nargs; argnum++)
 458:     {
 459:       tem = args[argnum];
 460:     retry:
 461:       if (XTYPE (tem) == Lisp_Int)
 462:     {
 463:       str[0] = XINT (tem);
 464:       insert_before_markers (str, 1);
 465:     }
 466:       else if (XTYPE (tem) == Lisp_String)
 467:     {
 468:       insert_before_markers (XSTRING (tem)->data, XSTRING (tem)->size);
 469:     }
 470:       else
 471:     {
 472:       tem = wrong_type_argument (Qchar_or_string_p, tem);
 473:       goto retry;
 474:     }
 475:     }
 476:   return Qnil;
 477: }
 478: 
 479: /* Return a string with the contents of the current region */
 480: 
 481: DEFUN ("buffer-substring", Fbuffer_substring, Sbuffer_substring, 2, 2, 0,
 482:   "Return the contents of part of the current buffer as a string.\n\
 483: The two arguments specify the start and end, as character numbers.")
 484:   (b, e)
 485:      Lisp_Object b, e;
 486: {
 487:   int beg, end;
 488: 
 489:   validate_region (&b, &e);
 490:   beg = XINT (b);
 491:   end = XINT (e);
 492: 
 493:   if (beg <= bf_s1 && end > bf_s1)
 494:       GapTo (beg);
 495:   return make_string (&CharAt (beg), end - beg);
 496: }
 497: 
 498: DEFUN ("buffer-string", Fbuffer_string, Sbuffer_string, 0, 0, 0,
 499:   "Return the contents of the current buffer as a string.")
 500:   ()
 501: {
 502:   if (FirstCharacter <= bf_s1 && NumCharacters + 1 > bf_s1)
 503:       GapTo (FirstCharacter);
 504:   return make_string (&CharAt (FirstCharacter), NumCharacters + 1 - FirstCharacter);
 505: }
 506: 
 507: DEFUN ("insert-buffer-substring", Finsert_buffer_substring, Sinsert_buffer_substring,
 508:   1, 3, 0,
 509:   "Insert before point a substring of the contents buffer BUFFER.\n\
 510: BUFFER may be a buffer or a buffer name.\n\
 511: Arguments START and END are character numbers specifying the substring.\n\
 512: They default to the beginning and the end of BUFFER.")
 513:   (buf, b, e)
 514:      Lisp_Object buf, b, e;
 515: {
 516:     int beg, end, exch;
 517: 
 518:   buf = Fget_buffer (buf);
 519:   if (XBUFFER (buf) == bf_cur)
 520:     error ("Cannot insert buffer into itself");
 521: 
 522:   if (NULL (b))
 523:     beg = XBUFFER (buf)->text.head_clip - 1;
 524:   else
 525:     {
 526:       CHECK_NUMBER_COERCE_MARKER (b, 0);
 527:       beg = XINT (b) - 1;
 528:     }
 529:   if (NULL (e))
 530:     end = XBUFFER (buf)->text.size1 + XBUFFER (buf)->text.size2
 531:             - XBUFFER (buf)->text.tail_clip;
 532:   else
 533:     {
 534:       CHECK_NUMBER_COERCE_MARKER (e, 1);
 535:       end = XINT (e) - 1;
 536:     }
 537: 
 538:   if (beg > end)
 539:     exch = beg, beg = end, end = exch;
 540: 
 541:   if (!(XBUFFER (buf)->text.head_clip - 1 <= beg
 542:     && beg <= end
 543:         && end <= XBUFFER (buf)->text.size1 + XBUFFER (buf)->text.size2
 544:             - XBUFFER (buf)->text.tail_clip))
 545:     args_out_of_range (b, e);
 546: 
 547:   if (beg < XBUFFER (buf)->text.size1)
 548:     {
 549:       InsCStr (XBUFFER (buf)->text.p1 + 1 + beg, min (end, XBUFFER (buf)->text.size1) - beg);
 550:       beg = min (end, XBUFFER (buf)->text.size1);
 551:     }
 552:   if (beg < end)
 553:     InsCStr (XBUFFER (buf)->text.p2 + 1 + beg, end - beg);
 554: 
 555:   return Qnil;
 556: }
 557: 
 558: DEFUN ("subst-char-in-region", Fsubst_char_in_region,
 559:   Ssubst_char_in_region, 4, 5, 0,
 560:   "From START to END, replace FROMCHAR with TOCHAR each time it occurs.\n\
 561: If optional arg NOUNDO is non-nil, don't record this change for undo\n\
 562: and don't mark the buffer as really changed.")
 563:   (start, end, fromchar, tochar, noundo)
 564:      Lisp_Object start, end, fromchar, tochar, noundo;
 565: {
 566:   register int pos, stop, look;
 567: 
 568:   validate_region (&start, &end);
 569:   CHECK_NUMBER (fromchar, 2);
 570:   CHECK_NUMBER (tochar, 3);
 571: 
 572:   pos = XINT (start);
 573:   stop = XINT (end);
 574:   if (!NULL (bf_cur->read_only))
 575:     Fbarf_if_buffer_read_only();
 576: 
 577:   look = XINT (fromchar);
 578: 
 579:   while (pos < stop)
 580:     {
 581:       if (CharAt (pos) == look)
 582:     {
 583:       if (NULL (noundo))
 584:         RecordChange (pos, 1);
 585:       CharAt (pos) = XINT (tochar);
 586:     }
 587:       pos++;
 588:     }
 589:   modify_region (pos, stop);
 590: 
 591:   return Qnil;
 592: }
 593: 
 594: DEFUN ("delete-region", Fdelete_region, Sdelete_region, 2, 2, "r",
 595:   "Delete the text between point and mark.\n\
 596: When called from a program, expects two arguments,\n\
 597: character numbers specifying the stretch to be deleted.")
 598:   (b, e)
 599:      Lisp_Object b, e;
 600: {
 601:   validate_region (&b, &e);
 602:   del_range (XINT (b), XINT (e));
 603:   return Qnil;
 604: }
 605: 
 606: DEFUN ("widen", Fwiden, Swiden, 0, 0, "",
 607:   "Remove restrictions from current buffer, allowing full text to be seen and edited.")
 608:   ()
 609: {
 610:   bf_cur->text.head_clip = bf_head_clip = 1;
 611:   bf_cur->text.tail_clip = bf_tail_clip = 0;
 612:   clip_changed = 1;
 613:   return Qnil;
 614: }
 615: 
 616: DEFUN ("narrow-to-region", Fnarrow_to_region, Snarrow_to_region, 2, 2, "r",
 617:   "Restrict editing in current buffer to text between present values of point and mark.\n\
 618: Use  widen  to undo the effects of this command.\n\
 619: Called non-interactively, takes two arguments; character numbers which\n\
 620: specify the stretch to which to restrict.")
 621:   (b, e)
 622:      Lisp_Object b, e;
 623: {
 624:   int i;
 625: 
 626:   CHECK_NUMBER_COERCE_MARKER (b, 0);
 627:   CHECK_NUMBER_COERCE_MARKER (e, 1);
 628: 
 629:   if (XINT (b) > XINT (e))
 630:     {
 631:       i = XFASTINT (b);
 632:       b = e;
 633:       XFASTINT (e) = i;
 634:     }
 635: 
 636:   if (!(1 <= XINT (b) && XINT (b) <= XINT (e)
 637:         && XINT (e) <= bf_s1 + bf_s2 + 1))
 638:     args_out_of_range (b, e);
 639: 
 640:   bf_cur->text.head_clip = bf_head_clip = XFASTINT (b);
 641:   bf_cur->text.tail_clip = bf_tail_clip = bf_s1 + bf_s2 + 1 - XFASTINT (e);
 642:   if (point < XFASTINT (b))
 643:     SetPoint (XFASTINT (b));
 644:   if (point > XFASTINT (e))
 645:     SetPoint (XFASTINT (e));
 646:   clip_changed = 1;
 647:   return Qnil;
 648: }
 649: 
 650: Lisp_Object
 651: save_restriction_save ()
 652: {
 653:   Lisp_Object ml, mh;
 654:   /* Note: I tried using markers here, but it does not win
 655:      because insertion at the end of the saved region
 656:      does not advance mh and is considered "outside" the saved region. */
 657:   XFASTINT (ml) = bf_head_clip;
 658:   XFASTINT (mh) = bf_tail_clip;
 659: 
 660:   return Fcons (Fcurrent_buffer (), Fcons (ml, mh));
 661: }
 662: 
 663: Lisp_Object
 664: save_restriction_restore (data)
 665:      Lisp_Object data;
 666: {
 667:   register struct buffer *old = bf_cur;
 668:   register int newhead, newtail;
 669: 
 670:   Fset_buffer (XCONS (data)->car);
 671: 
 672:   data = XCONS (data)->cdr;
 673: 
 674:   newhead = XINT (XCONS (data)->car);
 675:   newtail = XINT (XCONS (data)->cdr);
 676:   if (newhead + newtail > bf_s1 + bf_s2 + 1)
 677:     {
 678:       newhead = 1;
 679:       newtail = 0;
 680:     }
 681:   bf_cur->text.head_clip = bf_head_clip = newhead;
 682:   bf_cur->text.tail_clip = bf_tail_clip = newtail;
 683:   clip_changed = 1;
 684: 
 685:   /* If point is outside the new visible range, move it inside. */
 686:   if (point < FirstCharacter)
 687:     SetPoint (FirstCharacter);
 688:   if (point > NumCharacters+1)
 689:     SetPoint (NumCharacters+1);
 690: 
 691:   SetBfp (old);
 692:   return Qnil;
 693: }
 694: 
 695: DEFUN ("save-restriction", Fsave_restriction, Ssave_restriction, 0, UNEVALLED, 0,
 696:   "Execute the body, undoing at the end any changes to current buffer's restrictions.\n\
 697: Changes to restrictions are made by narrow-to-region or by widen.\n\
 698: Thus, the restrictions are the same after this function as they were before it.\n\
 699: The value returned is that returned by the last form in the body.\n\
 700: \n\
 701: This function can be confused if, within the body, you widen\n\
 702: and then make changes outside the area within the saved restrictions.\n\
 703: \n\
 704: Note: if you are using both save-excursion and save-restriction,\n\
 705: use save-excursion outermost.")
 706:   (body)
 707:      Lisp_Object body;
 708: {
 709:   Lisp_Object val;
 710:   int count = specpdl_ptr - specpdl;
 711: 
 712:   record_unwind_protect (save_restriction_restore, save_restriction_save ());
 713:   val = Fprogn (body);
 714:   unbind_to (count);
 715:   return val;
 716: }
 717: 
 718: DEFUN ("message", Fmessage, Smessage, 1, MANY, 0,
 719:   "Print a one-line message at the bottom of the screen.\n\
 720: The first argument is a control string.\n\
 721: It may contain %s or %d or %c to print successive following arguments.\n\
 722: %s means print an argument as a string, %d means print as number in decimal,\n\
 723: %c means print a number as a single character.\n\
 724: The argument used by %s must be a string or a symbol;\n\
 725: the argument used by %d or %c must be a number.")
 726:   (nargs, args)
 727:      int nargs;
 728:      Lisp_Object *args;
 729: {
 730:   Lisp_Object val;
 731: 
 732:   val = Fformat (nargs, args);
 733:   message ("%s", XSTRING (val)->data);
 734:   return val;
 735: }
 736: 
 737: DEFUN ("format", Fformat, Sformat, 1, MANY, 0,
 738:   "Format a string out of a control-string and arguments.\n\
 739: The first argument is a control string.\n\
 740: It, and subsequent arguments substituted into it, become the value, which is a string.\n\
 741: It may contain %s or %d or %c to substitute successive following arguments.\n\
 742: %s means print an argument as a string, %d means print as number in decimal,\n\
 743: %c means print a number as a single character.\n\
 744: The argument used by %s must be a string or a symbol;\n\
 745: the argument used by %d, %b, %o, %x or %c must be a number.")
 746:   (nargs, args)
 747:      int nargs;
 748:      register Lisp_Object *args;
 749: {
 750:   register int i;
 751:   register int total = 5;
 752:   char *buf;
 753:   register unsigned char **strings = (unsigned char **) alloca (nargs * sizeof (char *));
 754: 
 755:   for (i = 0; i < nargs; i++)
 756:     {
 757:       if (XTYPE (args[i]) == Lisp_Symbol)
 758:     {
 759:       strings[i] = XSYMBOL (args[i])->name->data;
 760:       total += XSYMBOL (args[i])->name->size;
 761:     }
 762:       else if (XTYPE (args[i]) == Lisp_String)
 763:     {
 764:       strings[i] = XSTRING (args[i])->data;
 765:       total += XSTRING (args[i])->size;
 766:     }
 767:       else if (XTYPE (args[i]) == Lisp_Int)
 768:     {
 769:       strings[i] = (unsigned char *) XINT (args[i]);
 770:       total += 10;
 771:     }
 772:       else
 773:     {
 774:       strings[i] = (unsigned char *) "??";
 775:       total += 2;
 776:     }
 777:     }
 778: 
 779:   /* Format it in bigger and bigger buf's until it all fits. */
 780: 
 781:   while (1)
 782:     {
 783:       buf = (char *) alloca (total + 1);
 784:       buf[total - 1] = 0;
 785: 
 786:       doprnt (buf, total + 1, strings[0], strings + 1);
 787:       if (buf[total - 1] == 0)
 788:     break;
 789: 
 790:       total *= 2;
 791:     }
 792: 
 793:   return build_string (buf);
 794: }
 795: 
 796: /* VARARGS 1 */
 797: Lisp_Object
 798: #ifdef NO_ARG_ARRAY
 799: format1 (string1, arg0, arg1, arg2, arg3, arg4)
 800:      Lisp_Object arg0, arg1, arg2, arg3, arg4;
 801: #else
 802: format1 (string1)
 803: #endif
 804:      char *string1;
 805: {
 806:   char buf[100];
 807: #ifdef NO_ARG_ARRAY
 808:   Lisp_Object args[5];
 809:   args[0] = arg0;
 810:   args[1] = arg1;
 811:   args[2] = arg2;
 812:   args[3] = arg3;
 813:   args[4] = arg4;
 814:   doprnt (buf, sizeof buf, string1, args);
 815: #else
 816:   doprnt (buf, sizeof buf, string1, &string1 + 1);
 817: #endif
 818:   return build_string (buf);
 819: }
 820: 
 821: DEFUN ("char-equal", Fchar_equal, Schar_equal, 2, 2, 0,
 822:   "T if args (both characters (numbers)) match.  May ignore case.\n\
 823: Case is ignored if the current buffer specifies to do so.")
 824:   (c1, c2)
 825:      Lisp_Object c1, c2;
 826: {
 827:   extern char downcase_table[];  /* From search.c */
 828: 
 829:   CHECK_NUMBER (c1, 0);
 830:   CHECK_NUMBER (c2, 1);
 831: 
 832:   if (!NULL (bf_cur->case_fold_search)
 833:       ? downcase_table[XINT (c1)] == downcase_table[XINT (c2)]
 834:       : XINT (c1) == XINT (c2))
 835:     return Qt;
 836:   return Qnil;
 837: }
 838: 
 839: DEFUN ("getenv", Fgetenv, Sgetenv, 1, 1, "sEnvironment variable: ",
 840:   "One arg VAR, a string. Return the value of environment variable VAR, as a string.")
 841:   (str)
 842:      Lisp_Object str;
 843: {
 844:   char *val;
 845:   CHECK_STRING (str, 0);
 846:   val = (char *) getenv (XSTRING (str)->data);
 847:   if (!val)
 848:     return Qnil;
 849:   return build_string (val);
 850: }
 851: 
 852: void
 853: syms_of_editfns ()
 854: {
 855:   defsubr (&Schar_equal);
 856:   defsubr (&Sgoto_char);
 857:   defsubr (&Sstring_to_char);
 858:   defsubr (&Schar_to_string);
 859:   defsubr (&Sbuffer_substring);
 860:   defsubr (&Sbuffer_string);
 861: 
 862:   defsubr (&Spoint_marker);
 863:   defalias (&Spoint_marker, "dot-marker");
 864:   defsubr (&Smark_marker);
 865:   defsubr (&Spoint);
 866:   defalias (&Spoint, "dot");
 867:   defsubr (&Sregion_beginning);
 868:   defsubr (&Sregion_end);
 869:   defsubr (&Smark);
 870:   defsubr (&Sset_mark);
 871:   defsubr (&Ssave_excursion);
 872: 
 873:   defsubr (&Sbufsize);
 874:   defsubr (&Spoint_max);
 875:   defsubr (&Spoint_min);
 876:   defalias (&Spoint_max, "dot-max");
 877:   defalias (&Spoint_min, "dot-min");
 878:   defsubr (&Spoint_min_marker);
 879:   defsubr (&Spoint_max_marker);
 880: 
 881:   defsubr (&Sbobp);
 882:   defsubr (&Seobp);
 883:   defsubr (&Sbolp);
 884:   defsubr (&Seolp);
 885:   defsubr (&Sfollchar);
 886:   defsubr (&Sprevchar);
 887:   defsubr (&Schar_after);
 888:   defsubr (&Sinsert);
 889:   defsubr (&Sinsert_before_markers);
 890: 
 891:   defsubr (&Suser_login_name);
 892:   defsubr (&Suser_real_login_name);
 893:   defsubr (&Suser_full_name);
 894:   defsubr (&Scurrent_time_string);
 895:   defsubr (&Sgetenv);
 896:   defsubr (&Ssystem_name);
 897:   defsubr (&Smessage);
 898:   defsubr (&Sformat);
 899: 
 900:   defsubr (&Sinsert_buffer_substring);
 901:   defsubr (&Ssubst_char_in_region);
 902:   defsubr (&Sdelete_region);
 903:   defsubr (&Swiden);
 904:   defsubr (&Snarrow_to_region);
 905:   defsubr (&Ssave_restriction);
 906: }

Defined functions

Defined variables

Defined macros