![[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.