![[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] / 43BSD / contrib / emacs / src|
Return to editfns.c CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / src |
1.1 ! root 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: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.