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