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