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