1 /* Lisp functions pertaining to editing.
2 Copyright (C) 1985, 1986, 1987, 1989, 1993 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 1, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
21 #include <sys/types.h>
32 #include "intervals.h"
38 #define min(a, b) ((a) < (b) ? (a) : (b))
39 #define max(a, b) ((a) > (b) ? (a) : (b))
41 /* Some static data, and a function to initialize it for each run */
43 Lisp_Object Vsystem_name
;
44 Lisp_Object Vuser_real_name
; /* login name of current user ID */
45 Lisp_Object Vuser_full_name
; /* full name of current user */
46 Lisp_Object Vuser_name
; /* user name from USER or LOGNAME. */
52 register unsigned char *p
, *q
, *r
;
53 struct passwd
*pw
; /* password entry for the current user */
54 extern char *index ();
57 /* Set up system_name even when dumping. */
59 Vsystem_name
= build_string (get_system_name ());
60 p
= XSTRING (Vsystem_name
)->data
;
63 if (*p
== ' ' || *p
== '\t')
69 /* Don't bother with this on initial start when just dumping out */
72 #endif /* not CANNOT_DUMP */
74 pw
= (struct passwd
*) getpwuid (getuid ());
75 Vuser_real_name
= build_string (pw
? pw
->pw_name
: "unknown");
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");
81 user_name
= (char *) getenv ("LOGNAME");
84 pw
= (struct passwd
*) getpwuid (geteuid ());
85 user_name
= (char *) (pw
? pw
->pw_name
: "unknown");
87 Vuser_name
= build_string (user_name
);
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. */
91 tem
= Fstring_equal (Vuser_name
, Vuser_real_name
);
93 pw
= (struct passwd
*) getpwnam (XSTRING (Vuser_name
)->data
);
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
));
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. */
105 r
= (char *) alloca (strlen (p
) + XSTRING (Vuser_name
)->size
+ 1);
108 strcat (r
, XSTRING (Vuser_name
)->data
);
109 r
[q
- p
] = UPCASE (r
[q
- p
]);
111 Vuser_full_name
= build_string (r
);
113 #endif /* AMPERSAND_FULL_NAME */
116 DEFUN ("char-to-string", Fchar_to_string
, Schar_to_string
, 1, 1, 0,
117 "Convert arg CHAR to a one-character string containing that character.")
125 return make_string (&c
, 1);
128 DEFUN ("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.")
131 register Lisp_Object str
;
133 register Lisp_Object val
;
134 register struct Lisp_String
*p
;
135 CHECK_STRING (str
, 0);
139 XFASTINT (val
) = ((unsigned char *) p
->data
)[0];
149 register Lisp_Object mark
;
150 mark
= Fmake_marker ();
151 Fset_marker (mark
, make_number (val
), Qnil
);
155 DEFUN ("point", Fpoint
, Spoint
, 0, 0, 0,
156 "Return value of point, as an integer.\n\
157 Beginning of buffer is position (point-min)")
161 XFASTINT (temp
) = point
;
165 DEFUN ("point-marker", Fpoint_marker
, Spoint_marker
, 0, 0, 0,
166 "Return value of point, as a marker object.")
169 return buildmark (point
);
173 clip_to_bounds (lower
, num
, upper
)
174 int lower
, num
, upper
;
178 else if (num
> upper
)
184 DEFUN ("goto-char", Fgoto_char
, Sgoto_char
, 1, 1, "NGoto char: ",
185 "Set point to POSITION, a number or marker.\n\
186 Beginning of buffer is position (point-min), end is (point-max).")
188 register Lisp_Object n
;
190 CHECK_NUMBER_COERCE_MARKER (n
, 0);
192 SET_PT (clip_to_bounds (BEGV
, XINT (n
), ZV
));
197 region_limit (beginningp
)
200 register Lisp_Object m
;
201 if (!NILP (Vtransient_mark_mode
) && NILP (Vmark_even_if_inactive
)
202 && NILP (current_buffer
->mark_active
))
203 Fsignal (Qmark_inactive
, Qnil
);
204 m
= Fmarker_position (current_buffer
->mark
);
205 if (NILP (m
)) error ("There is no region now");
206 if ((point
< XFASTINT (m
)) == beginningp
)
207 return (make_number (point
));
212 DEFUN ("region-beginning", Fregion_beginning
, Sregion_beginning
, 0, 0, 0,
213 "Return position of beginning of region, as an integer.")
216 return (region_limit (1));
219 DEFUN ("region-end", Fregion_end
, Sregion_end
, 0, 0, 0,
220 "Return position of end of region, as an integer.")
223 return (region_limit (0));
226 #if 0 /* now in lisp code */
227 DEFUN ("mark", Fmark
, Smark
, 0, 0, 0,
228 "Return this buffer's mark value as integer, or nil if no mark.\n\
229 If you are using this in an editing command, you are most likely making\n\
230 a mistake; see the documentation of `set-mark'.")
233 return Fmarker_position (current_buffer
->mark
);
235 #endif /* commented out code */
237 DEFUN ("mark-marker", Fmark_marker
, Smark_marker
, 0, 0, 0,
238 "Return this buffer's mark, as a marker object.\n\
239 Watch out! Moving this marker changes the mark position.\n\
240 If you set the marker not to point anywhere, the buffer will have no mark.")
243 return current_buffer
->mark
;
246 #if 0 /* this is now in lisp code */
247 DEFUN ("set-mark", Fset_mark
, Sset_mark
, 1, 1, 0,
248 "Set this buffer's mark to POS. Don't use this function!\n\
249 That is to say, don't use this function unless you want\n\
250 the user to see that the mark has moved, and you want the previous\n\
251 mark position to be lost.\n\
253 Normally, when a new mark is set, the old one should go on the stack.\n\
254 This is why most applications should use push-mark, not set-mark.\n\
256 Novice programmers often try to use the mark for the wrong purposes.\n\
257 The mark saves a location for the user's convenience.\n\
258 Most editing commands should not alter the mark.\n\
259 To remember a location for internal use in the Lisp program,\n\
260 store it in a Lisp variable. Example:\n\
262 (let ((beg (point))) (forward-line 1) (delete-region beg (point))).")
268 current_buffer
->mark
= Qnil
;
271 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
273 if (NILP (current_buffer
->mark
))
274 current_buffer
->mark
= Fmake_marker ();
276 Fset_marker (current_buffer
->mark
, pos
, Qnil
);
279 #endif /* commented-out code */
282 save_excursion_save ()
284 register int visible
= (XBUFFER (XWINDOW (selected_window
)->buffer
)
287 return Fcons (Fpoint_marker (),
288 Fcons (Fcopy_marker (current_buffer
->mark
),
289 Fcons (visible
? Qt
: Qnil
,
290 current_buffer
->mark_active
)));
294 save_excursion_restore (info
)
295 register Lisp_Object info
;
297 register Lisp_Object tem
, tem1
;
299 tem
= Fmarker_buffer (Fcar (info
));
300 /* If buffer being returned to is now deleted, avoid error */
301 /* Otherwise could get error here while unwinding to top level
303 /* In that case, Fmarker_buffer returns nil now. */
309 unchain_marker (tem
);
310 tem
= Fcar (Fcdr (info
));
311 Fset_marker (current_buffer
->mark
, tem
, Fcurrent_buffer ());
312 unchain_marker (tem
);
313 tem
= Fcdr (Fcdr (info
));
316 && current_buffer
!= XBUFFER (XWINDOW (selected_window
)->buffer
))
317 Fswitch_to_buffer (Fcurrent_buffer (), Qnil
);
319 tem1
= current_buffer
->mark_active
;
320 current_buffer
->mark_active
= Fcdr (tem
);
321 if (! NILP (current_buffer
->mark_active
))
322 call1 (Vrun_hooks
, intern ("activate-mark-hook"));
323 else if (! NILP (tem1
))
324 call1 (Vrun_hooks
, intern ("deactivate-mark-hook"));
328 DEFUN ("save-excursion", Fsave_excursion
, Ssave_excursion
, 0, UNEVALLED
, 0,
329 "Save point, mark, and current buffer; execute BODY; restore those things.\n\
330 Executes BODY just like `progn'.\n\
331 The values of point, mark and the current buffer are restored\n\
332 even in case of abnormal exit (throw or error).\n\
333 The state of activation of the mark is also restored.")
337 register Lisp_Object val
;
338 int count
= specpdl_ptr
- specpdl
;
340 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
343 return unbind_to (count
, val
);
346 DEFUN ("buffer-size", Fbufsize
, Sbufsize
, 0, 0, 0,
347 "Return the number of characters in the current buffer.")
351 XFASTINT (temp
) = Z
- BEG
;
355 DEFUN ("point-min", Fpoint_min
, Spoint_min
, 0, 0, 0,
356 "Return the minimum permissible value of point in the current buffer.\n\
357 This is 1, unless a clipping restriction is in effect.")
361 XFASTINT (temp
) = BEGV
;
365 DEFUN ("point-min-marker", Fpoint_min_marker
, Spoint_min_marker
, 0, 0, 0,
366 "Return a marker to the minimum permissible value of point in this buffer.\n\
367 This is the beginning, unless a clipping restriction is in effect.")
370 return buildmark (BEGV
);
373 DEFUN ("point-max", Fpoint_max
, Spoint_max
, 0, 0, 0,
374 "Return the maximum permissible value of point in the current buffer.\n\
375 This is (1+ (buffer-size)), unless a clipping restriction is in effect,\n\
376 in which case it is less.")
380 XFASTINT (temp
) = ZV
;
384 DEFUN ("point-max-marker", Fpoint_max_marker
, Spoint_max_marker
, 0, 0, 0,
385 "Return a marker to the maximum permissible value of point in this buffer.\n\
386 This is (1+ (buffer-size)), unless a clipping restriction is in effect,\n\
387 in which case it is less.")
390 return buildmark (ZV
);
393 DEFUN ("following-char", Ffollowing_char
, Sfollowing_char
, 0, 0, 0,
394 "Return the character following point, as a number.\n\
395 At the end of the buffer or accessible region, return 0.")
402 XFASTINT (temp
) = FETCH_CHAR (point
);
406 DEFUN ("preceding-char", Fprevious_char
, Sprevious_char
, 0, 0, 0,
407 "Return the character preceding point, as a number.\n\
408 At the beginning of the buffer or accessible region, return 0.")
415 XFASTINT (temp
) = FETCH_CHAR (point
- 1);
419 DEFUN ("bobp", Fbobp
, Sbobp
, 0, 0, 0,
420 "Return T if point is at the beginning of the buffer.\n\
421 If the buffer is narrowed, this means the beginning of the narrowed part.")
429 DEFUN ("eobp", Feobp
, Seobp
, 0, 0, 0,
430 "Return T if point is at the end of the buffer.\n\
431 If the buffer is narrowed, this means the end of the narrowed part.")
439 DEFUN ("bolp", Fbolp
, Sbolp
, 0, 0, 0,
440 "Return T if point is at the beginning of a line.")
443 if (point
== BEGV
|| FETCH_CHAR (point
- 1) == '\n')
448 DEFUN ("eolp", Feolp
, Seolp
, 0, 0, 0,
449 "Return T if point is at the end of a line.\n\
450 `End of a line' includes point being at the end of the buffer.")
453 if (point
== ZV
|| FETCH_CHAR (point
) == '\n')
458 DEFUN ("char-after", Fchar_after
, Schar_after
, 1, 1, 0,
459 "Return character in current buffer at position POS.\n\
460 POS is an integer or a buffer pointer.\n\
461 If POS is out of range, the value is nil.")
465 register Lisp_Object val
;
468 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
471 if (n
< BEGV
|| n
>= ZV
) return Qnil
;
473 XFASTINT (val
) = FETCH_CHAR (n
);
477 DEFUN ("user-login-name", Fuser_login_name
, Suser_login_name
, 0, 0, 0,
478 "Return the name under which the user logged in, as a string.\n\
479 This is based on the effective uid, not the real uid.\n\
480 Also, if the environment variable USER or LOGNAME is set,\n\
481 that determines the value of this function.")
487 DEFUN ("user-real-login-name", Fuser_real_login_name
, Suser_real_login_name
,
489 "Return the name of the user's real uid, as a string.\n\
490 Differs from `user-login-name' when running under `su'.")
493 return Vuser_real_name
;
496 DEFUN ("user-uid", Fuser_uid
, Suser_uid
, 0, 0, 0,
497 "Return the effective uid of Emacs, as an integer.")
500 return make_number (geteuid ());
503 DEFUN ("user-real-uid", Fuser_real_uid
, Suser_real_uid
, 0, 0, 0,
504 "Return the real uid of Emacs, as an integer.")
507 return make_number (getuid ());
510 DEFUN ("user-full-name", Fuser_full_name
, Suser_full_name
, 0, 0, 0,
511 "Return the full name of the user logged in, as a string.")
514 return Vuser_full_name
;
517 DEFUN ("system-name", Fsystem_name
, Ssystem_name
, 0, 0, 0,
518 "Return the name of the machine you are running on, as a string.")
524 DEFUN ("current-time", Fcurrent_time
, Scurrent_time
, 0, 0, 0,
525 "Return the current time, as the number of seconds since 12:00 AM January 1970.\n\
526 The time is returned as a list of three integers. The first has the\n\
527 most significant 16 bits of the seconds, while the second has the\n\
528 least significant 16 bits. The third integer gives the microsecond\n\
531 The microsecond count is zero on systems that do not provide\n\
532 resolution finer than a second.")
536 Lisp_Object result
[3];
539 XSET (result
[0], Lisp_Int
, (EMACS_SECS (t
) >> 16) & 0xffff);
540 XSET (result
[1], Lisp_Int
, (EMACS_SECS (t
) >> 0) & 0xffff);
541 XSET (result
[2], Lisp_Int
, EMACS_USECS (t
));
543 return Flist (3, result
);
548 lisp_time_argument (specified_time
, result
)
549 Lisp_Object specified_time
;
552 if (NILP (specified_time
))
553 return time (result
) != -1;
556 Lisp_Object high
, low
;
557 high
= Fcar (specified_time
);
558 CHECK_NUMBER (high
, 0);
559 low
= Fcdr (specified_time
);
560 if (XTYPE (low
) == Lisp_Cons
)
562 CHECK_NUMBER (low
, 0);
563 *result
= (XINT (high
) << 16) + (XINT (low
) & 0xffff);
564 return *result
>> 16 == XINT (high
);
568 DEFUN ("current-time-string", Fcurrent_time_string
, Scurrent_time_string
, 0, 1, 0,
569 "Return the current time, as a human-readable string.\n\
570 Programs can use this function to decode a time,\n\
571 since the number of columns in each field is fixed.\n\
572 The format is `Sun Sep 16 01:03:52 1973'.\n\
573 If an argument is given, it specifies a time to format\n\
574 instead of the current time. The argument should have the form:\n\
577 (HIGH LOW . IGNORED).\n\
578 Thus, you can use times obtained from `current-time'\n\
579 and from `file-attributes'.")
581 Lisp_Object specified_time
;
587 if (! lisp_time_argument (specified_time
, &value
))
589 tem
= (char *) ctime (&value
);
591 strncpy (buf
, tem
, 24);
594 return build_string (buf
);
597 #define TM_YEAR_ORIGIN 1900
599 /* Yield A - B, measured in seconds. */
604 int ay
= a
->tm_year
+ (TM_YEAR_ORIGIN
- 1);
605 int by
= b
->tm_year
+ (TM_YEAR_ORIGIN
- 1);
610 /* difference in day of year */
611 a
->tm_yday
- b
->tm_yday
612 /* + intervening leap days */
613 + ((ay
>> 2) - (by
>> 2))
615 + ((ay
/100 >> 2) - (by
/100 >> 2))
616 /* + difference in years * 365 */
617 + (long)(ay
-by
) * 365
618 )*24 + (a
->tm_hour
- b
->tm_hour
)
619 )*60 + (a
->tm_min
- b
->tm_min
)
620 )*60 + (a
->tm_sec
- b
->tm_sec
);
623 DEFUN ("current-time-zone", Fcurrent_time_zone
, Scurrent_time_zone
, 0, 1, 0,
624 "Return the offset and name for the local time zone.\n\
625 This returns a list of the form (OFFSET NAME).\n\
626 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).\n\
627 A negative value means west of Greenwich.\n\
628 NAME is a string giving the name of the time zone.\n\
629 If an argument is given, it specifies when the time zone offset is determined\n\
630 instead of using the current time. The argument should have the form:\n\
633 (HIGH LOW . IGNORED).\n\
634 Thus, you can use times obtained from `current-time'\n\
635 and from `file-attributes'.\n\
637 Some operating systems cannot provide all this information to Emacs;\n\
638 in this case, `current-time-zone' returns a list containing nil for\n\
639 the data it can't find.")
641 Lisp_Object specified_time
;
646 if (lisp_time_argument (specified_time
, &value
)
647 && (t
= gmtime (&value
)) != 0)
653 gmt
= *t
; /* Make a copy, in case localtime modifies *t. */
654 t
= localtime (&value
);
655 offset
= difftm (t
, &gmt
);
660 #else /* not HAVE_TM_ZONE */
662 if (t
->tm_isdst
== 0 || t
->tm_isdst
== 1)
663 s
= tzname
[t
->tm_isdst
];
665 #endif /* not HAVE_TM_ZONE */
668 /* No local time zone name is available; use "+-NNNN" instead. */
669 int am
= (offset
< 0 ? -offset
: offset
) / 60;
670 sprintf (buf
, "%c%02d%02d", (offset
< 0 ? '-' : '+'), am
/60, am
%60);
673 return Fcons (make_number (offset
), Fcons (build_string (s
), Qnil
));
676 return Fmake_list (2, Qnil
);
688 /* Callers passing one argument to Finsert need not gcpro the
689 argument "array", since the only element of the array will
690 not be used after calling insert or insert_from_string, so
691 we don't care if it gets trashed. */
693 DEFUN ("insert", Finsert
, Sinsert
, 0, MANY
, 0,
694 "Insert the arguments, either strings or characters, at point.\n\
695 Point moves forward so that it ends up after the inserted text.\n\
696 Any other markers at the point of insertion remain before the text.")
699 register Lisp_Object
*args
;
702 register Lisp_Object tem
;
705 for (argnum
= 0; argnum
< nargs
; argnum
++)
709 if (XTYPE (tem
) == Lisp_Int
)
714 else if (XTYPE (tem
) == Lisp_String
)
716 insert_from_string (tem
, 0, XSTRING (tem
)->size
);
720 tem
= wrong_type_argument (Qchar_or_string_p
, tem
);
728 DEFUN ("insert-before-markers", Finsert_before_markers
, Sinsert_before_markers
, 0, MANY
, 0,
729 "Insert strings or characters at point, relocating markers after the text.\n\
730 Point moves forward so that it ends up after the inserted text.\n\
731 Any other markers at the point of insertion also end up after the text.")
734 register Lisp_Object
*args
;
737 register Lisp_Object tem
;
740 for (argnum
= 0; argnum
< nargs
; argnum
++)
744 if (XTYPE (tem
) == Lisp_Int
)
747 insert_before_markers (str
, 1);
749 else if (XTYPE (tem
) == Lisp_String
)
751 insert_from_string_before_markers (tem
, 0, XSTRING (tem
)->size
);
755 tem
= wrong_type_argument (Qchar_or_string_p
, tem
);
763 DEFUN ("insert-char", Finsert_char
, Sinsert_char
, 2, 2, 0,
764 "Insert COUNT (second arg) copies of CHAR (first arg).\n\
765 Point and all markers are affected as in the function `insert'.\n\
766 Both arguments are required.")
768 Lisp_Object chr
, count
;
770 register unsigned char *string
;
774 CHECK_NUMBER (chr
, 0);
775 CHECK_NUMBER (count
, 1);
780 strlen
= min (n
, 256);
781 string
= (unsigned char *) alloca (strlen
);
782 for (i
= 0; i
< strlen
; i
++)
783 string
[i
] = XFASTINT (chr
);
786 insert (string
, strlen
);
795 /* Making strings from buffer contents. */
797 /* Return a Lisp_String containing the text of the current buffer from
798 START to END. If text properties are in use and the current buffer
799 has properties in the range specified, the resulting string will also
802 We don't want to use plain old make_string here, because it calls
803 make_uninit_string, which can cause the buffer arena to be
804 compacted. make_string has no way of knowing that the data has
805 been moved, and thus copies the wrong data into the string. This
806 doesn't effect most of the other users of make_string, so it should
807 be left as is. But we should use this function when conjuring
808 buffer substrings. */
811 make_buffer_string (start
, end
)
816 if (start
< GPT
&& GPT
< end
)
819 result
= make_uninit_string (end
- start
);
820 bcopy (&FETCH_CHAR (start
), XSTRING (result
)->data
, end
- start
);
822 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
823 copy_intervals_to_string (result
, current_buffer
, start
, end
- start
);
828 DEFUN ("buffer-substring", Fbuffer_substring
, Sbuffer_substring
, 2, 2, 0,
829 "Return the contents of part of the current buffer as a string.\n\
830 The two arguments START and END are character positions;\n\
831 they can be in either order.")
835 register int beg
, end
;
837 validate_region (&b
, &e
);
841 return make_buffer_string (beg
, end
);
844 DEFUN ("buffer-string", Fbuffer_string
, Sbuffer_string
, 0, 0, 0,
845 "Return the contents of the current buffer as a string.")
848 return make_buffer_string (BEGV
, ZV
);
851 DEFUN ("insert-buffer-substring", Finsert_buffer_substring
, Sinsert_buffer_substring
,
853 "Insert before point a substring of the contents of buffer BUFFER.\n\
854 BUFFER may be a buffer or a buffer name.\n\
855 Arguments START and END are character numbers specifying the substring.\n\
856 They default to the beginning and the end of BUFFER.")
858 Lisp_Object buf
, b
, e
;
860 register int beg
, end
, temp
, len
, opoint
, start
;
861 register struct buffer
*bp
;
864 buffer
= Fget_buffer (buf
);
867 bp
= XBUFFER (buffer
);
873 CHECK_NUMBER_COERCE_MARKER (b
, 0);
880 CHECK_NUMBER_COERCE_MARKER (e
, 1);
885 temp
= beg
, beg
= end
, end
= temp
;
887 /* Move the gap or create enough gap in the current buffer. */
891 if (GAP_SIZE
< end
- beg
)
892 make_gap (end
- beg
- GAP_SIZE
);
898 if (!(BUF_BEGV (bp
) <= beg
900 && end
<= BUF_ZV (bp
)))
901 args_out_of_range (b
, e
);
903 /* Now the actual insertion will not do any gap motion,
904 so it matters not if BUF is the current buffer. */
905 if (beg
< BUF_GPT (bp
))
907 insert (BUF_CHAR_ADDRESS (bp
, beg
), min (end
, BUF_GPT (bp
)) - beg
);
908 beg
= min (end
, BUF_GPT (bp
));
911 insert (BUF_CHAR_ADDRESS (bp
, beg
), end
- beg
);
913 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
914 graft_intervals_into_buffer (copy_intervals (bp
->intervals
, start
, len
),
920 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings
, Scompare_buffer_substrings
,
922 "Compare two substrings of two buffers; return result as number.\n\
923 the value is -N if first string is less after N-1 chars,\n\
924 +N if first string is greater after N-1 chars, or 0 if strings match.\n\
925 Each substring is represented as three arguments: BUFFER, START and END.\n\
926 That makes six args in all, three for each substring.\n\n\
927 The value of `case-fold-search' in the current buffer\n\
928 determines whether case is significant or ignored.")
929 (buffer1
, start1
, end1
, buffer2
, start2
, end2
)
930 Lisp_Object buffer1
, start1
, end1
, buffer2
, start2
, end2
;
932 register int begp1
, endp1
, begp2
, endp2
, temp
, len1
, len2
, length
, i
;
933 register struct buffer
*bp1
, *bp2
;
934 register unsigned char *trt
935 = (!NILP (current_buffer
->case_fold_search
)
936 ? XSTRING (current_buffer
->case_canon_table
)->data
: 0);
938 /* Find the first buffer and its substring. */
941 bp1
= current_buffer
;
945 buf1
= Fget_buffer (buffer1
);
948 bp1
= XBUFFER (buf1
);
952 begp1
= BUF_BEGV (bp1
);
955 CHECK_NUMBER_COERCE_MARKER (start1
, 1);
956 begp1
= XINT (start1
);
959 endp1
= BUF_ZV (bp1
);
962 CHECK_NUMBER_COERCE_MARKER (end1
, 2);
967 temp
= begp1
, begp1
= endp1
, endp1
= temp
;
969 if (!(BUF_BEGV (bp1
) <= begp1
971 && endp1
<= BUF_ZV (bp1
)))
972 args_out_of_range (start1
, end1
);
974 /* Likewise for second substring. */
977 bp2
= current_buffer
;
981 buf2
= Fget_buffer (buffer2
);
984 bp2
= XBUFFER (buffer2
);
988 begp2
= BUF_BEGV (bp2
);
991 CHECK_NUMBER_COERCE_MARKER (start2
, 4);
992 begp2
= XINT (start2
);
995 endp2
= BUF_ZV (bp2
);
998 CHECK_NUMBER_COERCE_MARKER (end2
, 5);
1003 temp
= begp2
, begp2
= endp2
, endp2
= temp
;
1005 if (!(BUF_BEGV (bp2
) <= begp2
1007 && endp2
<= BUF_ZV (bp2
)))
1008 args_out_of_range (start2
, end2
);
1010 len1
= endp1
- begp1
;
1011 len2
= endp2
- begp2
;
1016 for (i
= 0; i
< length
; i
++)
1018 int c1
= *BUF_CHAR_ADDRESS (bp1
, begp1
+ i
);
1019 int c2
= *BUF_CHAR_ADDRESS (bp2
, begp2
+ i
);
1026 return make_number (- 1 - i
);
1028 return make_number (i
+ 1);
1031 /* The strings match as far as they go.
1032 If one is shorter, that one is less. */
1034 return make_number (length
+ 1);
1035 else if (length
< len2
)
1036 return make_number (- length
- 1);
1038 /* Same length too => they are equal. */
1039 return make_number (0);
1042 DEFUN ("subst-char-in-region", Fsubst_char_in_region
,
1043 Ssubst_char_in_region
, 4, 5, 0,
1044 "From START to END, replace FROMCHAR with TOCHAR each time it occurs.\n\
1045 If optional arg NOUNDO is non-nil, don't record this change for undo\n\
1046 and don't mark the buffer as really changed.")
1047 (start
, end
, fromchar
, tochar
, noundo
)
1048 Lisp_Object start
, end
, fromchar
, tochar
, noundo
;
1050 register int pos
, stop
, look
;
1052 validate_region (&start
, &end
);
1053 CHECK_NUMBER (fromchar
, 2);
1054 CHECK_NUMBER (tochar
, 3);
1058 look
= XINT (fromchar
);
1060 modify_region (current_buffer
, pos
, stop
);
1061 if (! NILP (noundo
))
1063 if (MODIFF
- 1 == current_buffer
->save_modified
)
1064 current_buffer
->save_modified
++;
1065 if (MODIFF
- 1 == current_buffer
->auto_save_modified
)
1066 current_buffer
->auto_save_modified
++;
1071 if (FETCH_CHAR (pos
) == look
)
1074 record_change (pos
, 1);
1075 FETCH_CHAR (pos
) = XINT (tochar
);
1077 signal_after_change (pos
, 1, 1);
1085 DEFUN ("translate-region", Ftranslate_region
, Stranslate_region
, 3, 3, 0,
1086 "From START to END, translate characters according to TABLE.\n\
1087 TABLE is a string; the Nth character in it is the mapping\n\
1088 for the character with code N. Returns the number of characters changed.")
1092 register Lisp_Object table
;
1094 register int pos
, stop
; /* Limits of the region. */
1095 register unsigned char *tt
; /* Trans table. */
1096 register int oc
; /* Old character. */
1097 register int nc
; /* New character. */
1098 int cnt
; /* Number of changes made. */
1099 Lisp_Object z
; /* Return. */
1100 int size
; /* Size of translate table. */
1102 validate_region (&start
, &end
);
1103 CHECK_STRING (table
, 2);
1105 size
= XSTRING (table
)->size
;
1106 tt
= XSTRING (table
)->data
;
1110 modify_region (current_buffer
, pos
, stop
);
1113 for (; pos
< stop
; ++pos
)
1115 oc
= FETCH_CHAR (pos
);
1121 record_change (pos
, 1);
1122 FETCH_CHAR (pos
) = nc
;
1123 signal_after_change (pos
, 1, 1);
1133 DEFUN ("delete-region", Fdelete_region
, Sdelete_region
, 2, 2, "r",
1134 "Delete the text between point and mark.\n\
1135 When called from a program, expects two arguments,\n\
1136 positions (integers or markers) specifying the stretch to be deleted.")
1140 validate_region (&b
, &e
);
1141 del_range (XINT (b
), XINT (e
));
1145 DEFUN ("widen", Fwiden
, Swiden
, 0, 0, "",
1146 "Remove restrictions (narrowing) from current buffer.\n\
1147 This allows the buffer's full text to be seen and edited.")
1151 SET_BUF_ZV (current_buffer
, Z
);
1153 /* Changing the buffer bounds invalidates any recorded current column. */
1154 invalidate_current_column ();
1158 DEFUN ("narrow-to-region", Fnarrow_to_region
, Snarrow_to_region
, 2, 2, "r",
1159 "Restrict editing in this buffer to the current region.\n\
1160 The rest of the text becomes temporarily invisible and untouchable\n\
1161 but is not deleted; if you save the buffer in a file, the invisible\n\
1162 text is included in the file. \\[widen] makes all visible again.\n\
1163 See also `save-restriction'.\n\
1165 When calling from a program, pass two arguments; positions (integers\n\
1166 or markers) bounding the text that should remain visible.")
1168 register Lisp_Object b
, e
;
1172 CHECK_NUMBER_COERCE_MARKER (b
, 0);
1173 CHECK_NUMBER_COERCE_MARKER (e
, 1);
1175 if (XINT (b
) > XINT (e
))
1182 if (!(BEG
<= XINT (b
) && XINT (b
) <= XINT (e
) && XINT (e
) <= Z
))
1183 args_out_of_range (b
, e
);
1185 BEGV
= XFASTINT (b
);
1186 SET_BUF_ZV (current_buffer
, XFASTINT (e
));
1187 if (point
< XFASTINT (b
))
1188 SET_PT (XFASTINT (b
));
1189 if (point
> XFASTINT (e
))
1190 SET_PT (XFASTINT (e
));
1192 /* Changing the buffer bounds invalidates any recorded current column. */
1193 invalidate_current_column ();
1198 save_restriction_save ()
1200 register Lisp_Object bottom
, top
;
1201 /* Note: I tried using markers here, but it does not win
1202 because insertion at the end of the saved region
1203 does not advance mh and is considered "outside" the saved region. */
1204 XFASTINT (bottom
) = BEGV
- BEG
;
1205 XFASTINT (top
) = Z
- ZV
;
1207 return Fcons (Fcurrent_buffer (), Fcons (bottom
, top
));
1211 save_restriction_restore (data
)
1214 register struct buffer
*buf
;
1215 register int newhead
, newtail
;
1216 register Lisp_Object tem
;
1218 buf
= XBUFFER (XCONS (data
)->car
);
1220 data
= XCONS (data
)->cdr
;
1222 tem
= XCONS (data
)->car
;
1223 newhead
= XINT (tem
);
1224 tem
= XCONS (data
)->cdr
;
1225 newtail
= XINT (tem
);
1226 if (newhead
+ newtail
> BUF_Z (buf
) - BUF_BEG (buf
))
1231 BUF_BEGV (buf
) = BUF_BEG (buf
) + newhead
;
1232 SET_BUF_ZV (buf
, BUF_Z (buf
) - newtail
);
1235 /* If point is outside the new visible range, move it inside. */
1237 clip_to_bounds (BUF_BEGV (buf
), BUF_PT (buf
), BUF_ZV (buf
)));
1242 DEFUN ("save-restriction", Fsave_restriction
, Ssave_restriction
, 0, UNEVALLED
, 0,
1243 "Execute BODY, saving and restoring current buffer's restrictions.\n\
1244 The buffer's restrictions make parts of the beginning and end invisible.\n\
1245 \(They are set up with `narrow-to-region' and eliminated with `widen'.)\n\
1246 This special form, `save-restriction', saves the current buffer's restrictions\n\
1247 when it is entered, and restores them when it is exited.\n\
1248 So any `narrow-to-region' within BODY lasts only until the end of the form.\n\
1249 The old restrictions settings are restored\n\
1250 even in case of abnormal exit (throw or error).\n\
1252 The value returned is the value of the last form in BODY.\n\
1254 `save-restriction' can get confused if, within the BODY, you widen\n\
1255 and then make changes outside the area within the saved restrictions.\n\
1257 Note: if you are using both `save-excursion' and `save-restriction',\n\
1258 use `save-excursion' outermost:\n\
1259 (save-excursion (save-restriction ...))")
1263 register Lisp_Object val
;
1264 int count
= specpdl_ptr
- specpdl
;
1266 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1267 val
= Fprogn (body
);
1268 return unbind_to (count
, val
);
1271 DEFUN ("message", Fmessage
, Smessage
, 1, MANY
, 0,
1272 "Print a one-line message at the bottom of the screen.\n\
1273 The first argument is a control string.\n\
1274 It may contain %s or %d or %c to print successive following arguments.\n\
1275 %s means print an argument as a string, %d means print as number in decimal,\n\
1276 %c means print a number as a single character.\n\
1277 The argument used by %s must be a string or a symbol;\n\
1278 the argument used by %d or %c must be a number.\n\
1279 If the first argument is nil, clear any existing message; let the\n\
1280 minibuffer contents show.")
1292 register Lisp_Object val
;
1293 val
= Fformat (nargs
, args
);
1294 message ("%s", XSTRING (val
)->data
);
1299 DEFUN ("format", Fformat
, Sformat
, 1, MANY
, 0,
1300 "Format a string out of a control-string and arguments.\n\
1301 The first argument is a control string.\n\
1302 The other arguments are substituted into it to make the result, a string.\n\
1303 It may contain %-sequences meaning to substitute the next argument.\n\
1304 %s means print a string argument. Actually, prints any object, with `princ'.\n\
1305 %d means print as number in decimal (%o octal, %x hex).\n\
1306 %c means print a number as a single character.\n\
1307 %S means print any object as an s-expression (using prin1).\n\
1308 The argument used for %d, %o, %x or %c must be a number.\n\
1309 Use %% to put a single % into the output.")
1312 register Lisp_Object
*args
;
1314 register int n
; /* The number of the next arg to substitute */
1315 register int total
= 5; /* An estimate of the final length */
1317 register unsigned char *format
, *end
;
1319 extern char *index ();
1320 /* It should not be necessary to GCPRO ARGS, because
1321 the caller in the interpreter should take care of that. */
1323 CHECK_STRING (args
[0], 0);
1324 format
= XSTRING (args
[0])->data
;
1325 end
= format
+ XSTRING (args
[0])->size
;
1328 while (format
!= end
)
1329 if (*format
++ == '%')
1333 /* Process a numeric arg and skip it. */
1334 minlen
= atoi (format
);
1339 while ((*format
>= '0' && *format
<= '9')
1340 || *format
== '-' || *format
== ' ' || *format
== '.')
1345 else if (++n
>= nargs
)
1347 else if (*format
== 'S')
1349 /* For `S', prin1 the argument and then treat like a string. */
1350 register Lisp_Object tem
;
1351 tem
= Fprin1_to_string (args
[n
], Qnil
);
1355 else if (XTYPE (args
[n
]) == Lisp_Symbol
)
1357 XSET (args
[n
], Lisp_String
, XSYMBOL (args
[n
])->name
);
1360 else if (XTYPE (args
[n
]) == Lisp_String
)
1363 total
+= XSTRING (args
[n
])->size
;
1365 /* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */
1366 else if (XTYPE (args
[n
]) == Lisp_Int
&& *format
!= 's')
1368 #ifdef LISP_FLOAT_TYPE
1369 /* The following loop assumes the Lisp type indicates
1370 the proper way to pass the argument.
1371 So make sure we have a flonum if the argument should
1373 if (*format
== 'e' || *format
== 'f' || *format
== 'g')
1374 args
[n
] = Ffloat (args
[n
]);
1378 #ifdef LISP_FLOAT_TYPE
1379 else if (XTYPE (args
[n
]) == Lisp_Float
&& *format
!= 's')
1381 if (! (*format
== 'e' || *format
== 'f' || *format
== 'g'))
1382 args
[n
] = Ftruncate (args
[n
]);
1388 /* Anything but a string, convert to a string using princ. */
1389 register Lisp_Object tem
;
1390 tem
= Fprin1_to_string (args
[n
], Qt
);
1397 register int nstrings
= n
+ 1;
1399 /* Allocate twice as many strings as we have %-escapes; floats occupy
1400 two slots, and we're not sure how many of those we have. */
1401 register unsigned char **strings
1402 = (unsigned char **) alloca (2 * nstrings
* sizeof (unsigned char *));
1406 for (n
= 0; n
< nstrings
; n
++)
1409 strings
[i
++] = (unsigned char *) "";
1410 else if (XTYPE (args
[n
]) == Lisp_Int
)
1411 /* We checked above that the corresponding format effector
1412 isn't %s, which would cause MPV. */
1413 strings
[i
++] = (unsigned char *) XINT (args
[n
]);
1414 #ifdef LISP_FLOAT_TYPE
1415 else if (XTYPE (args
[n
]) == Lisp_Float
)
1417 union { double d
; int half
[2]; } u
;
1419 u
.d
= XFLOAT (args
[n
])->data
;
1420 strings
[i
++] = (unsigned char *) u
.half
[0];
1421 strings
[i
++] = (unsigned char *) u
.half
[1];
1425 strings
[i
++] = XSTRING (args
[n
])->data
;
1428 /* Format it in bigger and bigger buf's until it all fits. */
1431 buf
= (char *) alloca (total
+ 1);
1434 length
= doprnt (buf
, total
+ 1, strings
[0], end
, i
-1, strings
+ 1);
1435 if (buf
[total
- 1] == 0)
1443 return make_string (buf
, length
);
1449 format1 (string1
, arg0
, arg1
, arg2
, arg3
, arg4
)
1450 int arg0
, arg1
, arg2
, arg3
, arg4
;
1464 doprnt (buf
, sizeof buf
, string1
, 0, 5, args
);
1466 doprnt (buf
, sizeof buf
, string1
, 0, 5, &string1
+ 1);
1468 return build_string (buf
);
1471 DEFUN ("char-equal", Fchar_equal
, Schar_equal
, 2, 2, 0,
1472 "Return t if two characters match, optionally ignoring case.\n\
1473 Both arguments must be characters (i.e. integers).\n\
1474 Case is ignored if `case-fold-search' is non-nil in the current buffer.")
1476 register Lisp_Object c1
, c2
;
1478 unsigned char *downcase
= DOWNCASE_TABLE
;
1479 CHECK_NUMBER (c1
, 0);
1480 CHECK_NUMBER (c2
, 1);
1482 if (!NILP (current_buffer
->case_fold_search
)
1483 ? (downcase
[0xff & XFASTINT (c1
)] == downcase
[0xff & XFASTINT (c2
)]
1484 && (XFASTINT (c1
) & ~0xff) == (XFASTINT (c2
) & ~0xff))
1485 : XINT (c1
) == XINT (c2
))
1494 DEFVAR_LISP ("system-name", &Vsystem_name
,
1495 "The name of the machine Emacs is running on.");
1497 DEFVAR_LISP ("user-full-name", &Vuser_full_name
,
1498 "The full name of the user logged in.");
1500 DEFVAR_LISP ("user-name", &Vuser_name
,
1501 "The user's name, based on the effective uid.");
1503 DEFVAR_LISP ("user-real-name", &Vuser_real_name
,
1504 "The user's name, base upon the real uid.");
1506 defsubr (&Schar_equal
);
1507 defsubr (&Sgoto_char
);
1508 defsubr (&Sstring_to_char
);
1509 defsubr (&Schar_to_string
);
1510 defsubr (&Sbuffer_substring
);
1511 defsubr (&Sbuffer_string
);
1513 defsubr (&Spoint_marker
);
1514 defsubr (&Smark_marker
);
1516 defsubr (&Sregion_beginning
);
1517 defsubr (&Sregion_end
);
1518 /* defsubr (&Smark); */
1519 /* defsubr (&Sset_mark); */
1520 defsubr (&Ssave_excursion
);
1522 defsubr (&Sbufsize
);
1523 defsubr (&Spoint_max
);
1524 defsubr (&Spoint_min
);
1525 defsubr (&Spoint_min_marker
);
1526 defsubr (&Spoint_max_marker
);
1532 defsubr (&Sfollowing_char
);
1533 defsubr (&Sprevious_char
);
1534 defsubr (&Schar_after
);
1536 defsubr (&Sinsert_before_markers
);
1537 defsubr (&Sinsert_char
);
1539 defsubr (&Suser_login_name
);
1540 defsubr (&Suser_real_login_name
);
1541 defsubr (&Suser_uid
);
1542 defsubr (&Suser_real_uid
);
1543 defsubr (&Suser_full_name
);
1544 defsubr (&Scurrent_time
);
1545 defsubr (&Scurrent_time_string
);
1546 defsubr (&Scurrent_time_zone
);
1547 defsubr (&Ssystem_name
);
1548 defsubr (&Smessage
);
1551 defsubr (&Sinsert_buffer_substring
);
1552 defsubr (&Scompare_buffer_substrings
);
1553 defsubr (&Ssubst_char_in_region
);
1554 defsubr (&Stranslate_region
);
1555 defsubr (&Sdelete_region
);
1557 defsubr (&Snarrow_to_region
);
1558 defsubr (&Ssave_restriction
);