(Fkill_buffer, Fkill_all_local_variables):
[bpt/emacs.git] / src / editfns.c
CommitLineData
35692fe0 1/* Lisp functions pertaining to editing.
9772455e 2 Copyright (C) 1985, 1986, 1987, 1989, 1993 Free Software Foundation, Inc.
35692fe0
JB
3
4This file is part of GNU Emacs.
5
6GNU Emacs is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
8the Free Software Foundation; either version 1, or (at your option)
9any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs; see the file COPYING. If not, write to
18the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19
20
738429d1
JB
21#include <sys/types.h>
22
18160b98 23#include <config.h>
bfb61299
JB
24
25#ifdef VMS
956ace37 26#include "vms-pwd.h"
bfb61299 27#else
35692fe0 28#include <pwd.h>
bfb61299
JB
29#endif
30
35692fe0 31#include "lisp.h"
74d6d8c5 32#include "intervals.h"
35692fe0
JB
33#include "buffer.h"
34#include "window.h"
35
956ace37 36#include "systime.h"
35692fe0
JB
37
38#define min(a, b) ((a) < (b) ? (a) : (b))
39#define max(a, b) ((a) > (b) ? (a) : (b))
40
41/* Some static data, and a function to initialize it for each run */
42
43Lisp_Object Vsystem_name;
44Lisp_Object Vuser_real_name; /* login name of current user ID */
45Lisp_Object Vuser_full_name; /* full name of current user */
2c9ae24e 46Lisp_Object Vuser_name; /* user name from LOGNAME or USER */
35692fe0
JB
47
48void
49init_editfns ()
50{
52b14ac0 51 char *user_name;
35692fe0
JB
52 register unsigned char *p, *q, *r;
53 struct passwd *pw; /* password entry for the current user */
54 extern char *index ();
55 Lisp_Object tem;
56
57 /* Set up system_name even when dumping. */
58
59 Vsystem_name = build_string (get_system_name ());
60 p = XSTRING (Vsystem_name)->data;
61 while (*p)
62 {
63 if (*p == ' ' || *p == '\t')
64 *p = '-';
65 p++;
66 }
67
68#ifndef CANNOT_DUMP
69 /* Don't bother with this on initial start when just dumping out */
70 if (!initialized)
71 return;
72#endif /* not CANNOT_DUMP */
73
74 pw = (struct passwd *) getpwuid (getuid ());
75 Vuser_real_name = build_string (pw ? pw->pw_name : "unknown");
76
52b14ac0
JB
77 /* Get the effective user name, by consulting environment variables,
78 or the effective uid if those are unset. */
2c9ae24e 79 user_name = (char *) getenv ("LOGNAME");
35692fe0 80 if (!user_name)
2c9ae24e 81 user_name = (char *) getenv ("USER");
52b14ac0
JB
82 if (!user_name)
83 {
84 pw = (struct passwd *) getpwuid (geteuid ());
85 user_name = (char *) (pw ? pw->pw_name : "unknown");
86 }
87 Vuser_name = build_string (user_name);
35692fe0 88
52b14ac0
JB
89 /* If the user name claimed in the environment vars differs from
90 the real uid, use the claimed name to find the full name. */
35692fe0 91 tem = Fstring_equal (Vuser_name, Vuser_real_name);
56a98455 92 if (NILP (tem))
52b14ac0 93 pw = (struct passwd *) getpwnam (XSTRING (Vuser_name)->data);
35692fe0
JB
94
95 p = (unsigned char *) (pw ? USER_FULL_NAME : "unknown");
96 q = (unsigned char *) index (p, ',');
97 Vuser_full_name = make_string (p, q ? q - p : strlen (p));
98
99#ifdef AMPERSAND_FULL_NAME
100 p = XSTRING (Vuser_full_name)->data;
101 q = (char *) index (p, '&');
102 /* Substitute the login name for the &, upcasing the first character. */
103 if (q)
104 {
105 r = (char *) alloca (strlen (p) + XSTRING (Vuser_name)->size + 1);
106 bcopy (p, r, q - p);
107 r[q - p] = 0;
52b14ac0 108 strcat (r, XSTRING (Vuser_name)->data);
35692fe0
JB
109 r[q - p] = UPCASE (r[q - p]);
110 strcat (r, q + 1);
111 Vuser_full_name = build_string (r);
112 }
113#endif /* AMPERSAND_FULL_NAME */
114}
115\f
116DEFUN ("char-to-string", Fchar_to_string, Schar_to_string, 1, 1, 0,
117 "Convert arg CHAR to a one-character string containing that character.")
118 (n)
119 Lisp_Object n;
120{
121 char c;
122 CHECK_NUMBER (n, 0);
123
124 c = XINT (n);
125 return make_string (&c, 1);
126}
127
128DEFUN ("string-to-char", Fstring_to_char, Sstring_to_char, 1, 1, 0,
129 "Convert arg STRING to a character, the first character of that string.")
130 (str)
131 register Lisp_Object str;
132{
133 register Lisp_Object val;
134 register struct Lisp_String *p;
135 CHECK_STRING (str, 0);
136
137 p = XSTRING (str);
138 if (p->size)
139 XFASTINT (val) = ((unsigned char *) p->data)[0];
140 else
141 XFASTINT (val) = 0;
142 return val;
143}
144\f
145static Lisp_Object
146buildmark (val)
147 int val;
148{
149 register Lisp_Object mark;
150 mark = Fmake_marker ();
151 Fset_marker (mark, make_number (val), Qnil);
152 return mark;
153}
154
155DEFUN ("point", Fpoint, Spoint, 0, 0, 0,
156 "Return value of point, as an integer.\n\
157Beginning of buffer is position (point-min)")
158 ()
159{
160 Lisp_Object temp;
161 XFASTINT (temp) = point;
162 return temp;
163}
164
165DEFUN ("point-marker", Fpoint_marker, Spoint_marker, 0, 0, 0,
166 "Return value of point, as a marker object.")
167 ()
168{
169 return buildmark (point);
170}
171
172int
173clip_to_bounds (lower, num, upper)
174 int lower, num, upper;
175{
176 if (num < lower)
177 return lower;
178 else if (num > upper)
179 return upper;
180 else
181 return num;
182}
183
184DEFUN ("goto-char", Fgoto_char, Sgoto_char, 1, 1, "NGoto char: ",
185 "Set point to POSITION, a number or marker.\n\
186Beginning of buffer is position (point-min), end is (point-max).")
187 (n)
188 register Lisp_Object n;
189{
190 CHECK_NUMBER_COERCE_MARKER (n, 0);
191
192 SET_PT (clip_to_bounds (BEGV, XINT (n), ZV));
193 return n;
194}
195
196static Lisp_Object
197region_limit (beginningp)
198 int beginningp;
199{
646d9d18 200 extern Lisp_Object Vmark_even_if_inactive; /* Defined in callint.c. */
35692fe0 201 register Lisp_Object m;
c9dd14e1
RM
202 if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive)
203 && NILP (current_buffer->mark_active))
204 Fsignal (Qmark_inactive, Qnil);
35692fe0 205 m = Fmarker_position (current_buffer->mark);
56a98455 206 if (NILP (m)) error ("There is no region now");
35692fe0
JB
207 if ((point < XFASTINT (m)) == beginningp)
208 return (make_number (point));
209 else
210 return (m);
211}
212
213DEFUN ("region-beginning", Fregion_beginning, Sregion_beginning, 0, 0, 0,
214 "Return position of beginning of region, as an integer.")
215 ()
216{
217 return (region_limit (1));
218}
219
220DEFUN ("region-end", Fregion_end, Sregion_end, 0, 0, 0,
221 "Return position of end of region, as an integer.")
222 ()
223{
224 return (region_limit (0));
225}
226
227#if 0 /* now in lisp code */
228DEFUN ("mark", Fmark, Smark, 0, 0, 0,
229 "Return this buffer's mark value as integer, or nil if no mark.\n\
230If you are using this in an editing command, you are most likely making\n\
231a mistake; see the documentation of `set-mark'.")
232 ()
233{
234 return Fmarker_position (current_buffer->mark);
235}
236#endif /* commented out code */
237
238DEFUN ("mark-marker", Fmark_marker, Smark_marker, 0, 0, 0,
239 "Return this buffer's mark, as a marker object.\n\
240Watch out! Moving this marker changes the mark position.\n\
241If you set the marker not to point anywhere, the buffer will have no mark.")
242 ()
243{
244 return current_buffer->mark;
245}
246
247#if 0 /* this is now in lisp code */
248DEFUN ("set-mark", Fset_mark, Sset_mark, 1, 1, 0,
249 "Set this buffer's mark to POS. Don't use this function!\n\
250That is to say, don't use this function unless you want\n\
251the user to see that the mark has moved, and you want the previous\n\
252mark position to be lost.\n\
253\n\
254Normally, when a new mark is set, the old one should go on the stack.\n\
255This is why most applications should use push-mark, not set-mark.\n\
256\n\
257Novice programmers often try to use the mark for the wrong purposes.\n\
258The mark saves a location for the user's convenience.\n\
259Most editing commands should not alter the mark.\n\
260To remember a location for internal use in the Lisp program,\n\
261store it in a Lisp variable. Example:\n\
262\n\
263 (let ((beg (point))) (forward-line 1) (delete-region beg (point))).")
264 (pos)
265 Lisp_Object pos;
266{
56a98455 267 if (NILP (pos))
35692fe0
JB
268 {
269 current_buffer->mark = Qnil;
270 return Qnil;
271 }
272 CHECK_NUMBER_COERCE_MARKER (pos, 0);
273
56a98455 274 if (NILP (current_buffer->mark))
35692fe0
JB
275 current_buffer->mark = Fmake_marker ();
276
277 Fset_marker (current_buffer->mark, pos, Qnil);
278 return pos;
279}
280#endif /* commented-out code */
281
282Lisp_Object
283save_excursion_save ()
284{
0e2c9c70
JB
285 register int visible = (XBUFFER (XWINDOW (selected_window)->buffer)
286 == current_buffer);
35692fe0
JB
287
288 return Fcons (Fpoint_marker (),
0e2c9c70 289 Fcons (Fcopy_marker (current_buffer->mark),
9772455e
RS
290 Fcons (visible ? Qt : Qnil,
291 current_buffer->mark_active)));
35692fe0
JB
292}
293
294Lisp_Object
295save_excursion_restore (info)
296 register Lisp_Object info;
297{
9772455e 298 register Lisp_Object tem, tem1;
35692fe0
JB
299
300 tem = Fmarker_buffer (Fcar (info));
301 /* If buffer being returned to is now deleted, avoid error */
302 /* Otherwise could get error here while unwinding to top level
303 and crash */
304 /* In that case, Fmarker_buffer returns nil now. */
56a98455 305 if (NILP (tem))
35692fe0
JB
306 return Qnil;
307 Fset_buffer (tem);
308 tem = Fcar (info);
309 Fgoto_char (tem);
310 unchain_marker (tem);
311 tem = Fcar (Fcdr (info));
312 Fset_marker (current_buffer->mark, tem, Fcurrent_buffer ());
313 unchain_marker (tem);
314 tem = Fcdr (Fcdr (info));
ef580991
RS
315#if 0 /* We used to make the current buffer visible in the selected window
316 if that was true previously. That avoids some anomalies.
317 But it creates others, and it wasn't documented, and it is simpler
318 and cleaner never to alter the window/buffer connections. */
9772455e
RS
319 tem1 = Fcar (tem);
320 if (!NILP (tem1)
0e2c9c70 321 && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer))
35692fe0 322 Fswitch_to_buffer (Fcurrent_buffer (), Qnil);
ef580991 323#endif /* 0 */
9772455e
RS
324
325 tem1 = current_buffer->mark_active;
326 current_buffer->mark_active = Fcdr (tem);
327 if (! NILP (current_buffer->mark_active))
328 call1 (Vrun_hooks, intern ("activate-mark-hook"));
329 else if (! NILP (tem1))
330 call1 (Vrun_hooks, intern ("deactivate-mark-hook"));
35692fe0
JB
331 return Qnil;
332}
333
334DEFUN ("save-excursion", Fsave_excursion, Ssave_excursion, 0, UNEVALLED, 0,
335 "Save point, mark, and current buffer; execute BODY; restore those things.\n\
336Executes BODY just like `progn'.\n\
337The values of point, mark and the current buffer are restored\n\
9772455e
RS
338even in case of abnormal exit (throw or error).\n\
339The state of activation of the mark is also restored.")
35692fe0
JB
340 (args)
341 Lisp_Object args;
342{
343 register Lisp_Object val;
344 int count = specpdl_ptr - specpdl;
345
346 record_unwind_protect (save_excursion_restore, save_excursion_save ());
347
348 val = Fprogn (args);
349 return unbind_to (count, val);
350}
351\f
352DEFUN ("buffer-size", Fbufsize, Sbufsize, 0, 0, 0,
353 "Return the number of characters in the current buffer.")
354 ()
355{
356 Lisp_Object temp;
357 XFASTINT (temp) = Z - BEG;
358 return temp;
359}
360
361DEFUN ("point-min", Fpoint_min, Spoint_min, 0, 0, 0,
362 "Return the minimum permissible value of point in the current buffer.\n\
4c390850 363This is 1, unless narrowing (a buffer restriction) is in effect.")
35692fe0
JB
364 ()
365{
366 Lisp_Object temp;
367 XFASTINT (temp) = BEGV;
368 return temp;
369}
370
371DEFUN ("point-min-marker", Fpoint_min_marker, Spoint_min_marker, 0, 0, 0,
372 "Return a marker to the minimum permissible value of point in this buffer.\n\
4c390850 373This is the beginning, unless narrowing (a buffer restriction) is in effect.")
35692fe0
JB
374 ()
375{
376 return buildmark (BEGV);
377}
378
379DEFUN ("point-max", Fpoint_max, Spoint_max, 0, 0, 0,
380 "Return the maximum permissible value of point in the current buffer.\n\
4c390850
RS
381This is (1+ (buffer-size)), unless narrowing (a buffer restriction)\n\
382is in effect, in which case it is less.")
35692fe0
JB
383 ()
384{
385 Lisp_Object temp;
386 XFASTINT (temp) = ZV;
387 return temp;
388}
389
390DEFUN ("point-max-marker", Fpoint_max_marker, Spoint_max_marker, 0, 0, 0,
391 "Return a marker to the maximum permissible value of point in this buffer.\n\
4c390850
RS
392This is (1+ (buffer-size)), unless narrowing (a buffer restriction)\n\
393is in effect, in which case it is less.")
35692fe0
JB
394 ()
395{
396 return buildmark (ZV);
397}
398
850a8179
JB
399DEFUN ("following-char", Ffollowing_char, Sfollowing_char, 0, 0, 0,
400 "Return the character following point, as a number.\n\
401At the end of the buffer or accessible region, return 0.")
35692fe0
JB
402 ()
403{
404 Lisp_Object temp;
850a8179
JB
405 if (point >= ZV)
406 XFASTINT (temp) = 0;
407 else
408 XFASTINT (temp) = FETCH_CHAR (point);
35692fe0
JB
409 return temp;
410}
411
850a8179
JB
412DEFUN ("preceding-char", Fprevious_char, Sprevious_char, 0, 0, 0,
413 "Return the character preceding point, as a number.\n\
414At the beginning of the buffer or accessible region, return 0.")
35692fe0
JB
415 ()
416{
417 Lisp_Object temp;
418 if (point <= BEGV)
419 XFASTINT (temp) = 0;
420 else
421 XFASTINT (temp) = FETCH_CHAR (point - 1);
422 return temp;
423}
424
425DEFUN ("bobp", Fbobp, Sbobp, 0, 0, 0,
426 "Return T if point is at the beginning of the buffer.\n\
427If the buffer is narrowed, this means the beginning of the narrowed part.")
428 ()
429{
430 if (point == BEGV)
431 return Qt;
432 return Qnil;
433}
434
435DEFUN ("eobp", Feobp, Seobp, 0, 0, 0,
436 "Return T if point is at the end of the buffer.\n\
437If the buffer is narrowed, this means the end of the narrowed part.")
438 ()
439{
440 if (point == ZV)
441 return Qt;
442 return Qnil;
443}
444
445DEFUN ("bolp", Fbolp, Sbolp, 0, 0, 0,
446 "Return T if point is at the beginning of a line.")
447 ()
448{
449 if (point == BEGV || FETCH_CHAR (point - 1) == '\n')
450 return Qt;
451 return Qnil;
452}
453
454DEFUN ("eolp", Feolp, Seolp, 0, 0, 0,
455 "Return T if point is at the end of a line.\n\
456`End of a line' includes point being at the end of the buffer.")
457 ()
458{
459 if (point == ZV || FETCH_CHAR (point) == '\n')
460 return Qt;
461 return Qnil;
462}
463
464DEFUN ("char-after", Fchar_after, Schar_after, 1, 1, 0,
465 "Return character in current buffer at position POS.\n\
466POS is an integer or a buffer pointer.\n\
467If POS is out of range, the value is nil.")
468 (pos)
469 Lisp_Object pos;
470{
471 register Lisp_Object val;
472 register int n;
473
474 CHECK_NUMBER_COERCE_MARKER (pos, 0);
475
476 n = XINT (pos);
477 if (n < BEGV || n >= ZV) return Qnil;
478
479 XFASTINT (val) = FETCH_CHAR (n);
480 return val;
481}
482\f
483DEFUN ("user-login-name", Fuser_login_name, Suser_login_name, 0, 0, 0,
484 "Return the name under which the user logged in, as a string.\n\
485This is based on the effective uid, not the real uid.\n\
2c9ae24e 486Also, if the environment variable LOGNAME or USER is set,\n\
35692fe0
JB
487that determines the value of this function.")
488 ()
489{
490 return Vuser_name;
491}
492
493DEFUN ("user-real-login-name", Fuser_real_login_name, Suser_real_login_name,
494 0, 0, 0,
495 "Return the name of the user's real uid, as a string.\n\
b1da234a
KH
496This ignores the environment variables LOGNAME and USER, so it differs from
497`user-login-name' when running under `su'.")
35692fe0
JB
498 ()
499{
500 return Vuser_real_name;
501}
502
503DEFUN ("user-uid", Fuser_uid, Suser_uid, 0, 0, 0,
504 "Return the effective uid of Emacs, as an integer.")
505 ()
506{
507 return make_number (geteuid ());
508}
509
510DEFUN ("user-real-uid", Fuser_real_uid, Suser_real_uid, 0, 0, 0,
511 "Return the real uid of Emacs, as an integer.")
512 ()
513{
514 return make_number (getuid ());
515}
516
517DEFUN ("user-full-name", Fuser_full_name, Suser_full_name, 0, 0, 0,
518 "Return the full name of the user logged in, as a string.")
519 ()
520{
521 return Vuser_full_name;
522}
523
524DEFUN ("system-name", Fsystem_name, Ssystem_name, 0, 0, 0,
525 "Return the name of the machine you are running on, as a string.")
526 ()
527{
528 return Vsystem_name;
529}
530
7fd233b3
RS
531DEFUN ("emacs-pid", Femacs_pid, Semacs_pid, 0, 0, 0,
532 "Return the process ID of Emacs, as an integer.")
533 ()
534{
535 return make_number (getpid ());
536}
537
d940e0e4 538DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0,
956ace37
JB
539 "Return the current time, as the number of seconds since 12:00 AM January 1970.\n\
540The time is returned as a list of three integers. The first has the\n\
541most significant 16 bits of the seconds, while the second has the\n\
542least significant 16 bits. The third integer gives the microsecond\n\
543count.\n\
544\n\
545The microsecond count is zero on systems that do not provide\n\
546resolution finer than a second.")
d940e0e4
JB
547 ()
548{
956ace37
JB
549 EMACS_TIME t;
550 Lisp_Object result[3];
551
552 EMACS_GET_TIME (t);
553 XSET (result[0], Lisp_Int, (EMACS_SECS (t) >> 16) & 0xffff);
554 XSET (result[1], Lisp_Int, (EMACS_SECS (t) >> 0) & 0xffff);
555 XSET (result[2], Lisp_Int, EMACS_USECS (t));
556
557 return Flist (3, result);
d940e0e4
JB
558}
559\f
560
e3120ab5
JB
561static int
562lisp_time_argument (specified_time, result)
563 Lisp_Object specified_time;
564 time_t *result;
565{
566 if (NILP (specified_time))
567 return time (result) != -1;
568 else
569 {
570 Lisp_Object high, low;
571 high = Fcar (specified_time);
572 CHECK_NUMBER (high, 0);
573 low = Fcdr (specified_time);
574 if (XTYPE (low) == Lisp_Cons)
575 low = Fcar (low);
576 CHECK_NUMBER (low, 0);
577 *result = (XINT (high) << 16) + (XINT (low) & 0xffff);
578 return *result >> 16 == XINT (high);
579 }
580}
581
2148f2b4 582DEFUN ("current-time-string", Fcurrent_time_string, Scurrent_time_string, 0, 1, 0,
35692fe0 583 "Return the current time, as a human-readable string.\n\
2148f2b4
RS
584Programs can use this function to decode a time,\n\
585since the number of columns in each field is fixed.\n\
586The format is `Sun Sep 16 01:03:52 1973'.\n\
587If an argument is given, it specifies a time to format\n\
588instead of the current time. The argument should have the form:\n\
589 (HIGH . LOW)\n\
590or the form:\n\
591 (HIGH LOW . IGNORED).\n\
592Thus, you can use times obtained from `current-time'\n\
593and from `file-attributes'.")
594 (specified_time)
595 Lisp_Object specified_time;
596{
e3120ab5 597 time_t value;
35692fe0 598 char buf[30];
2148f2b4
RS
599 register char *tem;
600
e3120ab5
JB
601 if (! lisp_time_argument (specified_time, &value))
602 value = -1;
2148f2b4 603 tem = (char *) ctime (&value);
35692fe0
JB
604
605 strncpy (buf, tem, 24);
606 buf[24] = 0;
607
608 return build_string (buf);
609}
c2662aea 610
e3120ab5
JB
611#define TM_YEAR_ORIGIN 1900
612
613/* Yield A - B, measured in seconds. */
614static long
8e718b4e 615difftm (a, b)
e3120ab5
JB
616 struct tm *a, *b;
617{
618 int ay = a->tm_year + (TM_YEAR_ORIGIN - 1);
619 int by = b->tm_year + (TM_YEAR_ORIGIN - 1);
8e718b4e
KH
620 /* Some compilers can't handle this as a single return statement. */
621 int days = (
622 /* difference in day of year */
623 a->tm_yday - b->tm_yday
624 /* + intervening leap days */
625 + ((ay >> 2) - (by >> 2))
626 - (ay/100 - by/100)
627 + ((ay/100 >> 2) - (by/100 >> 2))
628 /* + difference in years * 365 */
629 + (long)(ay-by) * 365
630 );
631 return (60*(60*(24*days + (a->tm_hour - b->tm_hour))
632 + (a->tm_min - b->tm_min))
633 + (a->tm_sec - b->tm_sec));
e3120ab5
JB
634}
635
636DEFUN ("current-time-zone", Fcurrent_time_zone, Scurrent_time_zone, 0, 1, 0,
637 "Return the offset and name for the local time zone.\n\
638This returns a list of the form (OFFSET NAME).\n\
639OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).\n\
640 A negative value means west of Greenwich.\n\
641NAME is a string giving the name of the time zone.\n\
642If an argument is given, it specifies when the time zone offset is determined\n\
643instead of using the current time. The argument should have the form:\n\
644 (HIGH . LOW)\n\
645or the form:\n\
646 (HIGH LOW . IGNORED).\n\
647Thus, you can use times obtained from `current-time'\n\
648and from `file-attributes'.\n\
773c1fd3
JB
649\n\
650Some operating systems cannot provide all this information to Emacs;\n\
2d88f747 651in this case, `current-time-zone' returns a list containing nil for\n\
773c1fd3 652the data it can't find.")
e3120ab5
JB
653 (specified_time)
654 Lisp_Object specified_time;
c2662aea 655{
e3120ab5
JB
656 time_t value;
657 struct tm *t;
c2662aea 658
e3120ab5 659 if (lisp_time_argument (specified_time, &value)
2d88f747 660 && (t = gmtime (&value)) != 0)
e3120ab5 661 {
2d88f747 662 struct tm gmt;
e3120ab5
JB
663 long offset;
664 char *s, buf[6];
2d88f747
RS
665
666 gmt = *t; /* Make a copy, in case localtime modifies *t. */
667 t = localtime (&value);
668 offset = difftm (t, &gmt);
e3120ab5
JB
669 s = 0;
670#ifdef HAVE_TM_ZONE
671 if (t->tm_zone)
672 s = t->tm_zone;
a7971c39
RS
673#else /* not HAVE_TM_ZONE */
674#ifdef HAVE_TZNAME
675 if (t->tm_isdst == 0 || t->tm_isdst == 1)
676 s = tzname[t->tm_isdst];
c2662aea 677#endif
a7971c39 678#endif /* not HAVE_TM_ZONE */
e3120ab5
JB
679 if (!s)
680 {
681 /* No local time zone name is available; use "+-NNNN" instead. */
00fc94d0 682 int am = (offset < 0 ? -offset : offset) / 60;
e3120ab5
JB
683 sprintf (buf, "%c%02d%02d", (offset < 0 ? '-' : '+'), am/60, am%60);
684 s = buf;
685 }
686 return Fcons (make_number (offset), Fcons (build_string (s), Qnil));
687 }
688 else
689 return Fmake_list (2, Qnil);
c2662aea
JB
690}
691
35692fe0
JB
692\f
693void
694insert1 (arg)
695 Lisp_Object arg;
696{
697 Finsert (1, &arg);
698}
699
52b14ac0
JB
700
701/* Callers passing one argument to Finsert need not gcpro the
702 argument "array", since the only element of the array will
703 not be used after calling insert or insert_from_string, so
704 we don't care if it gets trashed. */
705
35692fe0
JB
706DEFUN ("insert", Finsert, Sinsert, 0, MANY, 0,
707 "Insert the arguments, either strings or characters, at point.\n\
708Point moves forward so that it ends up after the inserted text.\n\
709Any other markers at the point of insertion remain before the text.")
710 (nargs, args)
711 int nargs;
712 register Lisp_Object *args;
713{
714 register int argnum;
715 register Lisp_Object tem;
716 char str[1];
35692fe0
JB
717
718 for (argnum = 0; argnum < nargs; argnum++)
719 {
720 tem = args[argnum];
721 retry:
722 if (XTYPE (tem) == Lisp_Int)
723 {
724 str[0] = XINT (tem);
725 insert (str, 1);
726 }
727 else if (XTYPE (tem) == Lisp_String)
728 {
be91036a
RS
729 insert_from_string (tem, 0, XSTRING (tem)->size, 0);
730 }
731 else
732 {
733 tem = wrong_type_argument (Qchar_or_string_p, tem);
734 goto retry;
735 }
736 }
737
738 return Qnil;
739}
740
741DEFUN ("insert-and-inherit", Finsert_and_inherit, Sinsert_and_inherit,
742 0, MANY, 0,
743 "Insert the arguments at point, inheriting properties from adjoining text.\n\
744Point moves forward so that it ends up after the inserted text.\n\
745Any other markers at the point of insertion remain before the text.")
746 (nargs, args)
747 int nargs;
748 register Lisp_Object *args;
749{
750 register int argnum;
751 register Lisp_Object tem;
752 char str[1];
753
754 for (argnum = 0; argnum < nargs; argnum++)
755 {
756 tem = args[argnum];
757 retry:
758 if (XTYPE (tem) == Lisp_Int)
759 {
760 str[0] = XINT (tem);
761 insert (str, 1);
762 }
763 else if (XTYPE (tem) == Lisp_String)
764 {
765 insert_from_string (tem, 0, XSTRING (tem)->size, 1);
35692fe0
JB
766 }
767 else
768 {
769 tem = wrong_type_argument (Qchar_or_string_p, tem);
770 goto retry;
771 }
772 }
773
35692fe0
JB
774 return Qnil;
775}
776
777DEFUN ("insert-before-markers", Finsert_before_markers, Sinsert_before_markers, 0, MANY, 0,
778 "Insert strings or characters at point, relocating markers after the text.\n\
779Point moves forward so that it ends up after the inserted text.\n\
780Any other markers at the point of insertion also end up after the text.")
781 (nargs, args)
782 int nargs;
783 register Lisp_Object *args;
784{
785 register int argnum;
786 register Lisp_Object tem;
787 char str[1];
35692fe0
JB
788
789 for (argnum = 0; argnum < nargs; argnum++)
790 {
791 tem = args[argnum];
792 retry:
793 if (XTYPE (tem) == Lisp_Int)
794 {
795 str[0] = XINT (tem);
796 insert_before_markers (str, 1);
797 }
798 else if (XTYPE (tem) == Lisp_String)
799 {
be91036a
RS
800 insert_from_string_before_markers (tem, 0, XSTRING (tem)->size, 0);
801 }
802 else
803 {
804 tem = wrong_type_argument (Qchar_or_string_p, tem);
805 goto retry;
806 }
807 }
808
809 return Qnil;
810}
811
812DEFUN ("insert-before-markers-and-inherit",
813 Finsert_and_inherit_before_markers, Sinsert_and_inherit_before_markers,
814 0, MANY, 0,
815 "Insert text at point, relocating markers and inheriting properties.\n\
816Point moves forward so that it ends up after the inserted text.\n\
817Any other markers at the point of insertion also end up after the text.")
818 (nargs, args)
819 int nargs;
820 register Lisp_Object *args;
821{
822 register int argnum;
823 register Lisp_Object tem;
824 char str[1];
825
826 for (argnum = 0; argnum < nargs; argnum++)
827 {
828 tem = args[argnum];
829 retry:
830 if (XTYPE (tem) == Lisp_Int)
831 {
832 str[0] = XINT (tem);
833 insert_before_markers (str, 1);
834 }
835 else if (XTYPE (tem) == Lisp_String)
836 {
837 insert_from_string_before_markers (tem, 0, XSTRING (tem)->size, 1);
35692fe0
JB
838 }
839 else
840 {
841 tem = wrong_type_argument (Qchar_or_string_p, tem);
842 goto retry;
843 }
844 }
845
35692fe0
JB
846 return Qnil;
847}
848\f
849DEFUN ("insert-char", Finsert_char, Sinsert_char, 2, 2, 0,
850 "Insert COUNT (second arg) copies of CHAR (first arg).\n\
851Point and all markers are affected as in the function `insert'.\n\
852Both arguments are required.")
853 (chr, count)
854 Lisp_Object chr, count;
855{
856 register unsigned char *string;
857 register int strlen;
858 register int i, n;
859
860 CHECK_NUMBER (chr, 0);
861 CHECK_NUMBER (count, 1);
862
863 n = XINT (count);
864 if (n <= 0)
865 return Qnil;
866 strlen = min (n, 256);
867 string = (unsigned char *) alloca (strlen);
868 for (i = 0; i < strlen; i++)
869 string[i] = XFASTINT (chr);
870 while (n >= strlen)
871 {
872 insert (string, strlen);
873 n -= strlen;
874 }
875 if (n > 0)
876 insert (string, n);
877 return Qnil;
878}
879
880\f
ffd56f97
JB
881/* Making strings from buffer contents. */
882
883/* Return a Lisp_String containing the text of the current buffer from
74d6d8c5 884 START to END. If text properties are in use and the current buffer
eb8c3be9 885 has properties in the range specified, the resulting string will also
74d6d8c5 886 have them.
ffd56f97
JB
887
888 We don't want to use plain old make_string here, because it calls
889 make_uninit_string, which can cause the buffer arena to be
890 compacted. make_string has no way of knowing that the data has
891 been moved, and thus copies the wrong data into the string. This
892 doesn't effect most of the other users of make_string, so it should
893 be left as is. But we should use this function when conjuring
894 buffer substrings. */
74d6d8c5 895
ffd56f97
JB
896Lisp_Object
897make_buffer_string (start, end)
898 int start, end;
899{
60b96ee7 900 Lisp_Object result, tem;
ffd56f97
JB
901
902 if (start < GPT && GPT < end)
903 move_gap (start);
904
905 result = make_uninit_string (end - start);
906 bcopy (&FETCH_CHAR (start), XSTRING (result)->data, end - start);
907
60b96ee7
RS
908 tem = Fnext_property_change (make_number (start), Qnil, make_number (end));
909
910#ifdef USE_TEXT_PROPERTIES
911 if (XINT (tem) != end)
912 copy_intervals_to_string (result, current_buffer, start, end - start);
913#endif
74d6d8c5 914
ffd56f97
JB
915 return result;
916}
35692fe0
JB
917
918DEFUN ("buffer-substring", Fbuffer_substring, Sbuffer_substring, 2, 2, 0,
919 "Return the contents of part of the current buffer as a string.\n\
920The two arguments START and END are character positions;\n\
921they can be in either order.")
922 (b, e)
923 Lisp_Object b, e;
924{
925 register int beg, end;
35692fe0
JB
926
927 validate_region (&b, &e);
928 beg = XINT (b);
929 end = XINT (e);
930
ffd56f97 931 return make_buffer_string (beg, end);
35692fe0
JB
932}
933
934DEFUN ("buffer-string", Fbuffer_string, Sbuffer_string, 0, 0, 0,
935 "Return the contents of the current buffer as a string.")
936 ()
937{
ffd56f97 938 return make_buffer_string (BEGV, ZV);
35692fe0
JB
939}
940
941DEFUN ("insert-buffer-substring", Finsert_buffer_substring, Sinsert_buffer_substring,
942 1, 3, 0,
83ea6fc2 943 "Insert before point a substring of the contents of buffer BUFFER.\n\
35692fe0
JB
944BUFFER may be a buffer or a buffer name.\n\
945Arguments START and END are character numbers specifying the substring.\n\
946They default to the beginning and the end of BUFFER.")
947 (buf, b, e)
948 Lisp_Object buf, b, e;
949{
74d6d8c5 950 register int beg, end, temp, len, opoint, start;
35692fe0 951 register struct buffer *bp;
3fff2dfa 952 Lisp_Object buffer;
35692fe0 953
3fff2dfa
RS
954 buffer = Fget_buffer (buf);
955 if (NILP (buffer))
956 nsberror (buf);
957 bp = XBUFFER (buffer);
35692fe0 958
56a98455 959 if (NILP (b))
35692fe0
JB
960 beg = BUF_BEGV (bp);
961 else
962 {
963 CHECK_NUMBER_COERCE_MARKER (b, 0);
964 beg = XINT (b);
965 }
56a98455 966 if (NILP (e))
35692fe0
JB
967 end = BUF_ZV (bp);
968 else
969 {
970 CHECK_NUMBER_COERCE_MARKER (e, 1);
971 end = XINT (e);
972 }
973
974 if (beg > end)
74d6d8c5 975 temp = beg, beg = end, end = temp;
35692fe0
JB
976
977 /* Move the gap or create enough gap in the current buffer. */
978
979 if (point != GPT)
980 move_gap (point);
981 if (GAP_SIZE < end - beg)
982 make_gap (end - beg - GAP_SIZE);
983
74d6d8c5
JA
984 len = end - beg;
985 start = beg;
986 opoint = point;
987
35692fe0
JB
988 if (!(BUF_BEGV (bp) <= beg
989 && beg <= end
990 && end <= BUF_ZV (bp)))
991 args_out_of_range (b, e);
992
993 /* Now the actual insertion will not do any gap motion,
994 so it matters not if BUF is the current buffer. */
995 if (beg < BUF_GPT (bp))
996 {
997 insert (BUF_CHAR_ADDRESS (bp, beg), min (end, BUF_GPT (bp)) - beg);
998 beg = min (end, BUF_GPT (bp));
999 }
1000 if (beg < end)
1001 insert (BUF_CHAR_ADDRESS (bp, beg), end - beg);
1002
74d6d8c5
JA
1003 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
1004 graft_intervals_into_buffer (copy_intervals (bp->intervals, start, len),
60b96ee7 1005 opoint, len, current_buffer, 0);
74d6d8c5 1006
35692fe0
JB
1007 return Qnil;
1008}
e9cf2084
RS
1009
1010DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings, Scompare_buffer_substrings,
1011 6, 6, 0,
1012 "Compare two substrings of two buffers; return result as number.\n\
1013the value is -N if first string is less after N-1 chars,\n\
1014+N if first string is greater after N-1 chars, or 0 if strings match.\n\
1015Each substring is represented as three arguments: BUFFER, START and END.\n\
1016That makes six args in all, three for each substring.\n\n\
1017The value of `case-fold-search' in the current buffer\n\
1018determines whether case is significant or ignored.")
1019 (buffer1, start1, end1, buffer2, start2, end2)
1020 Lisp_Object buffer1, start1, end1, buffer2, start2, end2;
1021{
1022 register int begp1, endp1, begp2, endp2, temp, len1, len2, length, i;
1023 register struct buffer *bp1, *bp2;
1024 register unsigned char *trt
1025 = (!NILP (current_buffer->case_fold_search)
1026 ? XSTRING (current_buffer->case_canon_table)->data : 0);
1027
1028 /* Find the first buffer and its substring. */
1029
1030 if (NILP (buffer1))
1031 bp1 = current_buffer;
1032 else
1033 {
3fff2dfa
RS
1034 Lisp_Object buf1;
1035 buf1 = Fget_buffer (buffer1);
1036 if (NILP (buf1))
1037 nsberror (buffer1);
1038 bp1 = XBUFFER (buf1);
e9cf2084
RS
1039 }
1040
1041 if (NILP (start1))
1042 begp1 = BUF_BEGV (bp1);
1043 else
1044 {
1045 CHECK_NUMBER_COERCE_MARKER (start1, 1);
1046 begp1 = XINT (start1);
1047 }
1048 if (NILP (end1))
1049 endp1 = BUF_ZV (bp1);
1050 else
1051 {
1052 CHECK_NUMBER_COERCE_MARKER (end1, 2);
1053 endp1 = XINT (end1);
1054 }
1055
1056 if (begp1 > endp1)
1057 temp = begp1, begp1 = endp1, endp1 = temp;
1058
1059 if (!(BUF_BEGV (bp1) <= begp1
1060 && begp1 <= endp1
1061 && endp1 <= BUF_ZV (bp1)))
1062 args_out_of_range (start1, end1);
1063
1064 /* Likewise for second substring. */
1065
1066 if (NILP (buffer2))
1067 bp2 = current_buffer;
1068 else
1069 {
3fff2dfa
RS
1070 Lisp_Object buf2;
1071 buf2 = Fget_buffer (buffer2);
1072 if (NILP (buf2))
1073 nsberror (buffer2);
e9cf2084
RS
1074 bp2 = XBUFFER (buffer2);
1075 }
1076
1077 if (NILP (start2))
1078 begp2 = BUF_BEGV (bp2);
1079 else
1080 {
1081 CHECK_NUMBER_COERCE_MARKER (start2, 4);
1082 begp2 = XINT (start2);
1083 }
1084 if (NILP (end2))
1085 endp2 = BUF_ZV (bp2);
1086 else
1087 {
1088 CHECK_NUMBER_COERCE_MARKER (end2, 5);
1089 endp2 = XINT (end2);
1090 }
1091
1092 if (begp2 > endp2)
1093 temp = begp2, begp2 = endp2, endp2 = temp;
1094
1095 if (!(BUF_BEGV (bp2) <= begp2
1096 && begp2 <= endp2
1097 && endp2 <= BUF_ZV (bp2)))
1098 args_out_of_range (start2, end2);
1099
1100 len1 = endp1 - begp1;
1101 len2 = endp2 - begp2;
1102 length = len1;
1103 if (len2 < length)
1104 length = len2;
1105
1106 for (i = 0; i < length; i++)
1107 {
1108 int c1 = *BUF_CHAR_ADDRESS (bp1, begp1 + i);
1109 int c2 = *BUF_CHAR_ADDRESS (bp2, begp2 + i);
1110 if (trt)
1111 {
1112 c1 = trt[c1];
1113 c2 = trt[c2];
1114 }
1115 if (c1 < c2)
1116 return make_number (- 1 - i);
1117 if (c1 > c2)
1118 return make_number (i + 1);
1119 }
1120
1121 /* The strings match as far as they go.
1122 If one is shorter, that one is less. */
1123 if (length < len1)
1124 return make_number (length + 1);
1125 else if (length < len2)
1126 return make_number (- length - 1);
1127
1128 /* Same length too => they are equal. */
1129 return make_number (0);
1130}
35692fe0
JB
1131\f
1132DEFUN ("subst-char-in-region", Fsubst_char_in_region,
1133 Ssubst_char_in_region, 4, 5, 0,
1134 "From START to END, replace FROMCHAR with TOCHAR each time it occurs.\n\
1135If optional arg NOUNDO is non-nil, don't record this change for undo\n\
1136and don't mark the buffer as really changed.")
1137 (start, end, fromchar, tochar, noundo)
1138 Lisp_Object start, end, fromchar, tochar, noundo;
1139{
1140 register int pos, stop, look;
60b96ee7 1141 int changed = 0;
35692fe0
JB
1142
1143 validate_region (&start, &end);
1144 CHECK_NUMBER (fromchar, 2);
1145 CHECK_NUMBER (tochar, 3);
1146
1147 pos = XINT (start);
1148 stop = XINT (end);
1149 look = XINT (fromchar);
1150
35692fe0
JB
1151 while (pos < stop)
1152 {
1153 if (FETCH_CHAR (pos) == look)
1154 {
60b96ee7
RS
1155 if (! changed)
1156 {
1157 modify_region (current_buffer, XINT (start), stop);
7653d030
RS
1158
1159 if (! NILP (noundo))
1160 {
1161 if (MODIFF - 1 == current_buffer->save_modified)
1162 current_buffer->save_modified++;
1163 if (MODIFF - 1 == current_buffer->auto_save_modified)
1164 current_buffer->auto_save_modified++;
1165 }
1166
1167 changed = 1;
60b96ee7
RS
1168 }
1169
56a98455 1170 if (NILP (noundo))
35692fe0
JB
1171 record_change (pos, 1);
1172 FETCH_CHAR (pos) = XINT (tochar);
35692fe0
JB
1173 }
1174 pos++;
1175 }
1176
60b96ee7
RS
1177 if (changed)
1178 signal_after_change (XINT (start),
1179 stop - XINT (start), stop - XINT (start));
1180
35692fe0
JB
1181 return Qnil;
1182}
1183
1184DEFUN ("translate-region", Ftranslate_region, Stranslate_region, 3, 3, 0,
1185 "From START to END, translate characters according to TABLE.\n\
1186TABLE is a string; the Nth character in it is the mapping\n\
1187for the character with code N. Returns the number of characters changed.")
1188 (start, end, table)
1189 Lisp_Object start;
1190 Lisp_Object end;
1191 register Lisp_Object table;
1192{
1193 register int pos, stop; /* Limits of the region. */
1194 register unsigned char *tt; /* Trans table. */
1195 register int oc; /* Old character. */
1196 register int nc; /* New character. */
1197 int cnt; /* Number of changes made. */
1198 Lisp_Object z; /* Return. */
1199 int size; /* Size of translate table. */
1200
1201 validate_region (&start, &end);
1202 CHECK_STRING (table, 2);
1203
1204 size = XSTRING (table)->size;
1205 tt = XSTRING (table)->data;
1206
1207 pos = XINT (start);
1208 stop = XINT (end);
04a759c8 1209 modify_region (current_buffer, pos, stop);
35692fe0
JB
1210
1211 cnt = 0;
1212 for (; pos < stop; ++pos)
1213 {
1214 oc = FETCH_CHAR (pos);
1215 if (oc < size)
1216 {
1217 nc = tt[oc];
1218 if (nc != oc)
1219 {
1220 record_change (pos, 1);
1221 FETCH_CHAR (pos) = nc;
1222 signal_after_change (pos, 1, 1);
1223 ++cnt;
1224 }
1225 }
1226 }
1227
1228 XFASTINT (z) = cnt;
1229 return (z);
1230}
1231
1232DEFUN ("delete-region", Fdelete_region, Sdelete_region, 2, 2, "r",
1233 "Delete the text between point and mark.\n\
1234When called from a program, expects two arguments,\n\
1235positions (integers or markers) specifying the stretch to be deleted.")
1236 (b, e)
1237 Lisp_Object b, e;
1238{
1239 validate_region (&b, &e);
1240 del_range (XINT (b), XINT (e));
1241 return Qnil;
1242}
1243\f
1244DEFUN ("widen", Fwiden, Swiden, 0, 0, "",
1245 "Remove restrictions (narrowing) from current buffer.\n\
1246This allows the buffer's full text to be seen and edited.")
1247 ()
1248{
1249 BEGV = BEG;
1250 SET_BUF_ZV (current_buffer, Z);
1251 clip_changed = 1;
52b14ac0
JB
1252 /* Changing the buffer bounds invalidates any recorded current column. */
1253 invalidate_current_column ();
35692fe0
JB
1254 return Qnil;
1255}
1256
1257DEFUN ("narrow-to-region", Fnarrow_to_region, Snarrow_to_region, 2, 2, "r",
1258 "Restrict editing in this buffer to the current region.\n\
1259The rest of the text becomes temporarily invisible and untouchable\n\
1260but is not deleted; if you save the buffer in a file, the invisible\n\
1261text is included in the file. \\[widen] makes all visible again.\n\
1262See also `save-restriction'.\n\
1263\n\
1264When calling from a program, pass two arguments; positions (integers\n\
1265or markers) bounding the text that should remain visible.")
1266 (b, e)
1267 register Lisp_Object b, e;
1268{
1269 register int i;
1270
1271 CHECK_NUMBER_COERCE_MARKER (b, 0);
1272 CHECK_NUMBER_COERCE_MARKER (e, 1);
1273
1274 if (XINT (b) > XINT (e))
1275 {
1276 i = XFASTINT (b);
1277 b = e;
1278 XFASTINT (e) = i;
1279 }
1280
1281 if (!(BEG <= XINT (b) && XINT (b) <= XINT (e) && XINT (e) <= Z))
1282 args_out_of_range (b, e);
1283
1284 BEGV = XFASTINT (b);
1285 SET_BUF_ZV (current_buffer, XFASTINT (e));
1286 if (point < XFASTINT (b))
1287 SET_PT (XFASTINT (b));
1288 if (point > XFASTINT (e))
1289 SET_PT (XFASTINT (e));
1290 clip_changed = 1;
52b14ac0
JB
1291 /* Changing the buffer bounds invalidates any recorded current column. */
1292 invalidate_current_column ();
35692fe0
JB
1293 return Qnil;
1294}
1295
1296Lisp_Object
1297save_restriction_save ()
1298{
1299 register Lisp_Object bottom, top;
1300 /* Note: I tried using markers here, but it does not win
1301 because insertion at the end of the saved region
1302 does not advance mh and is considered "outside" the saved region. */
1303 XFASTINT (bottom) = BEGV - BEG;
1304 XFASTINT (top) = Z - ZV;
1305
1306 return Fcons (Fcurrent_buffer (), Fcons (bottom, top));
1307}
1308
1309Lisp_Object
1310save_restriction_restore (data)
1311 Lisp_Object data;
1312{
1313 register struct buffer *buf;
1314 register int newhead, newtail;
1315 register Lisp_Object tem;
1316
1317 buf = XBUFFER (XCONS (data)->car);
1318
1319 data = XCONS (data)->cdr;
1320
1321 tem = XCONS (data)->car;
1322 newhead = XINT (tem);
1323 tem = XCONS (data)->cdr;
1324 newtail = XINT (tem);
1325 if (newhead + newtail > BUF_Z (buf) - BUF_BEG (buf))
1326 {
1327 newhead = 0;
1328 newtail = 0;
1329 }
1330 BUF_BEGV (buf) = BUF_BEG (buf) + newhead;
1331 SET_BUF_ZV (buf, BUF_Z (buf) - newtail);
1332 clip_changed = 1;
1333
1334 /* If point is outside the new visible range, move it inside. */
1335 SET_BUF_PT (buf,
1336 clip_to_bounds (BUF_BEGV (buf), BUF_PT (buf), BUF_ZV (buf)));
1337
1338 return Qnil;
1339}
1340
1341DEFUN ("save-restriction", Fsave_restriction, Ssave_restriction, 0, UNEVALLED, 0,
1342 "Execute BODY, saving and restoring current buffer's restrictions.\n\
1343The buffer's restrictions make parts of the beginning and end invisible.\n\
1344\(They are set up with `narrow-to-region' and eliminated with `widen'.)\n\
1345This special form, `save-restriction', saves the current buffer's restrictions\n\
1346when it is entered, and restores them when it is exited.\n\
1347So any `narrow-to-region' within BODY lasts only until the end of the form.\n\
1348The old restrictions settings are restored\n\
1349even in case of abnormal exit (throw or error).\n\
1350\n\
1351The value returned is the value of the last form in BODY.\n\
1352\n\
1353`save-restriction' can get confused if, within the BODY, you widen\n\
1354and then make changes outside the area within the saved restrictions.\n\
1355\n\
1356Note: if you are using both `save-excursion' and `save-restriction',\n\
1357use `save-excursion' outermost:\n\
1358 (save-excursion (save-restriction ...))")
1359 (body)
1360 Lisp_Object body;
1361{
1362 register Lisp_Object val;
1363 int count = specpdl_ptr - specpdl;
1364
1365 record_unwind_protect (save_restriction_restore, save_restriction_save ());
1366 val = Fprogn (body);
1367 return unbind_to (count, val);
1368}
1369\f
671fbc4d
KH
1370/* Buffer for the most recent text displayed by Fmessage. */
1371static char *message_text;
1372
1373/* Allocated length of that buffer. */
1374static int message_length;
1375
35692fe0
JB
1376DEFUN ("message", Fmessage, Smessage, 1, MANY, 0,
1377 "Print a one-line message at the bottom of the screen.\n\
1378The first argument is a control string.\n\
1379It may contain %s or %d or %c to print successive following arguments.\n\
1380%s means print an argument as a string, %d means print as number in decimal,\n\
1381%c means print a number as a single character.\n\
1382The argument used by %s must be a string or a symbol;\n\
ccdac5be
JB
1383the argument used by %d or %c must be a number.\n\
1384If the first argument is nil, clear any existing message; let the\n\
1385minibuffer contents show.")
35692fe0
JB
1386 (nargs, args)
1387 int nargs;
1388 Lisp_Object *args;
1389{
ccdac5be 1390 if (NILP (args[0]))
f0250249
JB
1391 {
1392 message (0);
1393 return Qnil;
1394 }
ccdac5be
JB
1395 else
1396 {
1397 register Lisp_Object val;
1398 val = Fformat (nargs, args);
671fbc4d
KH
1399 /* Copy the data so that it won't move when we GC. */
1400 if (! message_text)
1401 {
1402 message_text = (char *)xmalloc (80);
1403 message_length = 80;
1404 }
1405 if (XSTRING (val)->size > message_length)
1406 {
1407 message_length = XSTRING (val)->size;
1408 message_text = (char *)xrealloc (message_text, message_length);
1409 }
1410 bcopy (XSTRING (val)->data, message_text, XSTRING (val)->size);
1411 message2 (message_text, XSTRING (val)->size);
ccdac5be
JB
1412 return val;
1413 }
35692fe0
JB
1414}
1415
1416DEFUN ("format", Fformat, Sformat, 1, MANY, 0,
1417 "Format a string out of a control-string and arguments.\n\
1418The first argument is a control string.\n\
1419The other arguments are substituted into it to make the result, a string.\n\
1420It may contain %-sequences meaning to substitute the next argument.\n\
1421%s means print a string argument. Actually, prints any object, with `princ'.\n\
1422%d means print as number in decimal (%o octal, %x hex).\n\
1423%c means print a number as a single character.\n\
1424%S means print any object as an s-expression (using prin1).\n\
52b14ac0
JB
1425 The argument used for %d, %o, %x or %c must be a number.\n\
1426Use %% to put a single % into the output.")
35692fe0
JB
1427 (nargs, args)
1428 int nargs;
1429 register Lisp_Object *args;
1430{
1431 register int n; /* The number of the next arg to substitute */
1432 register int total = 5; /* An estimate of the final length */
1433 char *buf;
1434 register unsigned char *format, *end;
1435 int length;
1436 extern char *index ();
1437 /* It should not be necessary to GCPRO ARGS, because
1438 the caller in the interpreter should take care of that. */
1439
1440 CHECK_STRING (args[0], 0);
1441 format = XSTRING (args[0])->data;
1442 end = format + XSTRING (args[0])->size;
1443
1444 n = 0;
1445 while (format != end)
1446 if (*format++ == '%')
1447 {
1448 int minlen;
1449
1450 /* Process a numeric arg and skip it. */
1451 minlen = atoi (format);
1452 if (minlen > 0)
1453 total += minlen;
1454 else
1455 total -= minlen;
1456 while ((*format >= '0' && *format <= '9')
1457 || *format == '-' || *format == ' ' || *format == '.')
1458 format++;
1459
1460 if (*format == '%')
1461 format++;
1462 else if (++n >= nargs)
1463 ;
1464 else if (*format == 'S')
1465 {
1466 /* For `S', prin1 the argument and then treat like a string. */
1467 register Lisp_Object tem;
1468 tem = Fprin1_to_string (args[n], Qnil);
1469 args[n] = tem;
1470 goto string;
1471 }
1472 else if (XTYPE (args[n]) == Lisp_Symbol)
1473 {
1474 XSET (args[n], Lisp_String, XSYMBOL (args[n])->name);
1475 goto string;
1476 }
1477 else if (XTYPE (args[n]) == Lisp_String)
1478 {
1479 string:
1480 total += XSTRING (args[n])->size;
1481 }
1482 /* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */
1483 else if (XTYPE (args[n]) == Lisp_Int && *format != 's')
1484 {
4746118a 1485#ifdef LISP_FLOAT_TYPE
eb8c3be9 1486 /* The following loop assumes the Lisp type indicates
35692fe0
JB
1487 the proper way to pass the argument.
1488 So make sure we have a flonum if the argument should
1489 be a double. */
1490 if (*format == 'e' || *format == 'f' || *format == 'g')
1491 args[n] = Ffloat (args[n]);
4746118a 1492#endif
35692fe0
JB
1493 total += 10;
1494 }
4746118a 1495#ifdef LISP_FLOAT_TYPE
35692fe0
JB
1496 else if (XTYPE (args[n]) == Lisp_Float && *format != 's')
1497 {
1498 if (! (*format == 'e' || *format == 'f' || *format == 'g'))
1499 args[n] = Ftruncate (args[n]);
1500 total += 20;
1501 }
4746118a 1502#endif
35692fe0
JB
1503 else
1504 {
1505 /* Anything but a string, convert to a string using princ. */
1506 register Lisp_Object tem;
1507 tem = Fprin1_to_string (args[n], Qt);
1508 args[n] = tem;
1509 goto string;
1510 }
1511 }
1512
1513 {
1514 register int nstrings = n + 1;
50aa2f90
JB
1515
1516 /* Allocate twice as many strings as we have %-escapes; floats occupy
1517 two slots, and we're not sure how many of those we have. */
35692fe0 1518 register unsigned char **strings
50aa2f90
JB
1519 = (unsigned char **) alloca (2 * nstrings * sizeof (unsigned char *));
1520 int i;
35692fe0 1521
50aa2f90 1522 i = 0;
35692fe0
JB
1523 for (n = 0; n < nstrings; n++)
1524 {
1525 if (n >= nargs)
50aa2f90 1526 strings[i++] = (unsigned char *) "";
35692fe0
JB
1527 else if (XTYPE (args[n]) == Lisp_Int)
1528 /* We checked above that the corresponding format effector
1529 isn't %s, which would cause MPV. */
50aa2f90 1530 strings[i++] = (unsigned char *) XINT (args[n]);
4746118a 1531#ifdef LISP_FLOAT_TYPE
35692fe0
JB
1532 else if (XTYPE (args[n]) == Lisp_Float)
1533 {
1534 union { double d; int half[2]; } u;
1535
1536 u.d = XFLOAT (args[n])->data;
50aa2f90
JB
1537 strings[i++] = (unsigned char *) u.half[0];
1538 strings[i++] = (unsigned char *) u.half[1];
35692fe0 1539 }
4746118a 1540#endif
35692fe0 1541 else
50aa2f90 1542 strings[i++] = XSTRING (args[n])->data;
35692fe0
JB
1543 }
1544
1545 /* Format it in bigger and bigger buf's until it all fits. */
1546 while (1)
1547 {
1548 buf = (char *) alloca (total + 1);
1549 buf[total - 1] = 0;
1550
50aa2f90 1551 length = doprnt (buf, total + 1, strings[0], end, i-1, strings + 1);
35692fe0
JB
1552 if (buf[total - 1] == 0)
1553 break;
1554
1555 total *= 2;
1556 }
1557 }
1558
1559 /* UNGCPRO; */
1560 return make_string (buf, length);
1561}
1562
1563/* VARARGS 1 */
1564Lisp_Object
1565#ifdef NO_ARG_ARRAY
1566format1 (string1, arg0, arg1, arg2, arg3, arg4)
1567 int arg0, arg1, arg2, arg3, arg4;
1568#else
1569format1 (string1)
1570#endif
1571 char *string1;
1572{
1573 char buf[100];
1574#ifdef NO_ARG_ARRAY
1575 int args[5];
1576 args[0] = arg0;
1577 args[1] = arg1;
1578 args[2] = arg2;
1579 args[3] = arg3;
1580 args[4] = arg4;
1581 doprnt (buf, sizeof buf, string1, 0, 5, args);
1582#else
1583 doprnt (buf, sizeof buf, string1, 0, 5, &string1 + 1);
1584#endif
1585 return build_string (buf);
1586}
1587\f
1588DEFUN ("char-equal", Fchar_equal, Schar_equal, 2, 2, 0,
1589 "Return t if two characters match, optionally ignoring case.\n\
1590Both arguments must be characters (i.e. integers).\n\
1591Case is ignored if `case-fold-search' is non-nil in the current buffer.")
1592 (c1, c2)
1593 register Lisp_Object c1, c2;
1594{
1595 unsigned char *downcase = DOWNCASE_TABLE;
1596 CHECK_NUMBER (c1, 0);
1597 CHECK_NUMBER (c2, 1);
1598
56a98455 1599 if (!NILP (current_buffer->case_fold_search)
c34beca9
RS
1600 ? (downcase[0xff & XFASTINT (c1)] == downcase[0xff & XFASTINT (c2)]
1601 && (XFASTINT (c1) & ~0xff) == (XFASTINT (c2) & ~0xff))
35692fe0
JB
1602 : XINT (c1) == XINT (c2))
1603 return Qt;
1604 return Qnil;
1605}
1606
35692fe0
JB
1607\f
1608void
1609syms_of_editfns ()
1610{
f5ff08b0
RS
1611 staticpro (&Vuser_name);
1612 staticpro (&Vuser_full_name);
1613 staticpro (&Vuser_real_name);
1614 staticpro (&Vsystem_name);
35692fe0
JB
1615
1616 defsubr (&Schar_equal);
1617 defsubr (&Sgoto_char);
1618 defsubr (&Sstring_to_char);
1619 defsubr (&Schar_to_string);
1620 defsubr (&Sbuffer_substring);
1621 defsubr (&Sbuffer_string);
1622
1623 defsubr (&Spoint_marker);
1624 defsubr (&Smark_marker);
1625 defsubr (&Spoint);
1626 defsubr (&Sregion_beginning);
1627 defsubr (&Sregion_end);
1628/* defsubr (&Smark); */
1629/* defsubr (&Sset_mark); */
1630 defsubr (&Ssave_excursion);
1631
1632 defsubr (&Sbufsize);
1633 defsubr (&Spoint_max);
1634 defsubr (&Spoint_min);
1635 defsubr (&Spoint_min_marker);
1636 defsubr (&Spoint_max_marker);
1637
1638 defsubr (&Sbobp);
1639 defsubr (&Seobp);
1640 defsubr (&Sbolp);
1641 defsubr (&Seolp);
850a8179
JB
1642 defsubr (&Sfollowing_char);
1643 defsubr (&Sprevious_char);
35692fe0
JB
1644 defsubr (&Schar_after);
1645 defsubr (&Sinsert);
1646 defsubr (&Sinsert_before_markers);
be91036a
RS
1647 defsubr (&Sinsert_and_inherit);
1648 defsubr (&Sinsert_and_inherit_before_markers);
35692fe0
JB
1649 defsubr (&Sinsert_char);
1650
1651 defsubr (&Suser_login_name);
1652 defsubr (&Suser_real_login_name);
1653 defsubr (&Suser_uid);
1654 defsubr (&Suser_real_uid);
1655 defsubr (&Suser_full_name);
7fd233b3 1656 defsubr (&Semacs_pid);
d940e0e4 1657 defsubr (&Scurrent_time);
35692fe0 1658 defsubr (&Scurrent_time_string);
c2662aea 1659 defsubr (&Scurrent_time_zone);
35692fe0 1660 defsubr (&Ssystem_name);
35692fe0
JB
1661 defsubr (&Smessage);
1662 defsubr (&Sformat);
35692fe0
JB
1663
1664 defsubr (&Sinsert_buffer_substring);
e9cf2084 1665 defsubr (&Scompare_buffer_substrings);
35692fe0
JB
1666 defsubr (&Ssubst_char_in_region);
1667 defsubr (&Stranslate_region);
1668 defsubr (&Sdelete_region);
1669 defsubr (&Swiden);
1670 defsubr (&Snarrow_to_region);
1671 defsubr (&Ssave_restriction);
1672}