![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to editfns.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / src|
Return to editfns.c CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / src |
1.1 ! root 1: /* Lisp functions pertaining to editing. ! 2: Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc. ! 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: /* Some static data, and a function to initialize it for each run */ ! 32: ! 33: static char user_real_name[33]; /* login ID of current user */ ! 34: static char user_full_name[50]; /* full name of current user */ ! 35: ! 36: static char system_name[40]; ! 37: static char *user_name; ! 38: ! 39: void ! 40: init_editfns () ! 41: { ! 42: register char *p; ! 43: struct passwd *pw; /* password entry for the current user */ ! 44: extern char *index (); ! 45: ! 46: /* Set up system_name even when dumping. */ ! 47: ! 48: p = (char *) get_system_name (); ! 49: if (p == 0 || *p == 0) ! 50: p = "Bogus System Name"; ! 51: strncpy (system_name, p, sizeof system_name); ! 52: p = system_name; ! 53: while (*p) ! 54: { ! 55: if (*p < ' ') ! 56: *p = 0; ! 57: else ! 58: if (*p == ' ') ! 59: *p = '-'; ! 60: p++; ! 61: } ! 62: ! 63: #ifndef CANNOT_DUMP ! 64: /* Don't bother with this on initial start when just dumping out */ ! 65: if (!initialized) ! 66: return; ! 67: #endif /* not CANNOT_DUMP */ ! 68: ! 69: pw = (struct passwd *) getpwuid (getuid ()); ! 70: if (pw == 0) ! 71: strcpy (user_real_name, "unknown"); ! 72: else ! 73: strncpy (user_real_name, pw->pw_name, sizeof user_real_name); ! 74: ! 75: user_name = (char *) getenv ("USER"); ! 76: if (!user_name) ! 77: user_name = (char *) getenv ("LOGNAME"); /* USG equivalent */ ! 78: if (!user_name) ! 79: user_name = user_real_name; ! 80: ! 81: if (strcmp (user_name, user_real_name)) ! 82: pw = (struct passwd *) getpwnam (user_name); ! 83: ! 84: #ifndef AMPERSAND_FULL_NAME ! 85: if (pw == 0) ! 86: strcpy (user_full_name, "unknown"); ! 87: else ! 88: strncpy (user_full_name, USER_FULL_NAME, sizeof user_full_name); ! 89: p = index (user_full_name, ','); ! 90: if (p) *p = 0; ! 91: #else ! 92: if (pw == 0) ! 93: p = "unknown"; ! 94: else ! 95: p = USER_FULL_NAME; ! 96: { ! 97: int first = 1; ! 98: register char *q, *r; ! 99: ! 100: q = user_full_name; r = user_name; ! 101: ! 102: for (; (*p != 0) && (*p != ','); p++) ! 103: { ! 104: if (*p == '&') ! 105: { ! 106: if (*r != 0) ! 107: { ! 108: *q = *r++; ! 109: *q = UPCASE (*q); ! 110: for (q++; *r != 0; r++) ! 111: { ! 112: if (q == &user_full_name[sizeof user_full_name - 1]) ! 113: break; ! 114: *q++ = *r; ! 115: } ! 116: } ! 117: } ! 118: else ! 119: *q++ = *p; ! 120: if (q == &user_full_name[sizeof user_full_name - 2]) ! 121: break; ! 122: } ! 123: *q = 0; ! 124: } ! 125: #endif /* AMPERSAND_FULL_NAME */ ! 126: } ! 127: ! 128: DEFUN ("char-to-string", Fchar_to_string, Schar_to_string, 1, 1, 0, ! 129: "Convert arg CHAR to a string containing that character.") ! 130: (n) ! 131: Lisp_Object n; ! 132: { ! 133: char c; ! 134: CHECK_NUMBER (n, 0); ! 135: ! 136: c = XINT (n); ! 137: return make_string (&c, 1); ! 138: } ! 139: ! 140: DEFUN ("string-to-char", Fstring_to_char, Sstring_to_char, 1, 1, 0, ! 141: "Convert arg STRING to a character, the first character of that string.") ! 142: (str) ! 143: register Lisp_Object str; ! 144: { ! 145: register Lisp_Object val; ! 146: register struct Lisp_String *p; ! 147: CHECK_STRING (str, 0); ! 148: ! 149: p = XSTRING (str); ! 150: if (p->size) ! 151: XFASTINT (val) = ((unsigned char *) p->data)[0]; ! 152: else ! 153: XFASTINT (val) = 0; ! 154: return val; ! 155: } ! 156: ! 157: static Lisp_Object ! 158: buildmark (val) ! 159: int val; ! 160: { ! 161: register Lisp_Object mark; ! 162: mark = Fmake_marker (); ! 163: Fset_marker (mark, make_number (val), Qnil); ! 164: return mark; ! 165: } ! 166: ! 167: DEFSIMPLE ("point", Fpoint, Spoint, ! 168: "Return value of point, as an integer.\n\ ! 169: Beginning of buffer is position (point-min)", ! 170: Lisp_Int, XSETINT, point) ! 171: ! 172: DEFUN ("point-marker", Fpoint_marker, Spoint_marker, 0, 0, 0, ! 173: "Return value of point, as a marker object.") ! 174: () ! 175: { ! 176: return buildmark (point); ! 177: } ! 178: ! 179: DEFUN ("goto-char", Fgoto_char, Sgoto_char, 1, 1, "NGoto char: ", ! 180: "One arg, a number. Set point to that number.\n\ ! 181: Beginning of buffer is position (point-min), end is (point-max).") ! 182: (n) ! 183: register Lisp_Object n; ! 184: { ! 185: register int charno; ! 186: CHECK_NUMBER_COERCE_MARKER (n, 0); ! 187: charno = XINT (n); ! 188: if (charno < FirstCharacter) charno = FirstCharacter; ! 189: if (charno > NumCharacters) charno = NumCharacters + 1; ! 190: SetPoint (charno); ! 191: return n; ! 192: } ! 193: ! 194: static Lisp_Object ! 195: region_limit (beginningp) ! 196: int beginningp; ! 197: { ! 198: register Lisp_Object m; ! 199: m = Fmarker_position (bf_cur->mark); ! 200: if (NULL (m)) error ("There is no region now"); ! 201: if ((point < XFASTINT (m)) == beginningp) ! 202: return (make_number (point)); ! 203: else ! 204: return (m); ! 205: } ! 206: ! 207: DEFUN ("region-beginning", Fregion_beginning, Sregion_beginning, 0, 0, 0, ! 208: "Return position of beginning of region, as an integer.") ! 209: () ! 210: { ! 211: return (region_limit (1)); ! 212: } ! 213: ! 214: DEFUN ("region-end", Fregion_end, Sregion_end, 0, 0, 0, ! 215: "Return position of end of region, as an integer.") ! 216: () ! 217: { ! 218: return (region_limit (0)); ! 219: } ! 220: ! 221: #if 0 /* now in lisp code */ ! 222: DEFUN ("mark", Fmark, Smark, 0, 0, 0, ! 223: "Return this buffer's mark value as integer, or nil if no mark.\n\ ! 224: If you are using this in an editing command, you are most likely making\n\ ! 225: a mistake; see the documentation of `set-mark'.") ! 226: () ! 227: { ! 228: return Fmarker_position (bf_cur->mark); ! 229: } ! 230: #endif /* commented out code */ ! 231: ! 232: DEFUN ("mark-marker", Fmark_marker, Smark_marker, 0, 0, 0, ! 233: "Return this buffer's mark, as a marker object.\n\ ! 234: Watch out! Moving this marker changes the mark position.\n\ ! 235: The marker will not point anywhere if mark is not set.") ! 236: () ! 237: { ! 238: return bf_cur->mark; ! 239: } ! 240: ! 241: #if 0 /* this is now in lisp code */ ! 242: DEFUN ("set-mark", Fset_mark, Sset_mark, 1, 1, 0, ! 243: "Set this buffer's mark to POS. Don't use this function!\n\ ! 244: That is to say, don't use this function unless you want\n\ ! 245: the user to see that the mark has moved, and you want the previous\n\ ! 246: mark position to be lost.\n\ ! 247: \n\ ! 248: Normally, when a new mark is set, the old one should go on the stack.\n\ ! 249: This is why most applications should use push-mark, not set-mark.\n\ ! 250: \n\ ! 251: Novice programmers often try to use the mark for the wrong purposes.\n\ ! 252: The mark saves a location for the user's convenience.\n\ ! 253: Most editing commands should not alter the mark.\n\ ! 254: To remember a location for internal use in the Lisp program,\n\ ! 255: store it in a Lisp variable. Example:\n\ ! 256: \n\ ! 257: (let ((beg (point))) (forward-line 1) (delete-region beg (point))).") ! 258: (pos) ! 259: Lisp_Object pos; ! 260: { ! 261: if (NULL (pos)) ! 262: { ! 263: bf_cur->mark = Qnil; ! 264: return Qnil; ! 265: } ! 266: CHECK_NUMBER_COERCE_MARKER (pos, 0); ! 267: ! 268: if (NULL (bf_cur->mark)) ! 269: bf_cur->mark = Fmake_marker (); ! 270: ! 271: Fset_marker (bf_cur->mark, pos, Qnil); ! 272: return pos; ! 273: } ! 274: #endif /* commented-out code */ ! 275: ! 276: Lisp_Object ! 277: save_excursion_save () ! 278: { ! 279: register Lisp_Object oldpoint, oldmark; ! 280: register int visible = XBUFFER (XWINDOW (selected_window)->buffer) == bf_cur; ! 281: ! 282: oldpoint = Fpoint_marker (); ! 283: oldmark = Fcopy_marker (bf_cur->mark); ! 284: return Fcons (oldpoint, Fcons (oldmark, visible ? Qt : Qnil)); ! 285: } ! 286: ! 287: Lisp_Object ! 288: save_excursion_restore (info) ! 289: register Lisp_Object info; ! 290: { ! 291: register Lisp_Object tem; ! 292: ! 293: tem = Fmarker_buffer (Fcar (info)); ! 294: /* If buffer being returned to is now deleted, avoid error */ ! 295: /* Otherwise could get error here while unwinding to top level ! 296: and crash */ ! 297: /* In that case, Fmarker_buffer returns nil now. */ ! 298: if (NULL (tem)) ! 299: return Qnil; ! 300: Fset_buffer (tem); ! 301: tem = Fcar (info); ! 302: Fgoto_char (tem); ! 303: unchain_marker (tem); ! 304: tem = Fcar (Fcdr (info)); ! 305: Fset_marker (bf_cur->mark, tem, Fcurrent_buffer ()); ! 306: unchain_marker (tem); ! 307: tem = Fcdr (Fcdr (info)); ! 308: if (!NULL (tem) && bf_cur != XBUFFER (XWINDOW (selected_window)->buffer)) ! 309: Fswitch_to_buffer (Fcurrent_buffer (), Qnil); ! 310: return Qnil; ! 311: } ! 312: ! 313: DEFUN ("save-excursion", Fsave_excursion, Ssave_excursion, 0, UNEVALLED, 0, ! 314: "Save point (and mark), execute BODY, then restore point and mark.\n\ ! 315: Executes BODY just like PROGN. Point and mark values are restored\n\ ! 316: even in case of abnormal exit (throw or error).") ! 317: (args) ! 318: Lisp_Object args; ! 319: { ! 320: register Lisp_Object val; ! 321: int count = specpdl_ptr - specpdl; ! 322: ! 323: record_unwind_protect (save_excursion_restore, save_excursion_save ()); ! 324: ! 325: val = Fprogn (args); ! 326: unbind_to (count); ! 327: return val; ! 328: } ! 329: ! 330: DEFSIMPLE ("buffer-size", Fbufsize, Sbufsize, ! 331: "Return the number of characters in the current buffer.", ! 332: Lisp_Int, XSETINT, bf_s1 + bf_s2) ! 333: ! 334: DEFSIMPLE ("point-min", Fpoint_min, Spoint_min, ! 335: "Return the minimum permissible value of point in the current buffer.\n\ ! 336: This is 1, unless a clipping restriction is in effect.", ! 337: Lisp_Int, XSETINT, FirstCharacter) ! 338: ! 339: DEFUN ("point-min-marker", Fpoint_min_marker, Spoint_min_marker, 0, 0, 0, ! 340: "Return a marker to the beginning of the currently visible part of the buffer.\n\ ! 341: This is the beginning, unless a clipping restriction is in effect.") ! 342: () ! 343: { ! 344: return buildmark (FirstCharacter); ! 345: } ! 346: ! 347: DEFSIMPLE ("point-max", Fpoint_max, Spoint_max, ! 348: "Return the maximum permissible value of point in the current buffer.\n\ ! 349: This is (1+ (buffer-size)), unless a clipping restriction is in effect,\n\ ! 350: in which case it is less.", ! 351: Lisp_Int, XSETINT, NumCharacters+1) ! 352: ! 353: DEFUN ("point-max-marker", Fpoint_max_marker, Spoint_max_marker, 0, 0, 0, ! 354: "Return a marker to the end of the currently visible part of the buffer.\n\ ! 355: This is the actual end, unless a clipping restriction is in effect.") ! 356: () ! 357: { ! 358: return buildmark (NumCharacters+1); ! 359: } ! 360: ! 361: DEFSIMPLE ("following-char", Ffollchar, Sfollchar, ! 362: "Return the character following point, as a number.", ! 363: Lisp_Int, XSETINT, point>NumCharacters ? 0 : CharAt(point)) ! 364: DEFSIMPLE ("preceding-char", Fprevchar, Sprevchar, ! 365: "Return the character preceding point, as a number.", ! 366: Lisp_Int, XSETINT, point<=FirstCharacter ? 0 : CharAt(point-1)) ! 367: ! 368: DEFPRED ("bobp", Fbobp, Sbobp, ! 369: "Return T if point is at the beginning of the buffer.\n\ ! 370: If the buffer is narrowed, this means the beginning of the narrowed part.", ! 371: point<=FirstCharacter) ! 372: DEFPRED ("eobp", Feobp, Seobp, ! 373: "Return T if point is at the end of the buffer.\n\ ! 374: If the buffer is narrowed, this means the end of the narrowed part.", ! 375: point>NumCharacters) ! 376: DEFPRED ("bolp", Fbolp, Sbolp, ! 377: "Return T if point is at the beginning of a line.", ! 378: point<=FirstCharacter || CharAt(point-1)=='\n') ! 379: DEFPRED ("eolp", Feolp, Seolp, ! 380: "Return T if point is at the end of a line.\n\ ! 381: `End of a line' includes point being at the end of the buffer.", ! 382: point>NumCharacters || CharAt(point)=='\n') ! 383: ! 384: DEFUN ("char-after", Fchar_after, Schar_after, 1, 1, 0, ! 385: "One arg, POS, a number. Return the character in the current buffer\n\ ! 386: at position POS.\n\ ! 387: If POS is out of range, the value is NIL.") ! 388: (pos) ! 389: Lisp_Object pos; ! 390: { ! 391: register Lisp_Object val; ! 392: register int n = XINT (pos); ! 393: CHECK_NUMBER_COERCE_MARKER (pos, 0); ! 394: if (n < FirstCharacter || n > NumCharacters) return Qnil; ! 395: ! 396: XFASTINT (val) = CharAt (n); ! 397: return val; ! 398: } ! 399: ! 400: DEFUN ("user-login-name", Fuser_login_name, Suser_login_name, 0, 0, 0, ! 401: "Return the name under which user logged in, as a string.\n\ ! 402: This is based on the effective uid, not the real uid.") ! 403: () ! 404: { ! 405: return build_string (user_name); ! 406: } ! 407: ! 408: DEFUN ("user-real-login-name", Fuser_real_login_name, Suser_real_login_name, ! 409: 0, 0, 0, ! 410: "Return the name of the user's real uid, as a string.\n\ ! 411: Differs from user-login-name when running under su.") ! 412: () ! 413: { ! 414: return build_string (user_real_name); ! 415: } ! 416: ! 417: DEFUN ("user-uid", Fuser_uid, Suser_uid, 0, 0, 0, ! 418: "Return the effective uid of Emacs, as an integer.") ! 419: () ! 420: { ! 421: return make_number (geteuid ()); ! 422: } ! 423: ! 424: DEFUN ("user-real-uid", Fuser_real_uid, Suser_real_uid, 0, 0, 0, ! 425: "Return the real uid of Emacs, as an integer.") ! 426: () ! 427: { ! 428: return make_number (getuid ()); ! 429: } ! 430: ! 431: DEFUN ("user-full-name", Fuser_full_name, Suser_full_name, 0, 0, 0, ! 432: "Return the full name of the user logged in, as a string.") ! 433: () ! 434: { ! 435: return build_string (user_full_name); ! 436: } ! 437: ! 438: DEFUN ("system-name", Fsystem_name, Ssystem_name, 0, 0, 0, ! 439: "Return the name of the machine you are running on, as a string.") ! 440: () ! 441: { ! 442: return build_string (system_name); ! 443: } ! 444: ! 445: DEFUN ("current-time-string", Fcurrent_time_string, Scurrent_time_string, 0, 0, 0, ! 446: "Return the current time, as a human-readable string.") ! 447: () ! 448: { ! 449: long now = time ( (long *) 0); ! 450: register char *tem = (char *) ctime (&now); ! 451: tem [24] = 0; ! 452: return build_string (tem); ! 453: } ! 454: ! 455: DEFUN ("insert", Finsert, Sinsert, 0, MANY, 0, ! 456: "Any number of args, strings or chars. Insert them after point, moving point forward.") ! 457: (nargs, args) ! 458: int nargs; ! 459: register Lisp_Object *args; ! 460: { ! 461: register int argnum; ! 462: register Lisp_Object tem; ! 463: char str[1]; ! 464: ! 465: for (argnum = 0; argnum < nargs; argnum++) ! 466: { ! 467: tem = args[argnum]; ! 468: retry: ! 469: if (XTYPE (tem) == Lisp_Int) ! 470: { ! 471: str[0] = XINT (tem); ! 472: InsCStr (str, 1); ! 473: } ! 474: else if (XTYPE (tem) == Lisp_String) ! 475: { ! 476: InsCStr (XSTRING (tem)->data, XSTRING (tem)->size); ! 477: } ! 478: else ! 479: { ! 480: tem = wrong_type_argument (Qchar_or_string_p, tem); ! 481: goto retry; ! 482: } ! 483: } ! 484: return Qnil; ! 485: } ! 486: ! 487: DEFUN ("insert-before-markers", Finsert_before_markers, Sinsert_before_markers, 0, MANY, 0, ! 488: "Any number of args, strings or chars. Insert them after point,\n\ ! 489: moving point forward. Also, any markers pointing at the insertion point\n\ ! 490: get relocated to point after the newly inserted text.") ! 491: (nargs, args) ! 492: int nargs; ! 493: register Lisp_Object *args; ! 494: { ! 495: register int argnum; ! 496: register Lisp_Object tem; ! 497: char str[1]; ! 498: ! 499: for (argnum = 0; argnum < nargs; argnum++) ! 500: { ! 501: tem = args[argnum]; ! 502: retry: ! 503: if (XTYPE (tem) == Lisp_Int) ! 504: { ! 505: str[0] = XINT (tem); ! 506: insert_before_markers (str, 1); ! 507: } ! 508: else if (XTYPE (tem) == Lisp_String) ! 509: { ! 510: insert_before_markers (XSTRING (tem)->data, XSTRING (tem)->size); ! 511: } ! 512: else ! 513: { ! 514: tem = wrong_type_argument (Qchar_or_string_p, tem); ! 515: goto retry; ! 516: } ! 517: } ! 518: return Qnil; ! 519: } ! 520: ! 521: DEFUN ("insert-char", Finsert_char, Sinsert_char, 2, 2, 0, ! 522: "Insert COUNT (second arg) copies of CHAR (first arg).\n\ ! 523: Both arguments are required.") ! 524: (chr, count) ! 525: Lisp_Object chr, count; ! 526: { ! 527: register unsigned char *string; ! 528: register int strlen; ! 529: register int i, n; ! 530: ! 531: CHECK_NUMBER (chr, 0); ! 532: CHECK_NUMBER (count, 1); ! 533: ! 534: n = XINT (count); ! 535: if (n <= 0) ! 536: return Qnil; ! 537: strlen = max (n, 256); ! 538: string = (unsigned char *) alloca (strlen); ! 539: for (i = 0; i < strlen; i++) ! 540: string[i] = XFASTINT (chr); ! 541: while (n >= strlen) ! 542: { ! 543: InsCStr (string, strlen); ! 544: n -= strlen; ! 545: } ! 546: if (n > 0) ! 547: InsCStr (string, n); ! 548: return Qnil; ! 549: } ! 550: ! 551: ! 552: /* Return a string with the contents of the current region */ ! 553: ! 554: DEFUN ("buffer-substring", Fbuffer_substring, Sbuffer_substring, 2, 2, 0, ! 555: "Return the contents of part of the current buffer as a string.\n\ ! 556: The two arguments specify the start and end, as character numbers.") ! 557: (b, e) ! 558: Lisp_Object b, e; ! 559: { ! 560: register int beg, end; ! 561: ! 562: validate_region (&b, &e); ! 563: beg = XINT (b); ! 564: end = XINT (e); ! 565: ! 566: if (beg <= bf_s1 && end > bf_s1) ! 567: move_gap (beg); ! 568: return make_string (&CharAt (beg), end - beg); ! 569: } ! 570: ! 571: DEFUN ("buffer-string", Fbuffer_string, Sbuffer_string, 0, 0, 0, ! 572: "Return the contents of the current buffer as a string.") ! 573: () ! 574: { ! 575: if (FirstCharacter <= bf_s1 && NumCharacters + 1 > bf_s1) ! 576: move_gap (FirstCharacter); ! 577: return make_string (&CharAt (FirstCharacter), NumCharacters + 1 - FirstCharacter); ! 578: } ! 579: ! 580: DEFUN ("insert-buffer-substring", Finsert_buffer_substring, Sinsert_buffer_substring, ! 581: 1, 3, 0, ! 582: "Insert before point a substring of the contents buffer BUFFER.\n\ ! 583: BUFFER may be a buffer or a buffer name.\n\ ! 584: Arguments START and END are character numbers specifying the substring.\n\ ! 585: They default to the beginning and the end of BUFFER.") ! 586: (buf, b, e) ! 587: Lisp_Object buf, b, e; ! 588: { ! 589: register int beg, end, exch; ! 590: register struct buffer *bp; ! 591: ! 592: buf = Fget_buffer (buf); ! 593: bp = XBUFFER (buf); ! 594: ! 595: if (NULL (b)) ! 596: beg = bp->text.head_clip - 1; ! 597: else ! 598: { ! 599: CHECK_NUMBER_COERCE_MARKER (b, 0); ! 600: beg = XINT (b) - 1; ! 601: } ! 602: if (NULL (e)) ! 603: end = bp->text.size1 + bp->text.size2 ! 604: - bp->text.tail_clip; ! 605: else ! 606: { ! 607: CHECK_NUMBER_COERCE_MARKER (e, 1); ! 608: end = XINT (e) - 1; ! 609: } ! 610: ! 611: if (beg > end) ! 612: exch = beg, beg = end, end = exch; ! 613: ! 614: /* Move the gap or create enough gap in the current buffer. */ ! 615: ! 616: if (point != bf_s1 + 1) ! 617: move_gap (point); ! 618: if (bf_gap < end - beg) ! 619: make_gap (end - beg); ! 620: /* Make sure buf->text is up to date in case buf is the current buffer. */ ! 621: bf_cur->text = bf_text; ! 622: ! 623: if (!(bp->text.head_clip - 1 <= beg ! 624: && beg <= end ! 625: && end <= bp->text.size1 + bp->text.size2 - bp->text.tail_clip)) ! 626: args_out_of_range (b, e); ! 627: ! 628: /* Now the actual insertion will not do any gap motion, ! 629: so it matters not if BUF is the current buffer. */ ! 630: ! 631: if (beg < bp->text.size1) ! 632: { ! 633: InsCStr (bp->text.p1 + 1 + beg, min (end, bp->text.size1) - beg); ! 634: beg = min (end, bp->text.size1); ! 635: } ! 636: if (beg < end) ! 637: InsCStr (bp->text.p2 + 1 + beg, end - beg); ! 638: ! 639: return Qnil; ! 640: } ! 641: ! 642: DEFUN ("subst-char-in-region", Fsubst_char_in_region, ! 643: Ssubst_char_in_region, 4, 5, 0, ! 644: "From START to END, replace FROMCHAR with TOCHAR each time it occurs.\n\ ! 645: If optional arg NOUNDO is non-nil, don't record this change for undo\n\ ! 646: and don't mark the buffer as really changed.") ! 647: (start, end, fromchar, tochar, noundo) ! 648: Lisp_Object start, end, fromchar, tochar, noundo; ! 649: { ! 650: register int pos, stop, look; ! 651: ! 652: validate_region (&start, &end); ! 653: CHECK_NUMBER (fromchar, 2); ! 654: CHECK_NUMBER (tochar, 3); ! 655: ! 656: pos = XINT (start); ! 657: stop = XINT (end); ! 658: look = XINT (fromchar); ! 659: ! 660: modify_region (pos, stop); ! 661: if (! NULL (noundo)) ! 662: { ! 663: if (bf_modified - 1 == bf_cur->save_modified) ! 664: bf_cur->save_modified++; ! 665: if (bf_modified - 1 == bf_cur->auto_save_modified) ! 666: bf_cur->auto_save_modified++; ! 667: } ! 668: ! 669: while (pos < stop) ! 670: { ! 671: if (CharAt (pos) == look) ! 672: { ! 673: if (NULL (noundo)) ! 674: record_change (pos, 1); ! 675: CharAt (pos) = XINT (tochar); ! 676: } ! 677: pos++; ! 678: } ! 679: ! 680: return Qnil; ! 681: } ! 682: ! 683: DEFUN ("delete-region", Fdelete_region, Sdelete_region, 2, 2, "r", ! 684: "Delete the text between point and mark.\n\ ! 685: When called from a program, expects two arguments,\n\ ! 686: character numbers specifying the stretch to be deleted.") ! 687: (b, e) ! 688: Lisp_Object b, e; ! 689: { ! 690: validate_region (&b, &e); ! 691: del_range (XINT (b), XINT (e)); ! 692: return Qnil; ! 693: } ! 694: ! 695: DEFUN ("widen", Fwiden, Swiden, 0, 0, "", ! 696: "Remove restrictions from current buffer, allowing full text to be seen and edited.") ! 697: () ! 698: { ! 699: bf_cur->text.head_clip = bf_head_clip = 1; ! 700: bf_cur->text.tail_clip = bf_tail_clip = 0; ! 701: clip_changed = 1; ! 702: return Qnil; ! 703: } ! 704: ! 705: DEFUN ("narrow-to-region", Fnarrow_to_region, Snarrow_to_region, 2, 2, "r", ! 706: "Restrict editing in this buffer to the current region.\n\ ! 707: The rest of the text becomes temporarily invisible and untouchable\n\ ! 708: but is not deleted; if you save the buffer in a file, the invisible\n\ ! 709: text is included in the file. \\[widen] makes all visible again.\n\ ! 710: \n\ ! 711: When calling from a program, pass two arguments; character numbers\n\ ! 712: bounding the text that should remain visible.") ! 713: (b, e) ! 714: register Lisp_Object b, e; ! 715: { ! 716: register int i; ! 717: ! 718: CHECK_NUMBER_COERCE_MARKER (b, 0); ! 719: CHECK_NUMBER_COERCE_MARKER (e, 1); ! 720: ! 721: if (XINT (b) > XINT (e)) ! 722: { ! 723: i = XFASTINT (b); ! 724: b = e; ! 725: XFASTINT (e) = i; ! 726: } ! 727: ! 728: if (!(1 <= XINT (b) && XINT (b) <= XINT (e) ! 729: && XINT (e) <= bf_s1 + bf_s2 + 1)) ! 730: args_out_of_range (b, e); ! 731: ! 732: bf_cur->text.head_clip = bf_head_clip = XFASTINT (b); ! 733: bf_cur->text.tail_clip = bf_tail_clip = bf_s1 + bf_s2 + 1 - XFASTINT (e); ! 734: if (point < XFASTINT (b)) ! 735: SetPoint (XFASTINT (b)); ! 736: if (point > XFASTINT (e)) ! 737: SetPoint (XFASTINT (e)); ! 738: clip_changed = 1; ! 739: return Qnil; ! 740: } ! 741: ! 742: Lisp_Object ! 743: save_restriction_save () ! 744: { ! 745: register Lisp_Object ml, mh; ! 746: /* Note: I tried using markers here, but it does not win ! 747: because insertion at the end of the saved region ! 748: does not advance mh and is considered "outside" the saved region. */ ! 749: XFASTINT (ml) = bf_head_clip; ! 750: XFASTINT (mh) = bf_tail_clip; ! 751: ! 752: return Fcons (Fcurrent_buffer (), Fcons (ml, mh)); ! 753: } ! 754: ! 755: Lisp_Object ! 756: save_restriction_restore (data) ! 757: Lisp_Object data; ! 758: { ! 759: register struct buffer *old = bf_cur; ! 760: register int newhead, newtail; ! 761: register Lisp_Object tem; ! 762: ! 763: Fset_buffer (XCONS (data)->car); ! 764: ! 765: data = XCONS (data)->cdr; ! 766: ! 767: tem = XCONS (data)->car; ! 768: newhead = XINT (tem); ! 769: tem = XCONS (data)->cdr; ! 770: newtail = XINT (tem); ! 771: if (newhead + newtail > bf_s1 + bf_s2 + 1) ! 772: { ! 773: newhead = 1; ! 774: newtail = 0; ! 775: } ! 776: bf_cur->text.head_clip = bf_head_clip = newhead; ! 777: bf_cur->text.tail_clip = bf_tail_clip = newtail; ! 778: clip_changed = 1; ! 779: ! 780: /* If point is outside the new visible range, move it inside. */ ! 781: if (point < FirstCharacter) ! 782: SetPoint (FirstCharacter); ! 783: if (point > NumCharacters+1) ! 784: SetPoint (NumCharacters+1); ! 785: ! 786: SetBfp (old); ! 787: return Qnil; ! 788: } ! 789: ! 790: DEFUN ("save-restriction", Fsave_restriction, Ssave_restriction, 0, UNEVALLED, 0, ! 791: "Execute the body, undoing at the end any changes to current buffer's restrictions.\n\ ! 792: Changes to restrictions are made by narrow-to-region or by widen.\n\ ! 793: Thus, the restrictions are the same after this function as they were before it.\n\ ! 794: The value returned is that returned by the last form in the body.\n\ ! 795: \n\ ! 796: This function can be confused if, within the body, you widen\n\ ! 797: and then make changes outside the area within the saved restrictions.\n\ ! 798: \n\ ! 799: Note: if you are using both save-excursion and save-restriction,\n\ ! 800: use save-excursion outermost.") ! 801: (body) ! 802: Lisp_Object body; ! 803: { ! 804: register Lisp_Object val; ! 805: int count = specpdl_ptr - specpdl; ! 806: ! 807: record_unwind_protect (save_restriction_restore, save_restriction_save ()); ! 808: val = Fprogn (body); ! 809: unbind_to (count); ! 810: return val; ! 811: } ! 812: ! 813: DEFUN ("message", Fmessage, Smessage, 1, MANY, 0, ! 814: "Print a one-line message at the bottom of the screen.\n\ ! 815: The first argument is a control string.\n\ ! 816: It may contain %s or %d or %c to print successive following arguments.\n\ ! 817: %s means print an argument as a string, %d means print as number in decimal,\n\ ! 818: %c means print a number as a single character.\n\ ! 819: The argument used by %s must be a string or a symbol;\n\ ! 820: the argument used by %d or %c must be a number.") ! 821: (nargs, args) ! 822: int nargs; ! 823: Lisp_Object *args; ! 824: { ! 825: register Lisp_Object val; ! 826: ! 827: val = Fformat (nargs, args); ! 828: message ("%s", XSTRING (val)->data); ! 829: return val; ! 830: } ! 831: ! 832: DEFUN ("format", Fformat, Sformat, 1, MANY, 0, ! 833: "Format a string out of a control-string and arguments.\n\ ! 834: The first argument is a control string.\n\ ! 835: It, and subsequent arguments substituted into it, become the value, which is a string.\n\ ! 836: It may contain %s or %d or %c to substitute successive following arguments.\n\ ! 837: %s means print an argument as a string, %d means print as number in decimal,\n\ ! 838: %c means print a number as a single character.\n\ ! 839: The argument used by %s must be a string or a symbol;\n\ ! 840: the argument used by %d, %b, %o, %x or %c must be a number.") ! 841: (nargs, args) ! 842: int nargs; ! 843: register Lisp_Object *args; ! 844: { ! 845: register int n; ! 846: register int total = 5; ! 847: char *buf; ! 848: register unsigned char *format; ! 849: register unsigned char **strings; ! 850: extern char *index (); ! 851: /* struct gcpro gcpro1; */ ! 852: ! 853: CHECK_STRING (args[0], 0); ! 854: format = XSTRING (args[0])->data; ! 855: ! 856: /* This should be unnecessary. We don't call eval, so we cannot gc. */ ! 857: /* GCPRO1 (*args); ! 858: gcpro1.nvars = nargs; */ ! 859: ! 860: /* We have to do so much work in oder to prepare to call doprnt ! 861: that we might as well do all of it ourself... (Which would also ! 862: circumvent C asciz cretinism by allowing ascii 000 chars to appear) ! 863: */ ! 864: n = 0; ! 865: while (format = (unsigned char *) index (format, '%')) ! 866: { ! 867: format++; ! 868: while ((*format >= '0' && *format <= '9') ! 869: || *format == '-' || *format == ' ') ! 870: format++; ! 871: if (*format == '%') ! 872: format++; ! 873: else if (++n >= nargs) ! 874: ; ! 875: else if (XTYPE (args[n]) == Lisp_Symbol) ! 876: { ! 877: XSET (args[n], Lisp_String, XSYMBOL (args[n])->name); ! 878: goto string; ! 879: } ! 880: else if (XTYPE (args[n]) == Lisp_String) ! 881: { ! 882: string: ! 883: total += XSTRING (args[n])->size; ! 884: } ! 885: /* would get MPV otherwise, since Lisp_Int's `point' to low memory */ ! 886: else if (XTYPE (args[n]) == Lisp_Int && *format != 's') ! 887: total += 10; ! 888: else ! 889: { ! 890: register Lisp_Object tem; ! 891: tem = Fprin1_to_string (args[n]); ! 892: args[n] = tem; ! 893: goto string; ! 894: } ! 895: } ! 896: ! 897: strings = (unsigned char **) alloca ((n + 1) * sizeof (unsigned char *)); ! 898: for (; n >= 0; n--) ! 899: { ! 900: if (n >= nargs) ! 901: strings[n] = (unsigned char *) ""; ! 902: else if (XTYPE (args[n]) == Lisp_Int) ! 903: /* We checked above that the correspondiong format effector ! 904: isn't %s, which would cause MPV */ ! 905: strings[n] = (unsigned char *) XINT (args[n]); ! 906: else ! 907: strings[n] = XSTRING (args[n])->data; ! 908: } ! 909: ! 910: /* Format it in bigger and bigger buf's until it all fits. */ ! 911: while (1) ! 912: { ! 913: buf = (char *) alloca (total + 1); ! 914: buf[total - 1] = 0; ! 915: ! 916: doprnt (buf, total + 1, strings[0], nargs, strings + 1); ! 917: if (buf[total - 1] == 0) ! 918: break; ! 919: ! 920: total *= 2; ! 921: } ! 922: ! 923: /* UNGCPRO; */ ! 924: return build_string (buf); ! 925: } ! 926: ! 927: /* VARARGS 1 */ ! 928: Lisp_Object ! 929: #ifdef NO_ARG_ARRAY ! 930: format1 (string1, arg0, arg1, arg2, arg3, arg4) ! 931: int arg0, arg1, arg2, arg3, arg4; ! 932: #else ! 933: format1 (string1) ! 934: #endif ! 935: char *string1; ! 936: { ! 937: char buf[100]; ! 938: #ifdef NO_ARG_ARRAY ! 939: int args[5]; ! 940: args[0] = arg0; ! 941: args[1] = arg1; ! 942: args[2] = arg2; ! 943: args[3] = arg3; ! 944: args[4] = arg4; ! 945: doprnt (buf, sizeof buf, string1, 5, args); ! 946: #else ! 947: doprnt (buf, sizeof buf, string1, 5, &string1 + 1); ! 948: #endif ! 949: return build_string (buf); ! 950: } ! 951: ! 952: DEFUN ("char-equal", Fchar_equal, Schar_equal, 2, 2, 0, ! 953: "T if args (both characters (numbers)) match. May ignore case.\n\ ! 954: Case is ignored if the current buffer specifies to do so.") ! 955: (c1, c2) ! 956: register Lisp_Object c1, c2; ! 957: { ! 958: CHECK_NUMBER (c1, 0); ! 959: CHECK_NUMBER (c2, 1); ! 960: ! 961: if (!NULL (bf_cur->case_fold_search) ! 962: ? downcase_table[0xff & XFASTINT (c1)] == downcase_table[0xff & XFASTINT (c2)] ! 963: : XINT (c1) == XINT (c2)) ! 964: return Qt; ! 965: return Qnil; ! 966: } ! 967: ! 968: #ifndef MAINTAIN_ENVIRONMENT /* it is done in environ.c in that case */ ! 969: DEFUN ("getenv", Fgetenv, Sgetenv, 1, 2, 0, ! 970: "One arg VAR, a string. Return the value of environment variable VAR, as a string.") ! 971: (str) ! 972: Lisp_Object str; ! 973: { ! 974: register char *val; ! 975: CHECK_STRING (str, 0); ! 976: val = (char *) egetenv (XSTRING (str)->data); ! 977: if (!val) ! 978: return Qnil; ! 979: return build_string (val); ! 980: } ! 981: #endif MAINTAIN_ENVIRONMENT ! 982: ! 983: void ! 984: syms_of_editfns () ! 985: { ! 986: defsubr (&Schar_equal); ! 987: defsubr (&Sgoto_char); ! 988: defsubr (&Sstring_to_char); ! 989: defsubr (&Schar_to_string); ! 990: defsubr (&Sbuffer_substring); ! 991: defsubr (&Sbuffer_string); ! 992: ! 993: defsubr (&Spoint_marker); ! 994: defsubr (&Smark_marker); ! 995: defsubr (&Spoint); ! 996: defsubr (&Sregion_beginning); ! 997: defsubr (&Sregion_end); ! 998: /* defsubr (&Smark); */ ! 999: /* defsubr (&Sset_mark); */ ! 1000: defsubr (&Ssave_excursion); ! 1001: ! 1002: defsubr (&Sbufsize); ! 1003: defsubr (&Spoint_max); ! 1004: defsubr (&Spoint_min); ! 1005: defsubr (&Spoint_min_marker); ! 1006: defsubr (&Spoint_max_marker); ! 1007: ! 1008: defsubr (&Sbobp); ! 1009: defsubr (&Seobp); ! 1010: defsubr (&Sbolp); ! 1011: defsubr (&Seolp); ! 1012: defsubr (&Sfollchar); ! 1013: defsubr (&Sprevchar); ! 1014: defsubr (&Schar_after); ! 1015: defsubr (&Sinsert); ! 1016: defsubr (&Sinsert_before_markers); ! 1017: defsubr (&Sinsert_char); ! 1018: ! 1019: defsubr (&Suser_login_name); ! 1020: defsubr (&Suser_real_login_name); ! 1021: defsubr (&Suser_uid); ! 1022: defsubr (&Suser_real_uid); ! 1023: defsubr (&Suser_full_name); ! 1024: defsubr (&Scurrent_time_string); ! 1025: defsubr (&Ssystem_name); ! 1026: defsubr (&Smessage); ! 1027: defsubr (&Sformat); ! 1028: #ifndef MAINTAIN_ENVIRONMENT /* in environ.c */ ! 1029: defsubr (&Sgetenv); ! 1030: #endif ! 1031: ! 1032: defsubr (&Sinsert_buffer_substring); ! 1033: defsubr (&Ssubst_char_in_region); ! 1034: defsubr (&Sdelete_region); ! 1035: defsubr (&Swiden); ! 1036: defsubr (&Snarrow_to_region); ! 1037: defsubr (&Ssave_restriction); ! 1038: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.