1 /* Lisp functions pertaining to editing.
3 Copyright (C) 1985, 1986, 1987, 1989, 1993, 1994, 1995, 1996, 1997,
4 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
5 2009, 2010 Free Software Foundation, Inc.
7 This file is part of GNU Emacs.
9 GNU Emacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
14 GNU Emacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
24 #include <sys/types.h>
36 #ifdef HAVE_SYS_UTSNAME_H
37 #include <sys/utsname.h>
42 /* systime.h includes <sys/time.h> which, on some systems, is required
43 for <sys/resource.h>; thus systime.h must be included before
47 #if defined HAVE_SYS_RESOURCE_H
48 #include <sys/resource.h>
53 #include "intervals.h"
55 #include "character.h"
59 #include "blockinput.h"
63 #define MAX_10_EXP DBL_MAX_10_EXP
65 #define MAX_10_EXP 310
72 #ifndef USER_FULL_NAME
73 #define USER_FULL_NAME pw->pw_gecos
77 extern char **environ
;
80 #define TM_YEAR_BASE 1900
82 /* Nonzero if TM_YEAR is a struct tm's tm_year value that causes
83 asctime to have well-defined behavior. */
84 #ifndef TM_YEAR_IN_ASCTIME_RANGE
85 # define TM_YEAR_IN_ASCTIME_RANGE(tm_year) \
86 (1000 - TM_YEAR_BASE <= (tm_year) && (tm_year) <= 9999 - TM_YEAR_BASE)
89 extern size_t emacs_strftimeu (char *, size_t, const char *,
90 const struct tm
*, int);
93 extern Lisp_Object
w32_get_internal_run_time ();
96 static int tm_diff (struct tm
*, struct tm
*);
97 static void find_field (Lisp_Object
, Lisp_Object
, Lisp_Object
, int *, Lisp_Object
, int *);
98 static void update_buffer_properties (int, int);
99 static Lisp_Object
region_limit (int);
100 int lisp_time_argument (Lisp_Object
, time_t *, int *);
101 static size_t emacs_memftimeu (char *, size_t, const char *,
102 size_t, const struct tm
*, int);
103 static void general_insert_function (void (*) (const unsigned char *, EMACS_INT
),
104 void (*) (Lisp_Object
, EMACS_INT
,
105 EMACS_INT
, EMACS_INT
,
107 int, int, Lisp_Object
*);
108 static Lisp_Object
subst_char_in_region_unwind (Lisp_Object
);
109 static Lisp_Object
subst_char_in_region_unwind_1 (Lisp_Object
);
110 static void transpose_markers (int, int, int, int, int, int, int, int);
113 extern char *index (const char *, int);
116 Lisp_Object Vbuffer_access_fontify_functions
;
117 Lisp_Object Qbuffer_access_fontify_functions
;
118 Lisp_Object Vbuffer_access_fontified_property
;
120 Lisp_Object
Fuser_full_name (Lisp_Object
);
122 /* Non-nil means don't stop at field boundary in text motion commands. */
124 Lisp_Object Vinhibit_field_text_motion
;
126 /* Some static data, and a function to initialize it for each run */
128 Lisp_Object Vsystem_name
;
129 Lisp_Object Vuser_real_login_name
; /* login name of current user ID */
130 Lisp_Object Vuser_full_name
; /* full name of current user */
131 Lisp_Object Vuser_login_name
; /* user name from LOGNAME or USER */
132 Lisp_Object Voperating_system_release
; /* Operating System Release */
134 /* Symbol for the text property used to mark fields. */
138 /* A special value for Qfield properties. */
140 Lisp_Object Qboundary
;
147 register unsigned char *p
;
148 struct passwd
*pw
; /* password entry for the current user */
151 /* Set up system_name even when dumping. */
155 /* Don't bother with this on initial start when just dumping out */
158 #endif /* not CANNOT_DUMP */
160 pw
= (struct passwd
*) getpwuid (getuid ());
162 /* We let the real user name default to "root" because that's quite
163 accurate on MSDOG and because it lets Emacs find the init file.
164 (The DVX libraries override the Djgpp libraries here.) */
165 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "root");
167 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "unknown");
170 /* Get the effective user name, by consulting environment variables,
171 or the effective uid if those are unset. */
172 user_name
= (char *) getenv ("LOGNAME");
175 user_name
= (char *) getenv ("USERNAME"); /* it's USERNAME on NT */
176 #else /* WINDOWSNT */
177 user_name
= (char *) getenv ("USER");
178 #endif /* WINDOWSNT */
181 pw
= (struct passwd
*) getpwuid (geteuid ());
182 user_name
= (char *) (pw
? pw
->pw_name
: "unknown");
184 Vuser_login_name
= build_string (user_name
);
186 /* If the user name claimed in the environment vars differs from
187 the real uid, use the claimed name to find the full name. */
188 tem
= Fstring_equal (Vuser_login_name
, Vuser_real_login_name
);
189 Vuser_full_name
= Fuser_full_name (NILP (tem
)? make_number (geteuid())
192 p
= (unsigned char *) getenv ("NAME");
194 Vuser_full_name
= build_string (p
);
195 else if (NILP (Vuser_full_name
))
196 Vuser_full_name
= build_string ("unknown");
198 #ifdef HAVE_SYS_UTSNAME_H
202 Voperating_system_release
= build_string (uts
.release
);
205 Voperating_system_release
= Qnil
;
209 DEFUN ("char-to-string", Fchar_to_string
, Schar_to_string
, 1, 1, 0,
210 doc
: /* Convert arg CHAR to a string containing that character.
211 usage: (char-to-string CHAR) */)
213 Lisp_Object character
;
216 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
218 CHECK_CHARACTER (character
);
220 len
= CHAR_STRING (XFASTINT (character
), str
);
221 return make_string_from_bytes (str
, 1, len
);
224 DEFUN ("byte-to-string", Fbyte_to_string
, Sbyte_to_string
, 1, 1, 0,
225 doc
: /* Convert arg BYTE to a string containing that byte. */)
232 return make_string_from_bytes (&b
, 1, 1);
235 DEFUN ("string-to-char", Fstring_to_char
, Sstring_to_char
, 1, 1, 0,
236 doc
: /* Convert arg STRING to a character, the first character of that string.
237 A multibyte character is handled correctly. */)
239 register Lisp_Object string
;
241 register Lisp_Object val
;
242 CHECK_STRING (string
);
245 if (STRING_MULTIBYTE (string
))
246 XSETFASTINT (val
, STRING_CHAR (SDATA (string
)));
248 XSETFASTINT (val
, SREF (string
, 0));
251 XSETFASTINT (val
, 0);
256 buildmark (int charpos
, int bytepos
)
258 register Lisp_Object mark
;
259 mark
= Fmake_marker ();
260 set_marker_both (mark
, Qnil
, charpos
, bytepos
);
264 DEFUN ("point", Fpoint
, Spoint
, 0, 0, 0,
265 doc
: /* Return value of point, as an integer.
266 Beginning of buffer is position (point-min). */)
270 XSETFASTINT (temp
, PT
);
274 DEFUN ("point-marker", Fpoint_marker
, Spoint_marker
, 0, 0, 0,
275 doc
: /* Return value of point, as a marker object. */)
278 return buildmark (PT
, PT_BYTE
);
282 clip_to_bounds (int lower
, int num
, int upper
)
286 else if (num
> upper
)
292 DEFUN ("goto-char", Fgoto_char
, Sgoto_char
, 1, 1, "NGoto char: ",
293 doc
: /* Set point to POSITION, a number or marker.
294 Beginning of buffer is position (point-min), end is (point-max).
296 The return value is POSITION. */)
298 register Lisp_Object position
;
302 if (MARKERP (position
)
303 && current_buffer
== XMARKER (position
)->buffer
)
305 pos
= marker_position (position
);
307 SET_PT_BOTH (BEGV
, BEGV_BYTE
);
309 SET_PT_BOTH (ZV
, ZV_BYTE
);
311 SET_PT_BOTH (pos
, marker_byte_position (position
));
316 CHECK_NUMBER_COERCE_MARKER (position
);
318 pos
= clip_to_bounds (BEGV
, XINT (position
), ZV
);
324 /* Return the start or end position of the region.
325 BEGINNINGP non-zero means return the start.
326 If there is no region active, signal an error. */
329 region_limit (int beginningp
)
331 extern Lisp_Object Vmark_even_if_inactive
; /* Defined in callint.c. */
334 if (!NILP (Vtransient_mark_mode
)
335 && NILP (Vmark_even_if_inactive
)
336 && NILP (current_buffer
->mark_active
))
337 xsignal0 (Qmark_inactive
);
339 m
= Fmarker_position (current_buffer
->mark
);
341 error ("The mark is not set now, so there is no region");
343 if ((PT
< XFASTINT (m
)) == (beginningp
!= 0))
344 m
= make_number (PT
);
348 DEFUN ("region-beginning", Fregion_beginning
, Sregion_beginning
, 0, 0, 0,
349 doc
: /* Return position of beginning of region, as an integer. */)
352 return region_limit (1);
355 DEFUN ("region-end", Fregion_end
, Sregion_end
, 0, 0, 0,
356 doc
: /* Return position of end of region, as an integer. */)
359 return region_limit (0);
362 DEFUN ("mark-marker", Fmark_marker
, Smark_marker
, 0, 0, 0,
363 doc
: /* Return this buffer's mark, as a marker object.
364 Watch out! Moving this marker changes the mark position.
365 If you set the marker not to point anywhere, the buffer will have no mark. */)
368 return current_buffer
->mark
;
372 /* Find all the overlays in the current buffer that touch position POS.
373 Return the number found, and store them in a vector in VEC
377 overlays_around (int pos
, Lisp_Object
*vec
, int len
)
379 Lisp_Object overlay
, start
, end
;
380 struct Lisp_Overlay
*tail
;
381 int startpos
, endpos
;
384 for (tail
= current_buffer
->overlays_before
; tail
; tail
= tail
->next
)
386 XSETMISC (overlay
, tail
);
388 end
= OVERLAY_END (overlay
);
389 endpos
= OVERLAY_POSITION (end
);
392 start
= OVERLAY_START (overlay
);
393 startpos
= OVERLAY_POSITION (start
);
398 /* Keep counting overlays even if we can't return them all. */
403 for (tail
= current_buffer
->overlays_after
; tail
; tail
= tail
->next
)
405 XSETMISC (overlay
, tail
);
407 start
= OVERLAY_START (overlay
);
408 startpos
= OVERLAY_POSITION (start
);
411 end
= OVERLAY_END (overlay
);
412 endpos
= OVERLAY_POSITION (end
);
424 /* Return the value of property PROP, in OBJECT at POSITION.
425 It's the value of PROP that a char inserted at POSITION would get.
426 OBJECT is optional and defaults to the current buffer.
427 If OBJECT is a buffer, then overlay properties are considered as well as
429 If OBJECT is a window, then that window's buffer is used, but
430 window-specific overlays are considered only if they are associated
433 get_pos_property (Lisp_Object position
, register Lisp_Object prop
, Lisp_Object object
)
435 CHECK_NUMBER_COERCE_MARKER (position
);
438 XSETBUFFER (object
, current_buffer
);
439 else if (WINDOWP (object
))
440 object
= XWINDOW (object
)->buffer
;
442 if (!BUFFERP (object
))
443 /* pos-property only makes sense in buffers right now, since strings
444 have no overlays and no notion of insertion for which stickiness
446 return Fget_text_property (position
, prop
, object
);
449 int posn
= XINT (position
);
451 Lisp_Object
*overlay_vec
, tem
;
452 struct buffer
*obuf
= current_buffer
;
454 set_buffer_temp (XBUFFER (object
));
456 /* First try with room for 40 overlays. */
458 overlay_vec
= (Lisp_Object
*) alloca (noverlays
* sizeof (Lisp_Object
));
459 noverlays
= overlays_around (posn
, overlay_vec
, noverlays
);
461 /* If there are more than 40,
462 make enough space for all, and try again. */
465 overlay_vec
= (Lisp_Object
*) alloca (noverlays
* sizeof (Lisp_Object
));
466 noverlays
= overlays_around (posn
, overlay_vec
, noverlays
);
468 noverlays
= sort_overlays (overlay_vec
, noverlays
, NULL
);
470 set_buffer_temp (obuf
);
472 /* Now check the overlays in order of decreasing priority. */
473 while (--noverlays
>= 0)
475 Lisp_Object ol
= overlay_vec
[noverlays
];
476 tem
= Foverlay_get (ol
, prop
);
479 /* Check the overlay is indeed active at point. */
480 Lisp_Object start
= OVERLAY_START (ol
), finish
= OVERLAY_END (ol
);
481 if ((OVERLAY_POSITION (start
) == posn
482 && XMARKER (start
)->insertion_type
== 1)
483 || (OVERLAY_POSITION (finish
) == posn
484 && XMARKER (finish
)->insertion_type
== 0))
485 ; /* The overlay will not cover a char inserted at point. */
493 { /* Now check the text properties. */
494 int stickiness
= text_property_stickiness (prop
, position
, object
);
496 return Fget_text_property (position
, prop
, object
);
497 else if (stickiness
< 0
498 && XINT (position
) > BUF_BEGV (XBUFFER (object
)))
499 return Fget_text_property (make_number (XINT (position
) - 1),
507 /* Find the field surrounding POS in *BEG and *END. If POS is nil,
508 the value of point is used instead. If BEG or END is null,
509 means don't store the beginning or end of the field.
511 BEG_LIMIT and END_LIMIT serve to limit the ranged of the returned
512 results; they do not effect boundary behavior.
514 If MERGE_AT_BOUNDARY is nonzero, then if POS is at the very first
515 position of a field, then the beginning of the previous field is
516 returned instead of the beginning of POS's field (since the end of a
517 field is actually also the beginning of the next input field, this
518 behavior is sometimes useful). Additionally in the MERGE_AT_BOUNDARY
519 true case, if two fields are separated by a field with the special
520 value `boundary', and POS lies within it, then the two separated
521 fields are considered to be adjacent, and POS between them, when
522 finding the beginning and ending of the "merged" field.
524 Either BEG or END may be 0, in which case the corresponding value
528 find_field (Lisp_Object pos
, Lisp_Object merge_at_boundary
, Lisp_Object beg_limit
, int *beg
, Lisp_Object end_limit
, int *end
)
530 /* Fields right before and after the point. */
531 Lisp_Object before_field
, after_field
;
532 /* 1 if POS counts as the start of a field. */
533 int at_field_start
= 0;
534 /* 1 if POS counts as the end of a field. */
535 int at_field_end
= 0;
538 XSETFASTINT (pos
, PT
);
540 CHECK_NUMBER_COERCE_MARKER (pos
);
543 = get_char_property_and_overlay (pos
, Qfield
, Qnil
, NULL
);
545 = (XFASTINT (pos
) > BEGV
546 ? get_char_property_and_overlay (make_number (XINT (pos
) - 1),
548 /* Using nil here would be a more obvious choice, but it would
549 fail when the buffer starts with a non-sticky field. */
552 /* See if we need to handle the case where MERGE_AT_BOUNDARY is nil
553 and POS is at beginning of a field, which can also be interpreted
554 as the end of the previous field. Note that the case where if
555 MERGE_AT_BOUNDARY is non-nil (see function comment) is actually the
556 more natural one; then we avoid treating the beginning of a field
558 if (NILP (merge_at_boundary
))
560 Lisp_Object field
= get_pos_property (pos
, Qfield
, Qnil
);
561 if (!EQ (field
, after_field
))
563 if (!EQ (field
, before_field
))
565 if (NILP (field
) && at_field_start
&& at_field_end
)
566 /* If an inserted char would have a nil field while the surrounding
567 text is non-nil, we're probably not looking at a
568 zero-length field, but instead at a non-nil field that's
569 not intended for editing (such as comint's prompts). */
570 at_field_end
= at_field_start
= 0;
573 /* Note about special `boundary' fields:
575 Consider the case where the point (`.') is between the fields `x' and `y':
579 In this situation, if merge_at_boundary is true, we consider the
580 `x' and `y' fields as forming one big merged field, and so the end
581 of the field is the end of `y'.
583 However, if `x' and `y' are separated by a special `boundary' field
584 (a field with a `field' char-property of 'boundary), then we ignore
585 this special field when merging adjacent fields. Here's the same
586 situation, but with a `boundary' field between the `x' and `y' fields:
590 Here, if point is at the end of `x', the beginning of `y', or
591 anywhere in-between (within the `boundary' field), we merge all
592 three fields and consider the beginning as being the beginning of
593 the `x' field, and the end as being the end of the `y' field. */
598 /* POS is at the edge of a field, and we should consider it as
599 the beginning of the following field. */
600 *beg
= XFASTINT (pos
);
602 /* Find the previous field boundary. */
605 if (!NILP (merge_at_boundary
) && EQ (before_field
, Qboundary
))
606 /* Skip a `boundary' field. */
607 p
= Fprevious_single_char_property_change (p
, Qfield
, Qnil
,
610 p
= Fprevious_single_char_property_change (p
, Qfield
, Qnil
,
612 *beg
= NILP (p
) ? BEGV
: XFASTINT (p
);
619 /* POS is at the edge of a field, and we should consider it as
620 the end of the previous field. */
621 *end
= XFASTINT (pos
);
623 /* Find the next field boundary. */
625 if (!NILP (merge_at_boundary
) && EQ (after_field
, Qboundary
))
626 /* Skip a `boundary' field. */
627 pos
= Fnext_single_char_property_change (pos
, Qfield
, Qnil
,
630 pos
= Fnext_single_char_property_change (pos
, Qfield
, Qnil
,
632 *end
= NILP (pos
) ? ZV
: XFASTINT (pos
);
638 DEFUN ("delete-field", Fdelete_field
, Sdelete_field
, 0, 1, 0,
639 doc
: /* Delete the field surrounding POS.
640 A field is a region of text with the same `field' property.
641 If POS is nil, the value of point is used for POS. */)
646 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
648 del_range (beg
, end
);
652 DEFUN ("field-string", Ffield_string
, Sfield_string
, 0, 1, 0,
653 doc
: /* Return the contents of the field surrounding POS as a string.
654 A field is a region of text with the same `field' property.
655 If POS is nil, the value of point is used for POS. */)
660 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
661 return make_buffer_string (beg
, end
, 1);
664 DEFUN ("field-string-no-properties", Ffield_string_no_properties
, Sfield_string_no_properties
, 0, 1, 0,
665 doc
: /* Return the contents of the field around POS, without text properties.
666 A field is a region of text with the same `field' property.
667 If POS is nil, the value of point is used for POS. */)
672 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
673 return make_buffer_string (beg
, end
, 0);
676 DEFUN ("field-beginning", Ffield_beginning
, Sfield_beginning
, 0, 3, 0,
677 doc
: /* Return the beginning of the field surrounding POS.
678 A field is a region of text with the same `field' property.
679 If POS is nil, the value of point is used for POS.
680 If ESCAPE-FROM-EDGE is non-nil and POS is at the beginning of its
681 field, then the beginning of the *previous* field is returned.
682 If LIMIT is non-nil, it is a buffer position; if the beginning of the field
683 is before LIMIT, then LIMIT will be returned instead. */)
684 (pos
, escape_from_edge
, limit
)
685 Lisp_Object pos
, escape_from_edge
, limit
;
688 find_field (pos
, escape_from_edge
, limit
, &beg
, Qnil
, 0);
689 return make_number (beg
);
692 DEFUN ("field-end", Ffield_end
, Sfield_end
, 0, 3, 0,
693 doc
: /* Return the end of the field surrounding POS.
694 A field is a region of text with the same `field' property.
695 If POS is nil, the value of point is used for POS.
696 If ESCAPE-FROM-EDGE is non-nil and POS is at the end of its field,
697 then the end of the *following* field is returned.
698 If LIMIT is non-nil, it is a buffer position; if the end of the field
699 is after LIMIT, then LIMIT will be returned instead. */)
700 (pos
, escape_from_edge
, limit
)
701 Lisp_Object pos
, escape_from_edge
, limit
;
704 find_field (pos
, escape_from_edge
, Qnil
, 0, limit
, &end
);
705 return make_number (end
);
708 DEFUN ("constrain-to-field", Fconstrain_to_field
, Sconstrain_to_field
, 2, 5, 0,
709 doc
: /* Return the position closest to NEW-POS that is in the same field as OLD-POS.
711 A field is a region of text with the same `field' property.
712 If NEW-POS is nil, then the current point is used instead, and set to the
713 constrained position if that is different.
715 If OLD-POS is at the boundary of two fields, then the allowable
716 positions for NEW-POS depends on the value of the optional argument
717 ESCAPE-FROM-EDGE: If ESCAPE-FROM-EDGE is nil, then NEW-POS is
718 constrained to the field that has the same `field' char-property
719 as any new characters inserted at OLD-POS, whereas if ESCAPE-FROM-EDGE
720 is non-nil, NEW-POS is constrained to the union of the two adjacent
721 fields. Additionally, if two fields are separated by another field with
722 the special value `boundary', then any point within this special field is
723 also considered to be `on the boundary'.
725 If the optional argument ONLY-IN-LINE is non-nil and constraining
726 NEW-POS would move it to a different line, NEW-POS is returned
727 unconstrained. This useful for commands that move by line, like
728 \\[next-line] or \\[beginning-of-line], which should generally respect field boundaries
729 only in the case where they can still move to the right line.
731 If the optional argument INHIBIT-CAPTURE-PROPERTY is non-nil, and OLD-POS has
732 a non-nil property of that name, then any field boundaries are ignored.
734 Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil. */)
735 (new_pos
, old_pos
, escape_from_edge
, only_in_line
, inhibit_capture_property
)
736 Lisp_Object new_pos
, old_pos
;
737 Lisp_Object escape_from_edge
, only_in_line
, inhibit_capture_property
;
739 /* If non-zero, then the original point, before re-positioning. */
742 Lisp_Object prev_old
, prev_new
;
745 /* Use the current point, and afterwards, set it. */
748 XSETFASTINT (new_pos
, PT
);
751 CHECK_NUMBER_COERCE_MARKER (new_pos
);
752 CHECK_NUMBER_COERCE_MARKER (old_pos
);
754 fwd
= (XFASTINT (new_pos
) > XFASTINT (old_pos
));
756 prev_old
= make_number (XFASTINT (old_pos
) - 1);
757 prev_new
= make_number (XFASTINT (new_pos
) - 1);
759 if (NILP (Vinhibit_field_text_motion
)
760 && !EQ (new_pos
, old_pos
)
761 && (!NILP (Fget_char_property (new_pos
, Qfield
, Qnil
))
762 || !NILP (Fget_char_property (old_pos
, Qfield
, Qnil
))
763 /* To recognize field boundaries, we must also look at the
764 previous positions; we could use `get_pos_property'
765 instead, but in itself that would fail inside non-sticky
766 fields (like comint prompts). */
767 || (XFASTINT (new_pos
) > BEGV
768 && !NILP (Fget_char_property (prev_new
, Qfield
, Qnil
)))
769 || (XFASTINT (old_pos
) > BEGV
770 && !NILP (Fget_char_property (prev_old
, Qfield
, Qnil
))))
771 && (NILP (inhibit_capture_property
)
772 /* Field boundaries are again a problem; but now we must
773 decide the case exactly, so we need to call
774 `get_pos_property' as well. */
775 || (NILP (get_pos_property (old_pos
, inhibit_capture_property
, Qnil
))
776 && (XFASTINT (old_pos
) <= BEGV
777 || NILP (Fget_char_property (old_pos
, inhibit_capture_property
, Qnil
))
778 || NILP (Fget_char_property (prev_old
, inhibit_capture_property
, Qnil
))))))
779 /* It is possible that NEW_POS is not within the same field as
780 OLD_POS; try to move NEW_POS so that it is. */
783 Lisp_Object field_bound
;
786 field_bound
= Ffield_end (old_pos
, escape_from_edge
, new_pos
);
788 field_bound
= Ffield_beginning (old_pos
, escape_from_edge
, new_pos
);
790 if (/* See if ESCAPE_FROM_EDGE caused FIELD_BOUND to jump to the
791 other side of NEW_POS, which would mean that NEW_POS is
792 already acceptable, and it's not necessary to constrain it
794 ((XFASTINT (field_bound
) < XFASTINT (new_pos
)) ? fwd
: !fwd
)
795 /* NEW_POS should be constrained, but only if either
796 ONLY_IN_LINE is nil (in which case any constraint is OK),
797 or NEW_POS and FIELD_BOUND are on the same line (in which
798 case the constraint is OK even if ONLY_IN_LINE is non-nil). */
799 && (NILP (only_in_line
)
800 /* This is the ONLY_IN_LINE case, check that NEW_POS and
801 FIELD_BOUND are on the same line by seeing whether
802 there's an intervening newline or not. */
803 || (scan_buffer ('\n',
804 XFASTINT (new_pos
), XFASTINT (field_bound
),
805 fwd
? -1 : 1, &shortage
, 1),
807 /* Constrain NEW_POS to FIELD_BOUND. */
808 new_pos
= field_bound
;
810 if (orig_point
&& XFASTINT (new_pos
) != orig_point
)
811 /* The NEW_POS argument was originally nil, so automatically set PT. */
812 SET_PT (XFASTINT (new_pos
));
819 DEFUN ("line-beginning-position",
820 Fline_beginning_position
, Sline_beginning_position
, 0, 1, 0,
821 doc
: /* Return the character position of the first character on the current line.
822 With argument N not nil or 1, move forward N - 1 lines first.
823 If scan reaches end of buffer, return that position.
825 This function constrains the returned position to the current field
826 unless that would be on a different line than the original,
827 unconstrained result. If N is nil or 1, and a front-sticky field
828 starts at point, the scan stops as soon as it starts. To ignore field
829 boundaries bind `inhibit-field-text-motion' to t.
831 This function does not move point. */)
835 int orig
, orig_byte
, end
;
836 int count
= SPECPDL_INDEX ();
837 specbind (Qinhibit_point_motion_hooks
, Qt
);
846 Fforward_line (make_number (XINT (n
) - 1));
849 SET_PT_BOTH (orig
, orig_byte
);
851 unbind_to (count
, Qnil
);
853 /* Return END constrained to the current input field. */
854 return Fconstrain_to_field (make_number (end
), make_number (orig
),
855 XINT (n
) != 1 ? Qt
: Qnil
,
859 DEFUN ("line-end-position", Fline_end_position
, Sline_end_position
, 0, 1, 0,
860 doc
: /* Return the character position of the last character on the current line.
861 With argument N not nil or 1, move forward N - 1 lines first.
862 If scan reaches end of buffer, return that position.
864 This function constrains the returned position to the current field
865 unless that would be on a different line than the original,
866 unconstrained result. If N is nil or 1, and a rear-sticky field ends
867 at point, the scan stops as soon as it starts. To ignore field
868 boundaries bind `inhibit-field-text-motion' to t.
870 This function does not move point. */)
882 end_pos
= find_before_next_newline (orig
, 0, XINT (n
) - (XINT (n
) <= 0));
884 /* Return END_POS constrained to the current input field. */
885 return Fconstrain_to_field (make_number (end_pos
), make_number (orig
),
891 save_excursion_save (void)
893 int visible
= (XBUFFER (XWINDOW (selected_window
)->buffer
)
896 return Fcons (Fpoint_marker (),
897 Fcons (Fcopy_marker (current_buffer
->mark
, Qnil
),
898 Fcons (visible
? Qt
: Qnil
,
899 Fcons (current_buffer
->mark_active
,
904 save_excursion_restore (Lisp_Object info
)
906 Lisp_Object tem
, tem1
, omark
, nmark
;
907 struct gcpro gcpro1
, gcpro2
, gcpro3
;
910 tem
= Fmarker_buffer (XCAR (info
));
911 /* If buffer being returned to is now deleted, avoid error */
912 /* Otherwise could get error here while unwinding to top level
914 /* In that case, Fmarker_buffer returns nil now. */
918 omark
= nmark
= Qnil
;
919 GCPRO3 (info
, omark
, nmark
);
926 unchain_marker (XMARKER (tem
));
931 omark
= Fmarker_position (current_buffer
->mark
);
932 Fset_marker (current_buffer
->mark
, tem
, Fcurrent_buffer ());
933 nmark
= Fmarker_position (tem
);
934 unchain_marker (XMARKER (tem
));
938 visible_p
= !NILP (XCAR (info
));
940 #if 0 /* We used to make the current buffer visible in the selected window
941 if that was true previously. That avoids some anomalies.
942 But it creates others, and it wasn't documented, and it is simpler
943 and cleaner never to alter the window/buffer connections. */
946 && current_buffer
!= XBUFFER (XWINDOW (selected_window
)->buffer
))
947 Fswitch_to_buffer (Fcurrent_buffer (), Qnil
);
953 tem1
= current_buffer
->mark_active
;
954 current_buffer
->mark_active
= tem
;
956 if (!NILP (Vrun_hooks
))
958 /* If mark is active now, and either was not active
959 or was at a different place, run the activate hook. */
960 if (! NILP (current_buffer
->mark_active
))
962 if (! EQ (omark
, nmark
))
963 call1 (Vrun_hooks
, intern ("activate-mark-hook"));
965 /* If mark has ceased to be active, run deactivate hook. */
966 else if (! NILP (tem1
))
967 call1 (Vrun_hooks
, intern ("deactivate-mark-hook"));
970 /* If buffer was visible in a window, and a different window was
971 selected, and the old selected window is still showing this
972 buffer, restore point in that window. */
975 && !EQ (tem
, selected_window
)
976 && (tem1
= XWINDOW (tem
)->buffer
,
977 (/* Window is live... */
979 /* ...and it shows the current buffer. */
980 && XBUFFER (tem1
) == current_buffer
)))
981 Fset_window_point (tem
, make_number (PT
));
987 DEFUN ("save-excursion", Fsave_excursion
, Ssave_excursion
, 0, UNEVALLED
, 0,
988 doc
: /* Save point, mark, and current buffer; execute BODY; restore those things.
989 Executes BODY just like `progn'.
990 The values of point, mark and the current buffer are restored
991 even in case of abnormal exit (throw or error).
992 The state of activation of the mark is also restored.
994 This construct does not save `deactivate-mark', and therefore
995 functions that change the buffer will still cause deactivation
996 of the mark at the end of the command. To prevent that, bind
997 `deactivate-mark' with `let'.
999 If you only want to save the current buffer but not point nor mark,
1000 then just use `save-current-buffer', or even `with-current-buffer'.
1002 usage: (save-excursion &rest BODY) */)
1006 register Lisp_Object val
;
1007 int count
= SPECPDL_INDEX ();
1009 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1011 val
= Fprogn (args
);
1012 return unbind_to (count
, val
);
1015 DEFUN ("save-current-buffer", Fsave_current_buffer
, Ssave_current_buffer
, 0, UNEVALLED
, 0,
1016 doc
: /* Save the current buffer; execute BODY; restore the current buffer.
1017 Executes BODY just like `progn'.
1018 usage: (save-current-buffer &rest BODY) */)
1023 int count
= SPECPDL_INDEX ();
1025 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
1027 val
= Fprogn (args
);
1028 return unbind_to (count
, val
);
1031 DEFUN ("buffer-size", Fbufsize
, Sbufsize
, 0, 1, 0,
1032 doc
: /* Return the number of characters in the current buffer.
1033 If BUFFER, return the number of characters in that buffer instead. */)
1038 return make_number (Z
- BEG
);
1041 CHECK_BUFFER (buffer
);
1042 return make_number (BUF_Z (XBUFFER (buffer
))
1043 - BUF_BEG (XBUFFER (buffer
)));
1047 DEFUN ("point-min", Fpoint_min
, Spoint_min
, 0, 0, 0,
1048 doc
: /* Return the minimum permissible value of point in the current buffer.
1049 This is 1, unless narrowing (a buffer restriction) is in effect. */)
1053 XSETFASTINT (temp
, BEGV
);
1057 DEFUN ("point-min-marker", Fpoint_min_marker
, Spoint_min_marker
, 0, 0, 0,
1058 doc
: /* Return a marker to the minimum permissible value of point in this buffer.
1059 This is the beginning, unless narrowing (a buffer restriction) is in effect. */)
1062 return buildmark (BEGV
, BEGV_BYTE
);
1065 DEFUN ("point-max", Fpoint_max
, Spoint_max
, 0, 0, 0,
1066 doc
: /* Return the maximum permissible value of point in the current buffer.
1067 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
1068 is in effect, in which case it is less. */)
1072 XSETFASTINT (temp
, ZV
);
1076 DEFUN ("point-max-marker", Fpoint_max_marker
, Spoint_max_marker
, 0, 0, 0,
1077 doc
: /* Return a marker to the maximum permissible value of point in this buffer.
1078 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
1079 is in effect, in which case it is less. */)
1082 return buildmark (ZV
, ZV_BYTE
);
1085 DEFUN ("gap-position", Fgap_position
, Sgap_position
, 0, 0, 0,
1086 doc
: /* Return the position of the gap, in the current buffer.
1087 See also `gap-size'. */)
1091 XSETFASTINT (temp
, GPT
);
1095 DEFUN ("gap-size", Fgap_size
, Sgap_size
, 0, 0, 0,
1096 doc
: /* Return the size of the current buffer's gap.
1097 See also `gap-position'. */)
1101 XSETFASTINT (temp
, GAP_SIZE
);
1105 DEFUN ("position-bytes", Fposition_bytes
, Sposition_bytes
, 1, 1, 0,
1106 doc
: /* Return the byte position for character position POSITION.
1107 If POSITION is out of range, the value is nil. */)
1109 Lisp_Object position
;
1111 CHECK_NUMBER_COERCE_MARKER (position
);
1112 if (XINT (position
) < BEG
|| XINT (position
) > Z
)
1114 return make_number (CHAR_TO_BYTE (XINT (position
)));
1117 DEFUN ("byte-to-position", Fbyte_to_position
, Sbyte_to_position
, 1, 1, 0,
1118 doc
: /* Return the character position for byte position BYTEPOS.
1119 If BYTEPOS is out of range, the value is nil. */)
1121 Lisp_Object bytepos
;
1123 CHECK_NUMBER (bytepos
);
1124 if (XINT (bytepos
) < BEG_BYTE
|| XINT (bytepos
) > Z_BYTE
)
1126 return make_number (BYTE_TO_CHAR (XINT (bytepos
)));
1129 DEFUN ("following-char", Ffollowing_char
, Sfollowing_char
, 0, 0, 0,
1130 doc
: /* Return the character following point, as a number.
1131 At the end of the buffer or accessible region, return 0. */)
1136 XSETFASTINT (temp
, 0);
1138 XSETFASTINT (temp
, FETCH_CHAR (PT_BYTE
));
1142 DEFUN ("preceding-char", Fprevious_char
, Sprevious_char
, 0, 0, 0,
1143 doc
: /* Return the character preceding point, as a number.
1144 At the beginning of the buffer or accessible region, return 0. */)
1149 XSETFASTINT (temp
, 0);
1150 else if (!NILP (current_buffer
->enable_multibyte_characters
))
1154 XSETFASTINT (temp
, FETCH_CHAR (pos
));
1157 XSETFASTINT (temp
, FETCH_BYTE (PT_BYTE
- 1));
1161 DEFUN ("bobp", Fbobp
, Sbobp
, 0, 0, 0,
1162 doc
: /* Return t if point is at the beginning of the buffer.
1163 If the buffer is narrowed, this means the beginning of the narrowed part. */)
1171 DEFUN ("eobp", Feobp
, Seobp
, 0, 0, 0,
1172 doc
: /* Return t if point is at the end of the buffer.
1173 If the buffer is narrowed, this means the end of the narrowed part. */)
1181 DEFUN ("bolp", Fbolp
, Sbolp
, 0, 0, 0,
1182 doc
: /* Return t if point is at the beginning of a line. */)
1185 if (PT
== BEGV
|| FETCH_BYTE (PT_BYTE
- 1) == '\n')
1190 DEFUN ("eolp", Feolp
, Seolp
, 0, 0, 0,
1191 doc
: /* Return t if point is at the end of a line.
1192 `End of a line' includes point being at the end of the buffer. */)
1195 if (PT
== ZV
|| FETCH_BYTE (PT_BYTE
) == '\n')
1200 DEFUN ("char-after", Fchar_after
, Schar_after
, 0, 1, 0,
1201 doc
: /* Return character in current buffer at position POS.
1202 POS is an integer or a marker and defaults to point.
1203 If POS is out of range, the value is nil. */)
1207 register int pos_byte
;
1212 XSETFASTINT (pos
, PT
);
1217 pos_byte
= marker_byte_position (pos
);
1218 if (pos_byte
< BEGV_BYTE
|| pos_byte
>= ZV_BYTE
)
1223 CHECK_NUMBER_COERCE_MARKER (pos
);
1224 if (XINT (pos
) < BEGV
|| XINT (pos
) >= ZV
)
1227 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
1230 return make_number (FETCH_CHAR (pos_byte
));
1233 DEFUN ("char-before", Fchar_before
, Schar_before
, 0, 1, 0,
1234 doc
: /* Return character in current buffer preceding position POS.
1235 POS is an integer or a marker and defaults to point.
1236 If POS is out of range, the value is nil. */)
1240 register Lisp_Object val
;
1241 register int pos_byte
;
1246 XSETFASTINT (pos
, PT
);
1251 pos_byte
= marker_byte_position (pos
);
1253 if (pos_byte
<= BEGV_BYTE
|| pos_byte
> ZV_BYTE
)
1258 CHECK_NUMBER_COERCE_MARKER (pos
);
1260 if (XINT (pos
) <= BEGV
|| XINT (pos
) > ZV
)
1263 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
1266 if (!NILP (current_buffer
->enable_multibyte_characters
))
1269 XSETFASTINT (val
, FETCH_CHAR (pos_byte
));
1274 XSETFASTINT (val
, FETCH_BYTE (pos_byte
));
1279 DEFUN ("user-login-name", Fuser_login_name
, Suser_login_name
, 0, 1, 0,
1280 doc
: /* Return the name under which the user logged in, as a string.
1281 This is based on the effective uid, not the real uid.
1282 Also, if the environment variables LOGNAME or USER are set,
1283 that determines the value of this function.
1285 If optional argument UID is an integer or a float, return the login name
1286 of the user with that uid, or nil if there is no such user. */)
1293 /* Set up the user name info if we didn't do it before.
1294 (That can happen if Emacs is dumpable
1295 but you decide to run `temacs -l loadup' and not dump. */
1296 if (INTEGERP (Vuser_login_name
))
1300 return Vuser_login_name
;
1302 id
= (uid_t
)XFLOATINT (uid
);
1304 pw
= (struct passwd
*) getpwuid (id
);
1306 return (pw
? build_string (pw
->pw_name
) : Qnil
);
1309 DEFUN ("user-real-login-name", Fuser_real_login_name
, Suser_real_login_name
,
1311 doc
: /* Return the name of the user's real uid, as a string.
1312 This ignores the environment variables LOGNAME and USER, so it differs from
1313 `user-login-name' when running under `su'. */)
1316 /* Set up the user name info if we didn't do it before.
1317 (That can happen if Emacs is dumpable
1318 but you decide to run `temacs -l loadup' and not dump. */
1319 if (INTEGERP (Vuser_login_name
))
1321 return Vuser_real_login_name
;
1324 DEFUN ("user-uid", Fuser_uid
, Suser_uid
, 0, 0, 0,
1325 doc
: /* Return the effective uid of Emacs.
1326 Value is an integer or a float, depending on the value. */)
1329 /* Assignment to EMACS_INT stops GCC whining about limited range of
1331 EMACS_INT euid
= geteuid ();
1333 /* Make sure we don't produce a negative UID due to signed integer
1336 return make_float ((double)geteuid ());
1337 return make_fixnum_or_float (euid
);
1340 DEFUN ("user-real-uid", Fuser_real_uid
, Suser_real_uid
, 0, 0, 0,
1341 doc
: /* Return the real uid of Emacs.
1342 Value is an integer or a float, depending on the value. */)
1345 /* Assignment to EMACS_INT stops GCC whining about limited range of
1347 EMACS_INT uid
= getuid ();
1349 /* Make sure we don't produce a negative UID due to signed integer
1352 return make_float ((double)getuid ());
1353 return make_fixnum_or_float (uid
);
1356 DEFUN ("user-full-name", Fuser_full_name
, Suser_full_name
, 0, 1, 0,
1357 doc
: /* Return the full name of the user logged in, as a string.
1358 If the full name corresponding to Emacs's userid is not known,
1361 If optional argument UID is an integer or float, return the full name
1362 of the user with that uid, or nil if there is no such user.
1363 If UID is a string, return the full name of the user with that login
1364 name, or nil if there is no such user. */)
1369 register unsigned char *p
, *q
;
1373 return Vuser_full_name
;
1374 else if (NUMBERP (uid
))
1377 pw
= (struct passwd
*) getpwuid ((uid_t
) XFLOATINT (uid
));
1380 else if (STRINGP (uid
))
1383 pw
= (struct passwd
*) getpwnam (SDATA (uid
));
1387 error ("Invalid UID specification");
1392 p
= (unsigned char *) USER_FULL_NAME
;
1393 /* Chop off everything after the first comma. */
1394 q
= (unsigned char *) index (p
, ',');
1395 full
= make_string (p
, q
? q
- p
: strlen (p
));
1397 #ifdef AMPERSAND_FULL_NAME
1399 q
= (unsigned char *) index (p
, '&');
1400 /* Substitute the login name for the &, upcasing the first character. */
1403 register unsigned char *r
;
1406 login
= Fuser_login_name (make_number (pw
->pw_uid
));
1407 r
= (unsigned char *) alloca (strlen (p
) + SCHARS (login
) + 1);
1408 memcpy (r
, p
, q
- p
);
1410 strcat (r
, SDATA (login
));
1411 r
[q
- p
] = UPCASE (r
[q
- p
]);
1413 full
= build_string (r
);
1415 #endif /* AMPERSAND_FULL_NAME */
1420 DEFUN ("system-name", Fsystem_name
, Ssystem_name
, 0, 0, 0,
1421 doc
: /* Return the host name of the machine you are running on, as a string. */)
1424 return Vsystem_name
;
1427 /* For the benefit of callers who don't want to include lisp.h */
1430 get_system_name (void)
1432 if (STRINGP (Vsystem_name
))
1433 return (char *) SDATA (Vsystem_name
);
1439 get_operating_system_release (void)
1441 if (STRINGP (Voperating_system_release
))
1442 return (char *) SDATA (Voperating_system_release
);
1447 DEFUN ("emacs-pid", Femacs_pid
, Semacs_pid
, 0, 0, 0,
1448 doc
: /* Return the process ID of Emacs, as an integer. */)
1451 return make_number (getpid ());
1454 DEFUN ("current-time", Fcurrent_time
, Scurrent_time
, 0, 0, 0,
1455 doc
: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00.
1456 The time is returned as a list of three integers. The first has the
1457 most significant 16 bits of the seconds, while the second has the
1458 least significant 16 bits. The third integer gives the microsecond
1461 The microsecond count is zero on systems that do not provide
1462 resolution finer than a second. */)
1468 return list3 (make_number ((EMACS_SECS (t
) >> 16) & 0xffff),
1469 make_number ((EMACS_SECS (t
) >> 0) & 0xffff),
1470 make_number (EMACS_USECS (t
)));
1473 DEFUN ("get-internal-run-time", Fget_internal_run_time
, Sget_internal_run_time
,
1475 doc
: /* Return the current run time used by Emacs.
1476 The time is returned as a list of three integers. The first has the
1477 most significant 16 bits of the seconds, while the second has the
1478 least significant 16 bits. The third integer gives the microsecond
1481 On systems that can't determine the run time, `get-internal-run-time'
1482 does the same thing as `current-time'. The microsecond count is zero
1483 on systems that do not provide resolution finer than a second. */)
1486 #ifdef HAVE_GETRUSAGE
1487 struct rusage usage
;
1490 if (getrusage (RUSAGE_SELF
, &usage
) < 0)
1491 /* This shouldn't happen. What action is appropriate? */
1494 /* Sum up user time and system time. */
1495 secs
= usage
.ru_utime
.tv_sec
+ usage
.ru_stime
.tv_sec
;
1496 usecs
= usage
.ru_utime
.tv_usec
+ usage
.ru_stime
.tv_usec
;
1497 if (usecs
>= 1000000)
1503 return list3 (make_number ((secs
>> 16) & 0xffff),
1504 make_number ((secs
>> 0) & 0xffff),
1505 make_number (usecs
));
1506 #else /* ! HAVE_GETRUSAGE */
1508 return w32_get_internal_run_time ();
1509 #else /* ! WINDOWSNT */
1510 return Fcurrent_time ();
1511 #endif /* WINDOWSNT */
1512 #endif /* HAVE_GETRUSAGE */
1517 lisp_time_argument (Lisp_Object specified_time
, time_t *result
, int *usec
)
1519 if (NILP (specified_time
))
1526 *usec
= EMACS_USECS (t
);
1527 *result
= EMACS_SECS (t
);
1531 return time (result
) != -1;
1535 Lisp_Object high
, low
;
1536 high
= Fcar (specified_time
);
1537 CHECK_NUMBER (high
);
1538 low
= Fcdr (specified_time
);
1543 Lisp_Object usec_l
= Fcdr (low
);
1545 usec_l
= Fcar (usec_l
);
1550 CHECK_NUMBER (usec_l
);
1551 *usec
= XINT (usec_l
);
1559 *result
= (XINT (high
) << 16) + (XINT (low
) & 0xffff);
1560 return *result
>> 16 == XINT (high
);
1564 DEFUN ("float-time", Ffloat_time
, Sfloat_time
, 0, 1, 0,
1565 doc
: /* Return the current time, as a float number of seconds since the epoch.
1566 If SPECIFIED-TIME is given, it is the time to convert to float
1567 instead of the current time. The argument should have the form
1568 (HIGH LOW) or (HIGH LOW USEC). Thus, you can use times obtained from
1569 `current-time' and from `file-attributes'. SPECIFIED-TIME can also
1570 have the form (HIGH . LOW), but this is considered obsolete.
1572 WARNING: Since the result is floating point, it may not be exact.
1573 If precise time stamps are required, use either `current-time',
1574 or (if you need time as a string) `format-time-string'. */)
1576 Lisp_Object specified_time
;
1581 if (! lisp_time_argument (specified_time
, &sec
, &usec
))
1582 error ("Invalid time specification");
1584 return make_float ((sec
* 1e6
+ usec
) / 1e6
);
1587 /* Write information into buffer S of size MAXSIZE, according to the
1588 FORMAT of length FORMAT_LEN, using time information taken from *TP.
1589 Default to Universal Time if UT is nonzero, local time otherwise.
1590 Return the number of bytes written, not including the terminating
1591 '\0'. If S is NULL, nothing will be written anywhere; so to
1592 determine how many bytes would be written, use NULL for S and
1593 ((size_t) -1) for MAXSIZE.
1595 This function behaves like emacs_strftimeu, except it allows null
1598 emacs_memftimeu (char *s
, size_t maxsize
, const char *format
, size_t format_len
, const struct tm
*tp
, int ut
)
1602 /* Loop through all the null-terminated strings in the format
1603 argument. Normally there's just one null-terminated string, but
1604 there can be arbitrarily many, concatenated together, if the
1605 format contains '\0' bytes. emacs_strftimeu stops at the first
1606 '\0' byte so we must invoke it separately for each such string. */
1615 result
= emacs_strftimeu (s
, maxsize
, format
, tp
, ut
);
1619 if (result
== 0 && s
[0] != '\0')
1624 maxsize
-= result
+ 1;
1626 len
= strlen (format
);
1627 if (len
== format_len
)
1631 format_len
-= len
+ 1;
1635 DEFUN ("format-time-string", Fformat_time_string
, Sformat_time_string
, 1, 3, 0,
1636 doc
: /* Use FORMAT-STRING to format the time TIME, or now if omitted.
1637 TIME is specified as (HIGH LOW . IGNORED), as returned by
1638 `current-time' or `file-attributes'. The obsolete form (HIGH . LOW)
1639 is also still accepted.
1640 The third, optional, argument UNIVERSAL, if non-nil, means describe TIME
1641 as Universal Time; nil means describe TIME in the local time zone.
1642 The value is a copy of FORMAT-STRING, but with certain constructs replaced
1643 by text that describes the specified date and time in TIME:
1645 %Y is the year, %y within the century, %C the century.
1646 %G is the year corresponding to the ISO week, %g within the century.
1647 %m is the numeric month.
1648 %b and %h are the locale's abbreviated month name, %B the full name.
1649 %d is the day of the month, zero-padded, %e is blank-padded.
1650 %u is the numeric day of week from 1 (Monday) to 7, %w from 0 (Sunday) to 6.
1651 %a is the locale's abbreviated name of the day of week, %A the full name.
1652 %U is the week number starting on Sunday, %W starting on Monday,
1653 %V according to ISO 8601.
1654 %j is the day of the year.
1656 %H is the hour on a 24-hour clock, %I is on a 12-hour clock, %k is like %H
1657 only blank-padded, %l is like %I blank-padded.
1658 %p is the locale's equivalent of either AM or PM.
1661 %Z is the time zone name, %z is the numeric form.
1662 %s is the number of seconds since 1970-01-01 00:00:00 +0000.
1664 %c is the locale's date and time format.
1665 %x is the locale's "preferred" date format.
1666 %D is like "%m/%d/%y".
1668 %R is like "%H:%M", %T is like "%H:%M:%S", %r is like "%I:%M:%S %p".
1669 %X is the locale's "preferred" time format.
1671 Finally, %n is a newline, %t is a tab, %% is a literal %.
1673 Certain flags and modifiers are available with some format controls.
1674 The flags are `_', `-', `^' and `#'. For certain characters X,
1675 %_X is like %X, but padded with blanks; %-X is like %X,
1676 but without padding. %^X is like %X, but with all textual
1677 characters up-cased; %#X is like %X, but with letter-case of
1678 all textual characters reversed.
1679 %NX (where N stands for an integer) is like %X,
1680 but takes up at least N (a number) positions.
1681 The modifiers are `E' and `O'. For certain characters X,
1682 %EX is a locale's alternative version of %X;
1683 %OX is like %X, but uses the locale's number symbols.
1685 For example, to produce full ISO 8601 format, use "%Y-%m-%dT%T%z". */)
1686 (format_string
, time
, universal
)
1687 Lisp_Object format_string
, time
, universal
;
1692 int ut
= ! NILP (universal
);
1694 CHECK_STRING (format_string
);
1696 if (! lisp_time_argument (time
, &value
, NULL
))
1697 error ("Invalid time specification");
1699 format_string
= code_convert_string_norecord (format_string
,
1700 Vlocale_coding_system
, 1);
1702 /* This is probably enough. */
1703 size
= SBYTES (format_string
) * 6 + 50;
1706 tm
= ut
? gmtime (&value
) : localtime (&value
);
1709 error ("Specified time is not representable");
1711 synchronize_system_time_locale ();
1715 char *buf
= (char *) alloca (size
+ 1);
1720 result
= emacs_memftimeu (buf
, size
, SDATA (format_string
),
1721 SBYTES (format_string
),
1724 if ((result
> 0 && result
< size
) || (result
== 0 && buf
[0] == '\0'))
1725 return code_convert_string_norecord (make_unibyte_string (buf
, result
),
1726 Vlocale_coding_system
, 0);
1728 /* If buffer was too small, make it bigger and try again. */
1730 result
= emacs_memftimeu (NULL
, (size_t) -1,
1731 SDATA (format_string
),
1732 SBYTES (format_string
),
1739 DEFUN ("decode-time", Fdecode_time
, Sdecode_time
, 0, 1, 0,
1740 doc
: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).
1741 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED),
1742 as from `current-time' and `file-attributes', or nil to use the
1743 current time. The obsolete form (HIGH . LOW) is also still accepted.
1744 The list has the following nine members: SEC is an integer between 0
1745 and 60; SEC is 60 for a leap second, which only some operating systems
1746 support. MINUTE is an integer between 0 and 59. HOUR is an integer
1747 between 0 and 23. DAY is an integer between 1 and 31. MONTH is an
1748 integer between 1 and 12. YEAR is an integer indicating the
1749 four-digit year. DOW is the day of week, an integer between 0 and 6,
1750 where 0 is Sunday. DST is t if daylight saving time is in effect,
1751 otherwise nil. ZONE is an integer indicating the number of seconds
1752 east of Greenwich. (Note that Common Lisp has different meanings for
1755 Lisp_Object specified_time
;
1759 struct tm
*decoded_time
;
1760 Lisp_Object list_args
[9];
1762 if (! lisp_time_argument (specified_time
, &time_spec
, NULL
))
1763 error ("Invalid time specification");
1766 decoded_time
= localtime (&time_spec
);
1769 error ("Specified time is not representable");
1770 XSETFASTINT (list_args
[0], decoded_time
->tm_sec
);
1771 XSETFASTINT (list_args
[1], decoded_time
->tm_min
);
1772 XSETFASTINT (list_args
[2], decoded_time
->tm_hour
);
1773 XSETFASTINT (list_args
[3], decoded_time
->tm_mday
);
1774 XSETFASTINT (list_args
[4], decoded_time
->tm_mon
+ 1);
1775 /* On 64-bit machines an int is narrower than EMACS_INT, thus the
1776 cast below avoids overflow in int arithmetics. */
1777 XSETINT (list_args
[5], TM_YEAR_BASE
+ (EMACS_INT
) decoded_time
->tm_year
);
1778 XSETFASTINT (list_args
[6], decoded_time
->tm_wday
);
1779 list_args
[7] = (decoded_time
->tm_isdst
)? Qt
: Qnil
;
1781 /* Make a copy, in case gmtime modifies the struct. */
1782 save_tm
= *decoded_time
;
1784 decoded_time
= gmtime (&time_spec
);
1786 if (decoded_time
== 0)
1787 list_args
[8] = Qnil
;
1789 XSETINT (list_args
[8], tm_diff (&save_tm
, decoded_time
));
1790 return Flist (9, list_args
);
1793 DEFUN ("encode-time", Fencode_time
, Sencode_time
, 6, MANY
, 0,
1794 doc
: /* Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
1795 This is the reverse operation of `decode-time', which see.
1796 ZONE defaults to the current time zone rule. This can
1797 be a string or t (as from `set-time-zone-rule'), or it can be a list
1798 \(as from `current-time-zone') or an integer (as from `decode-time')
1799 applied without consideration for daylight saving time.
1801 You can pass more than 7 arguments; then the first six arguments
1802 are used as SECOND through YEAR, and the *last* argument is used as ZONE.
1803 The intervening arguments are ignored.
1804 This feature lets (apply 'encode-time (decode-time ...)) work.
1806 Out-of-range values for SECOND, MINUTE, HOUR, DAY, or MONTH are allowed;
1807 for example, a DAY of 0 means the day preceding the given month.
1808 Year numbers less than 100 are treated just like other year numbers.
1809 If you want them to stand for years in this century, you must do that yourself.
1811 Years before 1970 are not guaranteed to work. On some systems,
1812 year values as low as 1901 do work.
1814 usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */)
1817 register Lisp_Object
*args
;
1821 Lisp_Object zone
= (nargs
> 6 ? args
[nargs
- 1] : Qnil
);
1823 CHECK_NUMBER (args
[0]); /* second */
1824 CHECK_NUMBER (args
[1]); /* minute */
1825 CHECK_NUMBER (args
[2]); /* hour */
1826 CHECK_NUMBER (args
[3]); /* day */
1827 CHECK_NUMBER (args
[4]); /* month */
1828 CHECK_NUMBER (args
[5]); /* year */
1830 tm
.tm_sec
= XINT (args
[0]);
1831 tm
.tm_min
= XINT (args
[1]);
1832 tm
.tm_hour
= XINT (args
[2]);
1833 tm
.tm_mday
= XINT (args
[3]);
1834 tm
.tm_mon
= XINT (args
[4]) - 1;
1835 tm
.tm_year
= XINT (args
[5]) - TM_YEAR_BASE
;
1843 time
= mktime (&tm
);
1850 char **oldenv
= environ
, **newenv
;
1854 else if (STRINGP (zone
))
1855 tzstring
= (char *) SDATA (zone
);
1856 else if (INTEGERP (zone
))
1858 int abszone
= eabs (XINT (zone
));
1859 sprintf (tzbuf
, "XXX%s%d:%02d:%02d", "-" + (XINT (zone
) < 0),
1860 abszone
/ (60*60), (abszone
/60) % 60, abszone
% 60);
1864 error ("Invalid time zone specification");
1866 /* Set TZ before calling mktime; merely adjusting mktime's returned
1867 value doesn't suffice, since that would mishandle leap seconds. */
1868 set_time_zone_rule (tzstring
);
1871 time
= mktime (&tm
);
1874 /* Restore TZ to previous value. */
1878 #ifdef LOCALTIME_CACHE
1883 if (time
== (time_t) -1)
1884 error ("Specified time is not representable");
1886 return make_time (time
);
1889 DEFUN ("current-time-string", Fcurrent_time_string
, Scurrent_time_string
, 0, 1, 0,
1890 doc
: /* Return the current local time, as a human-readable string.
1891 Programs can use this function to decode a time,
1892 since the number of columns in each field is fixed
1893 if the year is in the range 1000-9999.
1894 The format is `Sun Sep 16 01:03:52 1973'.
1895 However, see also the functions `decode-time' and `format-time-string'
1896 which provide a much more powerful and general facility.
1898 If SPECIFIED-TIME is given, it is a time to format instead of the
1899 current time. The argument should have the form (HIGH LOW . IGNORED).
1900 Thus, you can use times obtained from `current-time' and from
1901 `file-attributes'. SPECIFIED-TIME can also have the form (HIGH . LOW),
1902 but this is considered obsolete. */)
1904 Lisp_Object specified_time
;
1910 if (! lisp_time_argument (specified_time
, &value
, NULL
))
1911 error ("Invalid time specification");
1913 /* Convert to a string, checking for out-of-range time stamps.
1914 Don't use 'ctime', as that might dump core if VALUE is out of
1917 tm
= localtime (&value
);
1919 if (! (tm
&& TM_YEAR_IN_ASCTIME_RANGE (tm
->tm_year
) && (tem
= asctime (tm
))))
1920 error ("Specified time is not representable");
1922 /* Remove the trailing newline. */
1923 tem
[strlen (tem
) - 1] = '\0';
1925 return build_string (tem
);
1928 /* Yield A - B, measured in seconds.
1929 This function is copied from the GNU C Library. */
1931 tm_diff (struct tm
*a
, struct tm
*b
)
1933 /* Compute intervening leap days correctly even if year is negative.
1934 Take care to avoid int overflow in leap day calculations,
1935 but it's OK to assume that A and B are close to each other. */
1936 int a4
= (a
->tm_year
>> 2) + (TM_YEAR_BASE
>> 2) - ! (a
->tm_year
& 3);
1937 int b4
= (b
->tm_year
>> 2) + (TM_YEAR_BASE
>> 2) - ! (b
->tm_year
& 3);
1938 int a100
= a4
/ 25 - (a4
% 25 < 0);
1939 int b100
= b4
/ 25 - (b4
% 25 < 0);
1940 int a400
= a100
>> 2;
1941 int b400
= b100
>> 2;
1942 int intervening_leap_days
= (a4
- b4
) - (a100
- b100
) + (a400
- b400
);
1943 int years
= a
->tm_year
- b
->tm_year
;
1944 int days
= (365 * years
+ intervening_leap_days
1945 + (a
->tm_yday
- b
->tm_yday
));
1946 return (60 * (60 * (24 * days
+ (a
->tm_hour
- b
->tm_hour
))
1947 + (a
->tm_min
- b
->tm_min
))
1948 + (a
->tm_sec
- b
->tm_sec
));
1951 DEFUN ("current-time-zone", Fcurrent_time_zone
, Scurrent_time_zone
, 0, 1, 0,
1952 doc
: /* Return the offset and name for the local time zone.
1953 This returns a list of the form (OFFSET NAME).
1954 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
1955 A negative value means west of Greenwich.
1956 NAME is a string giving the name of the time zone.
1957 If SPECIFIED-TIME is given, the time zone offset is determined from it
1958 instead of using the current time. The argument should have the form
1959 (HIGH LOW . IGNORED). Thus, you can use times obtained from
1960 `current-time' and from `file-attributes'. SPECIFIED-TIME can also
1961 have the form (HIGH . LOW), but this is considered obsolete.
1963 Some operating systems cannot provide all this information to Emacs;
1964 in this case, `current-time-zone' returns a list containing nil for
1965 the data it can't find. */)
1967 Lisp_Object specified_time
;
1973 if (!lisp_time_argument (specified_time
, &value
, NULL
))
1978 t
= gmtime (&value
);
1982 t
= localtime (&value
);
1989 int offset
= tm_diff (t
, &gmt
);
1995 s
= (char *)t
->tm_zone
;
1996 #else /* not HAVE_TM_ZONE */
1998 if (t
->tm_isdst
== 0 || t
->tm_isdst
== 1)
1999 s
= tzname
[t
->tm_isdst
];
2001 #endif /* not HAVE_TM_ZONE */
2005 /* No local time zone name is available; use "+-NNNN" instead. */
2006 int am
= (offset
< 0 ? -offset
: offset
) / 60;
2007 sprintf (buf
, "%c%02d%02d", (offset
< 0 ? '-' : '+'), am
/60, am
%60);
2011 return Fcons (make_number (offset
), Fcons (build_string (s
), Qnil
));
2014 return Fmake_list (make_number (2), Qnil
);
2017 /* This holds the value of `environ' produced by the previous
2018 call to Fset_time_zone_rule, or 0 if Fset_time_zone_rule
2019 has never been called. */
2020 static char **environbuf
;
2022 /* This holds the startup value of the TZ environment variable so it
2023 can be restored if the user calls set-time-zone-rule with a nil
2025 static char *initial_tz
;
2027 DEFUN ("set-time-zone-rule", Fset_time_zone_rule
, Sset_time_zone_rule
, 1, 1, 0,
2028 doc
: /* Set the local time zone using TZ, a string specifying a time zone rule.
2029 If TZ is nil, use implementation-defined default time zone information.
2030 If TZ is t, use Universal Time. */)
2036 /* When called for the first time, save the original TZ. */
2038 initial_tz
= (char *) getenv ("TZ");
2041 tzstring
= initial_tz
;
2042 else if (EQ (tz
, Qt
))
2047 tzstring
= (char *) SDATA (tz
);
2050 set_time_zone_rule (tzstring
);
2052 environbuf
= environ
;
2057 #ifdef LOCALTIME_CACHE
2059 /* These two values are known to load tz files in buggy implementations,
2060 i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2.
2061 Their values shouldn't matter in non-buggy implementations.
2062 We don't use string literals for these strings,
2063 since if a string in the environment is in readonly
2064 storage, it runs afoul of bugs in SVR4 and Solaris 2.3.
2065 See Sun bugs 1113095 and 1114114, ``Timezone routines
2066 improperly modify environment''. */
2068 static char set_time_zone_rule_tz1
[] = "TZ=GMT+0";
2069 static char set_time_zone_rule_tz2
[] = "TZ=GMT+1";
2073 /* Set the local time zone rule to TZSTRING.
2074 This allocates memory into `environ', which it is the caller's
2075 responsibility to free. */
2078 set_time_zone_rule (char *tzstring
)
2081 char **from
, **to
, **newenv
;
2083 /* Make the ENVIRON vector longer with room for TZSTRING. */
2084 for (from
= environ
; *from
; from
++)
2086 envptrs
= from
- environ
+ 2;
2087 newenv
= to
= (char **) xmalloc (envptrs
* sizeof (char *)
2088 + (tzstring
? strlen (tzstring
) + 4 : 0));
2090 /* Add TZSTRING to the end of environ, as a value for TZ. */
2093 char *t
= (char *) (to
+ envptrs
);
2095 strcat (t
, tzstring
);
2099 /* Copy the old environ vector elements into NEWENV,
2100 but don't copy the TZ variable.
2101 So we have only one definition of TZ, which came from TZSTRING. */
2102 for (from
= environ
; *from
; from
++)
2103 if (strncmp (*from
, "TZ=", 3) != 0)
2109 /* If we do have a TZSTRING, NEWENV points to the vector slot where
2110 the TZ variable is stored. If we do not have a TZSTRING,
2111 TO points to the vector slot which has the terminating null. */
2113 #ifdef LOCALTIME_CACHE
2115 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like
2116 "US/Pacific" that loads a tz file, then changes to a value like
2117 "XXX0" that does not load a tz file, and then changes back to
2118 its original value, the last change is (incorrectly) ignored.
2119 Also, if TZ changes twice in succession to values that do
2120 not load a tz file, tzset can dump core (see Sun bug#1225179).
2121 The following code works around these bugs. */
2125 /* Temporarily set TZ to a value that loads a tz file
2126 and that differs from tzstring. */
2128 *newenv
= (strcmp (tzstring
, set_time_zone_rule_tz1
+ 3) == 0
2129 ? set_time_zone_rule_tz2
: set_time_zone_rule_tz1
);
2135 /* The implied tzstring is unknown, so temporarily set TZ to
2136 two different values that each load a tz file. */
2137 *to
= set_time_zone_rule_tz1
;
2140 *to
= set_time_zone_rule_tz2
;
2145 /* Now TZ has the desired value, and tzset can be invoked safely. */
2152 /* Insert NARGS Lisp objects in the array ARGS by calling INSERT_FUNC
2153 (if a type of object is Lisp_Int) or INSERT_FROM_STRING_FUNC (if a
2154 type of object is Lisp_String). INHERIT is passed to
2155 INSERT_FROM_STRING_FUNC as the last argument. */
2158 general_insert_function (void (*insert_func
)
2159 (const unsigned char *, EMACS_INT
),
2160 void (*insert_from_string_func
)
2161 (Lisp_Object
, EMACS_INT
, EMACS_INT
,
2162 EMACS_INT
, EMACS_INT
, int),
2163 int inherit
, int nargs
, Lisp_Object
*args
)
2165 register int argnum
;
2166 register Lisp_Object val
;
2168 for (argnum
= 0; argnum
< nargs
; argnum
++)
2171 if (CHARACTERP (val
))
2173 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
2176 if (!NILP (current_buffer
->enable_multibyte_characters
))
2177 len
= CHAR_STRING (XFASTINT (val
), str
);
2180 str
[0] = (ASCII_CHAR_P (XINT (val
))
2182 : multibyte_char_to_unibyte (XINT (val
), Qnil
));
2185 (*insert_func
) (str
, len
);
2187 else if (STRINGP (val
))
2189 (*insert_from_string_func
) (val
, 0, 0,
2195 wrong_type_argument (Qchar_or_string_p
, val
);
2200 insert1 (Lisp_Object arg
)
2206 /* Callers passing one argument to Finsert need not gcpro the
2207 argument "array", since the only element of the array will
2208 not be used after calling insert or insert_from_string, so
2209 we don't care if it gets trashed. */
2211 DEFUN ("insert", Finsert
, Sinsert
, 0, MANY
, 0,
2212 doc
: /* Insert the arguments, either strings or characters, at point.
2213 Point and before-insertion markers move forward to end up
2214 after the inserted text.
2215 Any other markers at the point of insertion remain before the text.
2217 If the current buffer is multibyte, unibyte strings are converted
2218 to multibyte for insertion (see `string-make-multibyte').
2219 If the current buffer is unibyte, multibyte strings are converted
2220 to unibyte for insertion (see `string-make-unibyte').
2222 When operating on binary data, it may be necessary to preserve the
2223 original bytes of a unibyte string when inserting it into a multibyte
2224 buffer; to accomplish this, apply `string-as-multibyte' to the string
2225 and insert the result.
2227 usage: (insert &rest ARGS) */)
2230 register Lisp_Object
*args
;
2232 general_insert_function (insert
, insert_from_string
, 0, nargs
, args
);
2236 DEFUN ("insert-and-inherit", Finsert_and_inherit
, Sinsert_and_inherit
,
2238 doc
: /* Insert the arguments at point, inheriting properties from adjoining text.
2239 Point and before-insertion markers move forward to end up
2240 after the inserted text.
2241 Any other markers at the point of insertion remain before the text.
2243 If the current buffer is multibyte, unibyte strings are converted
2244 to multibyte for insertion (see `unibyte-char-to-multibyte').
2245 If the current buffer is unibyte, multibyte strings are converted
2246 to unibyte for insertion.
2248 usage: (insert-and-inherit &rest ARGS) */)
2251 register Lisp_Object
*args
;
2253 general_insert_function (insert_and_inherit
, insert_from_string
, 1,
2258 DEFUN ("insert-before-markers", Finsert_before_markers
, Sinsert_before_markers
, 0, MANY
, 0,
2259 doc
: /* Insert strings or characters at point, relocating markers after the text.
2260 Point and markers move forward to end up after the inserted text.
2262 If the current buffer is multibyte, unibyte strings are converted
2263 to multibyte for insertion (see `unibyte-char-to-multibyte').
2264 If the current buffer is unibyte, multibyte strings are converted
2265 to unibyte for insertion.
2267 usage: (insert-before-markers &rest ARGS) */)
2270 register Lisp_Object
*args
;
2272 general_insert_function (insert_before_markers
,
2273 insert_from_string_before_markers
, 0,
2278 DEFUN ("insert-before-markers-and-inherit", Finsert_and_inherit_before_markers
,
2279 Sinsert_and_inherit_before_markers
, 0, MANY
, 0,
2280 doc
: /* Insert text at point, relocating markers and inheriting properties.
2281 Point and markers move forward to end up after the inserted text.
2283 If the current buffer is multibyte, unibyte strings are converted
2284 to multibyte for insertion (see `unibyte-char-to-multibyte').
2285 If the current buffer is unibyte, multibyte strings are converted
2286 to unibyte for insertion.
2288 usage: (insert-before-markers-and-inherit &rest ARGS) */)
2291 register Lisp_Object
*args
;
2293 general_insert_function (insert_before_markers_and_inherit
,
2294 insert_from_string_before_markers
, 1,
2299 DEFUN ("insert-char", Finsert_char
, Sinsert_char
, 2, 3, 0,
2300 doc
: /* Insert COUNT copies of CHARACTER.
2301 Point, and before-insertion markers, are relocated as in the function `insert'.
2302 The optional third arg INHERIT, if non-nil, says to inherit text properties
2303 from adjoining text, if those properties are sticky. */)
2304 (character
, count
, inherit
)
2305 Lisp_Object character
, count
, inherit
;
2307 register unsigned char *string
;
2308 register int strlen
;
2311 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
2313 CHECK_NUMBER (character
);
2314 CHECK_NUMBER (count
);
2316 if (!NILP (current_buffer
->enable_multibyte_characters
))
2317 len
= CHAR_STRING (XFASTINT (character
), str
);
2319 str
[0] = XFASTINT (character
), len
= 1;
2320 n
= XINT (count
) * len
;
2323 strlen
= min (n
, 256 * len
);
2324 string
= (unsigned char *) alloca (strlen
);
2325 for (i
= 0; i
< strlen
; i
++)
2326 string
[i
] = str
[i
% len
];
2330 if (!NILP (inherit
))
2331 insert_and_inherit (string
, strlen
);
2333 insert (string
, strlen
);
2338 if (!NILP (inherit
))
2339 insert_and_inherit (string
, n
);
2346 DEFUN ("insert-byte", Finsert_byte
, Sinsert_byte
, 2, 3, 0,
2347 doc
: /* Insert COUNT (second arg) copies of BYTE (first arg).
2348 Both arguments are required.
2349 BYTE is a number of the range 0..255.
2351 If BYTE is 128..255 and the current buffer is multibyte, the
2352 corresponding eight-bit character is inserted.
2354 Point, and before-insertion markers, are relocated as in the function `insert'.
2355 The optional third arg INHERIT, if non-nil, says to inherit text properties
2356 from adjoining text, if those properties are sticky. */)
2357 (byte
, count
, inherit
)
2358 Lisp_Object byte
, count
, inherit
;
2360 CHECK_NUMBER (byte
);
2361 if (XINT (byte
) < 0 || XINT (byte
) > 255)
2362 args_out_of_range_3 (byte
, make_number (0), make_number (255));
2363 if (XINT (byte
) >= 128
2364 && ! NILP (current_buffer
->enable_multibyte_characters
))
2365 XSETFASTINT (byte
, BYTE8_TO_CHAR (XINT (byte
)));
2366 return Finsert_char (byte
, count
, inherit
);
2370 /* Making strings from buffer contents. */
2372 /* Return a Lisp_String containing the text of the current buffer from
2373 START to END. If text properties are in use and the current buffer
2374 has properties in the range specified, the resulting string will also
2375 have them, if PROPS is nonzero.
2377 We don't want to use plain old make_string here, because it calls
2378 make_uninit_string, which can cause the buffer arena to be
2379 compacted. make_string has no way of knowing that the data has
2380 been moved, and thus copies the wrong data into the string. This
2381 doesn't effect most of the other users of make_string, so it should
2382 be left as is. But we should use this function when conjuring
2383 buffer substrings. */
2386 make_buffer_string (int start
, int end
, int props
)
2388 int start_byte
= CHAR_TO_BYTE (start
);
2389 int end_byte
= CHAR_TO_BYTE (end
);
2391 return make_buffer_string_both (start
, start_byte
, end
, end_byte
, props
);
2394 /* Return a Lisp_String containing the text of the current buffer from
2395 START / START_BYTE to END / END_BYTE.
2397 If text properties are in use and the current buffer
2398 has properties in the range specified, the resulting string will also
2399 have them, if PROPS is nonzero.
2401 We don't want to use plain old make_string here, because it calls
2402 make_uninit_string, which can cause the buffer arena to be
2403 compacted. make_string has no way of knowing that the data has
2404 been moved, and thus copies the wrong data into the string. This
2405 doesn't effect most of the other users of make_string, so it should
2406 be left as is. But we should use this function when conjuring
2407 buffer substrings. */
2410 make_buffer_string_both (int start
, int start_byte
, int end
, int end_byte
, int props
)
2412 Lisp_Object result
, tem
, tem1
;
2414 if (start
< GPT
&& GPT
< end
)
2417 if (! NILP (current_buffer
->enable_multibyte_characters
))
2418 result
= make_uninit_multibyte_string (end
- start
, end_byte
- start_byte
);
2420 result
= make_uninit_string (end
- start
);
2421 memcpy (SDATA (result
), BYTE_POS_ADDR (start_byte
), end_byte
- start_byte
);
2423 /* If desired, update and copy the text properties. */
2426 update_buffer_properties (start
, end
);
2428 tem
= Fnext_property_change (make_number (start
), Qnil
, make_number (end
));
2429 tem1
= Ftext_properties_at (make_number (start
), Qnil
);
2431 if (XINT (tem
) != end
|| !NILP (tem1
))
2432 copy_intervals_to_string (result
, current_buffer
, start
,
2439 /* Call Vbuffer_access_fontify_functions for the range START ... END
2440 in the current buffer, if necessary. */
2443 update_buffer_properties (int start
, int end
)
2445 /* If this buffer has some access functions,
2446 call them, specifying the range of the buffer being accessed. */
2447 if (!NILP (Vbuffer_access_fontify_functions
))
2449 Lisp_Object args
[3];
2452 args
[0] = Qbuffer_access_fontify_functions
;
2453 XSETINT (args
[1], start
);
2454 XSETINT (args
[2], end
);
2456 /* But don't call them if we can tell that the work
2457 has already been done. */
2458 if (!NILP (Vbuffer_access_fontified_property
))
2460 tem
= Ftext_property_any (args
[1], args
[2],
2461 Vbuffer_access_fontified_property
,
2464 Frun_hook_with_args (3, args
);
2467 Frun_hook_with_args (3, args
);
2471 DEFUN ("buffer-substring", Fbuffer_substring
, Sbuffer_substring
, 2, 2, 0,
2472 doc
: /* Return the contents of part of the current buffer as a string.
2473 The two arguments START and END are character positions;
2474 they can be in either order.
2475 The string returned is multibyte if the buffer is multibyte.
2477 This function copies the text properties of that part of the buffer
2478 into the result string; if you don't want the text properties,
2479 use `buffer-substring-no-properties' instead. */)
2481 Lisp_Object start
, end
;
2485 validate_region (&start
, &end
);
2489 return make_buffer_string (b
, e
, 1);
2492 DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties
,
2493 Sbuffer_substring_no_properties
, 2, 2, 0,
2494 doc
: /* Return the characters of part of the buffer, without the text properties.
2495 The two arguments START and END are character positions;
2496 they can be in either order. */)
2498 Lisp_Object start
, end
;
2502 validate_region (&start
, &end
);
2506 return make_buffer_string (b
, e
, 0);
2509 DEFUN ("buffer-string", Fbuffer_string
, Sbuffer_string
, 0, 0, 0,
2510 doc
: /* Return the contents of the current buffer as a string.
2511 If narrowing is in effect, this function returns only the visible part
2515 return make_buffer_string (BEGV
, ZV
, 1);
2518 DEFUN ("insert-buffer-substring", Finsert_buffer_substring
, Sinsert_buffer_substring
,
2520 doc
: /* Insert before point a substring of the contents of BUFFER.
2521 BUFFER may be a buffer or a buffer name.
2522 Arguments START and END are character positions specifying the substring.
2523 They default to the values of (point-min) and (point-max) in BUFFER. */)
2524 (buffer
, start
, end
)
2525 Lisp_Object buffer
, start
, end
;
2527 register int b
, e
, temp
;
2528 register struct buffer
*bp
, *obuf
;
2531 buf
= Fget_buffer (buffer
);
2535 if (NILP (bp
->name
))
2536 error ("Selecting deleted buffer");
2542 CHECK_NUMBER_COERCE_MARKER (start
);
2549 CHECK_NUMBER_COERCE_MARKER (end
);
2554 temp
= b
, b
= e
, e
= temp
;
2556 if (!(BUF_BEGV (bp
) <= b
&& e
<= BUF_ZV (bp
)))
2557 args_out_of_range (start
, end
);
2559 obuf
= current_buffer
;
2560 set_buffer_internal_1 (bp
);
2561 update_buffer_properties (b
, e
);
2562 set_buffer_internal_1 (obuf
);
2564 insert_from_buffer (bp
, b
, e
- b
, 0);
2568 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings
, Scompare_buffer_substrings
,
2570 doc
: /* Compare two substrings of two buffers; return result as number.
2571 the value is -N if first string is less after N-1 chars,
2572 +N if first string is greater after N-1 chars, or 0 if strings match.
2573 Each substring is represented as three arguments: BUFFER, START and END.
2574 That makes six args in all, three for each substring.
2576 The value of `case-fold-search' in the current buffer
2577 determines whether case is significant or ignored. */)
2578 (buffer1
, start1
, end1
, buffer2
, start2
, end2
)
2579 Lisp_Object buffer1
, start1
, end1
, buffer2
, start2
, end2
;
2581 register int begp1
, endp1
, begp2
, endp2
, temp
;
2582 register struct buffer
*bp1
, *bp2
;
2583 register Lisp_Object trt
2584 = (!NILP (current_buffer
->case_fold_search
)
2585 ? current_buffer
->case_canon_table
: Qnil
);
2587 int i1
, i2
, i1_byte
, i2_byte
;
2589 /* Find the first buffer and its substring. */
2592 bp1
= current_buffer
;
2596 buf1
= Fget_buffer (buffer1
);
2599 bp1
= XBUFFER (buf1
);
2600 if (NILP (bp1
->name
))
2601 error ("Selecting deleted buffer");
2605 begp1
= BUF_BEGV (bp1
);
2608 CHECK_NUMBER_COERCE_MARKER (start1
);
2609 begp1
= XINT (start1
);
2612 endp1
= BUF_ZV (bp1
);
2615 CHECK_NUMBER_COERCE_MARKER (end1
);
2616 endp1
= XINT (end1
);
2620 temp
= begp1
, begp1
= endp1
, endp1
= temp
;
2622 if (!(BUF_BEGV (bp1
) <= begp1
2624 && endp1
<= BUF_ZV (bp1
)))
2625 args_out_of_range (start1
, end1
);
2627 /* Likewise for second substring. */
2630 bp2
= current_buffer
;
2634 buf2
= Fget_buffer (buffer2
);
2637 bp2
= XBUFFER (buf2
);
2638 if (NILP (bp2
->name
))
2639 error ("Selecting deleted buffer");
2643 begp2
= BUF_BEGV (bp2
);
2646 CHECK_NUMBER_COERCE_MARKER (start2
);
2647 begp2
= XINT (start2
);
2650 endp2
= BUF_ZV (bp2
);
2653 CHECK_NUMBER_COERCE_MARKER (end2
);
2654 endp2
= XINT (end2
);
2658 temp
= begp2
, begp2
= endp2
, endp2
= temp
;
2660 if (!(BUF_BEGV (bp2
) <= begp2
2662 && endp2
<= BUF_ZV (bp2
)))
2663 args_out_of_range (start2
, end2
);
2667 i1_byte
= buf_charpos_to_bytepos (bp1
, i1
);
2668 i2_byte
= buf_charpos_to_bytepos (bp2
, i2
);
2670 while (i1
< endp1
&& i2
< endp2
)
2672 /* When we find a mismatch, we must compare the
2673 characters, not just the bytes. */
2678 if (! NILP (bp1
->enable_multibyte_characters
))
2680 c1
= BUF_FETCH_MULTIBYTE_CHAR (bp1
, i1_byte
);
2681 BUF_INC_POS (bp1
, i1_byte
);
2686 c1
= BUF_FETCH_BYTE (bp1
, i1
);
2687 MAKE_CHAR_MULTIBYTE (c1
);
2691 if (! NILP (bp2
->enable_multibyte_characters
))
2693 c2
= BUF_FETCH_MULTIBYTE_CHAR (bp2
, i2_byte
);
2694 BUF_INC_POS (bp2
, i2_byte
);
2699 c2
= BUF_FETCH_BYTE (bp2
, i2
);
2700 MAKE_CHAR_MULTIBYTE (c2
);
2706 c1
= CHAR_TABLE_TRANSLATE (trt
, c1
);
2707 c2
= CHAR_TABLE_TRANSLATE (trt
, c2
);
2710 return make_number (- 1 - chars
);
2712 return make_number (chars
+ 1);
2717 /* The strings match as far as they go.
2718 If one is shorter, that one is less. */
2719 if (chars
< endp1
- begp1
)
2720 return make_number (chars
+ 1);
2721 else if (chars
< endp2
- begp2
)
2722 return make_number (- chars
- 1);
2724 /* Same length too => they are equal. */
2725 return make_number (0);
2729 subst_char_in_region_unwind (Lisp_Object arg
)
2731 return current_buffer
->undo_list
= arg
;
2735 subst_char_in_region_unwind_1 (Lisp_Object arg
)
2737 return current_buffer
->filename
= arg
;
2740 DEFUN ("subst-char-in-region", Fsubst_char_in_region
,
2741 Ssubst_char_in_region
, 4, 5, 0,
2742 doc
: /* From START to END, replace FROMCHAR with TOCHAR each time it occurs.
2743 If optional arg NOUNDO is non-nil, don't record this change for undo
2744 and don't mark the buffer as really changed.
2745 Both characters must have the same length of multi-byte form. */)
2746 (start
, end
, fromchar
, tochar
, noundo
)
2747 Lisp_Object start
, end
, fromchar
, tochar
, noundo
;
2749 register int pos
, pos_byte
, stop
, i
, len
, end_byte
;
2750 /* Keep track of the first change in the buffer:
2751 if 0 we haven't found it yet.
2752 if < 0 we've found it and we've run the before-change-function.
2753 if > 0 we've actually performed it and the value is its position. */
2755 unsigned char fromstr
[MAX_MULTIBYTE_LENGTH
], tostr
[MAX_MULTIBYTE_LENGTH
];
2757 int count
= SPECPDL_INDEX ();
2758 #define COMBINING_NO 0
2759 #define COMBINING_BEFORE 1
2760 #define COMBINING_AFTER 2
2761 #define COMBINING_BOTH (COMBINING_BEFORE | COMBINING_AFTER)
2762 int maybe_byte_combining
= COMBINING_NO
;
2763 int last_changed
= 0;
2764 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
2768 validate_region (&start
, &end
);
2769 CHECK_NUMBER (fromchar
);
2770 CHECK_NUMBER (tochar
);
2774 len
= CHAR_STRING (XFASTINT (fromchar
), fromstr
);
2775 if (CHAR_STRING (XFASTINT (tochar
), tostr
) != len
)
2776 error ("Characters in `subst-char-in-region' have different byte-lengths");
2777 if (!ASCII_BYTE_P (*tostr
))
2779 /* If *TOSTR is in the range 0x80..0x9F and TOCHAR is not a
2780 complete multibyte character, it may be combined with the
2781 after bytes. If it is in the range 0xA0..0xFF, it may be
2782 combined with the before and after bytes. */
2783 if (!CHAR_HEAD_P (*tostr
))
2784 maybe_byte_combining
= COMBINING_BOTH
;
2785 else if (BYTES_BY_CHAR_HEAD (*tostr
) > len
)
2786 maybe_byte_combining
= COMBINING_AFTER
;
2792 fromstr
[0] = XFASTINT (fromchar
);
2793 tostr
[0] = XFASTINT (tochar
);
2797 pos_byte
= CHAR_TO_BYTE (pos
);
2798 stop
= CHAR_TO_BYTE (XINT (end
));
2801 /* If we don't want undo, turn off putting stuff on the list.
2802 That's faster than getting rid of things,
2803 and it prevents even the entry for a first change.
2804 Also inhibit locking the file. */
2805 if (!changed
&& !NILP (noundo
))
2807 record_unwind_protect (subst_char_in_region_unwind
,
2808 current_buffer
->undo_list
);
2809 current_buffer
->undo_list
= Qt
;
2810 /* Don't do file-locking. */
2811 record_unwind_protect (subst_char_in_region_unwind_1
,
2812 current_buffer
->filename
);
2813 current_buffer
->filename
= Qnil
;
2816 if (pos_byte
< GPT_BYTE
)
2817 stop
= min (stop
, GPT_BYTE
);
2820 int pos_byte_next
= pos_byte
;
2822 if (pos_byte
>= stop
)
2824 if (pos_byte
>= end_byte
) break;
2827 p
= BYTE_POS_ADDR (pos_byte
);
2829 INC_POS (pos_byte_next
);
2832 if (pos_byte_next
- pos_byte
== len
2833 && p
[0] == fromstr
[0]
2835 || (p
[1] == fromstr
[1]
2836 && (len
== 2 || (p
[2] == fromstr
[2]
2837 && (len
== 3 || p
[3] == fromstr
[3]))))))
2840 /* We've already seen this and run the before-change-function;
2841 this time we only need to record the actual position. */
2846 modify_region (current_buffer
, pos
, XINT (end
), 0);
2848 if (! NILP (noundo
))
2850 if (MODIFF
- 1 == SAVE_MODIFF
)
2852 if (MODIFF
- 1 == BUF_AUTOSAVE_MODIFF (current_buffer
))
2853 BUF_AUTOSAVE_MODIFF (current_buffer
)++;
2856 /* The before-change-function may have moved the gap
2857 or even modified the buffer so we should start over. */
2861 /* Take care of the case where the new character
2862 combines with neighboring bytes. */
2863 if (maybe_byte_combining
2864 && (maybe_byte_combining
== COMBINING_AFTER
2865 ? (pos_byte_next
< Z_BYTE
2866 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next
)))
2867 : ((pos_byte_next
< Z_BYTE
2868 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next
)))
2869 || (pos_byte
> BEG_BYTE
2870 && ! ASCII_BYTE_P (FETCH_BYTE (pos_byte
- 1))))))
2872 Lisp_Object tem
, string
;
2874 struct gcpro gcpro1
;
2876 tem
= current_buffer
->undo_list
;
2879 /* Make a multibyte string containing this single character. */
2880 string
= make_multibyte_string (tostr
, 1, len
);
2881 /* replace_range is less efficient, because it moves the gap,
2882 but it handles combining correctly. */
2883 replace_range (pos
, pos
+ 1, string
,
2885 pos_byte_next
= CHAR_TO_BYTE (pos
);
2886 if (pos_byte_next
> pos_byte
)
2887 /* Before combining happened. We should not increment
2888 POS. So, to cancel the later increment of POS,
2892 INC_POS (pos_byte_next
);
2894 if (! NILP (noundo
))
2895 current_buffer
->undo_list
= tem
;
2902 record_change (pos
, 1);
2903 for (i
= 0; i
< len
; i
++) *p
++ = tostr
[i
];
2905 last_changed
= pos
+ 1;
2907 pos_byte
= pos_byte_next
;
2913 signal_after_change (changed
,
2914 last_changed
- changed
, last_changed
- changed
);
2915 update_compositions (changed
, last_changed
, CHECK_ALL
);
2918 unbind_to (count
, Qnil
);
2923 static Lisp_Object
check_translation (int, int, int, Lisp_Object
);
2925 /* Helper function for Ftranslate_region_internal.
2927 Check if a character sequence at POS (POS_BYTE) matches an element
2928 of VAL. VAL is a list (([FROM-CHAR ...] . TO) ...). If a matching
2929 element is found, return it. Otherwise return Qnil. */
2932 check_translation (int pos
, int pos_byte
, int end
, Lisp_Object val
)
2934 int buf_size
= 16, buf_used
= 0;
2935 int *buf
= alloca (sizeof (int) * buf_size
);
2937 for (; CONSP (val
); val
= XCDR (val
))
2946 if (! VECTORP (elt
))
2949 if (len
<= end
- pos
)
2951 for (i
= 0; i
< len
; i
++)
2955 unsigned char *p
= BYTE_POS_ADDR (pos_byte
);
2958 if (buf_used
== buf_size
)
2963 newbuf
= alloca (sizeof (int) * buf_size
);
2964 memcpy (newbuf
, buf
, sizeof (int) * buf_used
);
2967 buf
[buf_used
++] = STRING_CHAR_AND_LENGTH (p
, len
);
2970 if (XINT (AREF (elt
, i
)) != buf
[i
])
2981 DEFUN ("translate-region-internal", Ftranslate_region_internal
,
2982 Stranslate_region_internal
, 3, 3, 0,
2983 doc
: /* Internal use only.
2984 From START to END, translate characters according to TABLE.
2985 TABLE is a string or a char-table; the Nth character in it is the
2986 mapping for the character with code N.
2987 It returns the number of characters changed. */)
2991 register Lisp_Object table
;
2993 register unsigned char *tt
; /* Trans table. */
2994 register int nc
; /* New character. */
2995 int cnt
; /* Number of changes made. */
2996 int size
; /* Size of translate table. */
2997 int pos
, pos_byte
, end_pos
;
2998 int multibyte
= !NILP (current_buffer
->enable_multibyte_characters
);
2999 int string_multibyte
;
3002 validate_region (&start
, &end
);
3003 if (CHAR_TABLE_P (table
))
3005 if (! EQ (XCHAR_TABLE (table
)->purpose
, Qtranslation_table
))
3006 error ("Not a translation table");
3012 CHECK_STRING (table
);
3014 if (! multibyte
&& (SCHARS (table
) < SBYTES (table
)))
3015 table
= string_make_unibyte (table
);
3016 string_multibyte
= SCHARS (table
) < SBYTES (table
);
3017 size
= SBYTES (table
);
3022 pos_byte
= CHAR_TO_BYTE (pos
);
3023 end_pos
= XINT (end
);
3024 modify_region (current_buffer
, pos
, end_pos
, 0);
3027 for (; pos
< end_pos
; )
3029 register unsigned char *p
= BYTE_POS_ADDR (pos_byte
);
3030 unsigned char *str
, buf
[MAX_MULTIBYTE_LENGTH
];
3036 oc
= STRING_CHAR_AND_LENGTH (p
, len
);
3043 /* Reload as signal_after_change in last iteration may GC. */
3045 if (string_multibyte
)
3047 str
= tt
+ string_char_to_byte (table
, oc
);
3048 nc
= STRING_CHAR_AND_LENGTH (str
, str_len
);
3053 if (! ASCII_BYTE_P (nc
) && multibyte
)
3055 str_len
= BYTE8_STRING (nc
, buf
);
3070 val
= CHAR_TABLE_REF (table
, oc
);
3071 if (CHARACTERP (val
)
3072 && (c
= XINT (val
), CHAR_VALID_P (c
, 0)))
3075 str_len
= CHAR_STRING (nc
, buf
);
3078 else if (VECTORP (val
) || (CONSP (val
)))
3080 /* VAL is [TO_CHAR ...] or (([FROM-CHAR ...] . TO) ...)
3081 where TO is TO-CHAR or [TO-CHAR ...]. */
3086 if (nc
!= oc
&& nc
>= 0)
3088 /* Simple one char to one char translation. */
3093 /* This is less efficient, because it moves the gap,
3094 but it should handle multibyte characters correctly. */
3095 string
= make_multibyte_string (str
, 1, str_len
);
3096 replace_range (pos
, pos
+ 1, string
, 1, 0, 1);
3101 record_change (pos
, 1);
3102 while (str_len
-- > 0)
3104 signal_after_change (pos
, 1, 1);
3105 update_compositions (pos
, pos
+ 1, CHECK_BORDER
);
3115 val
= check_translation (pos
, pos_byte
, end_pos
, val
);
3122 /* VAL is ([FROM-CHAR ...] . TO). */
3123 len
= ASIZE (XCAR (val
));
3131 string
= Fconcat (1, &val
);
3135 string
= Fmake_string (make_number (1), val
);
3137 replace_range (pos
, pos
+ len
, string
, 1, 0, 1);
3138 pos_byte
+= SBYTES (string
);
3139 pos
+= SCHARS (string
);
3140 cnt
+= SCHARS (string
);
3141 end_pos
+= SCHARS (string
) - len
;
3149 return make_number (cnt
);
3152 DEFUN ("delete-region", Fdelete_region
, Sdelete_region
, 2, 2, "r",
3153 doc
: /* Delete the text between point and mark.
3155 When called from a program, expects two arguments,
3156 positions (integers or markers) specifying the stretch to be deleted. */)
3158 Lisp_Object start
, end
;
3160 validate_region (&start
, &end
);
3161 del_range (XINT (start
), XINT (end
));
3165 DEFUN ("delete-and-extract-region", Fdelete_and_extract_region
,
3166 Sdelete_and_extract_region
, 2, 2, 0,
3167 doc
: /* Delete the text between START and END and return it. */)
3169 Lisp_Object start
, end
;
3171 validate_region (&start
, &end
);
3172 if (XINT (start
) == XINT (end
))
3173 return empty_unibyte_string
;
3174 return del_range_1 (XINT (start
), XINT (end
), 1, 1);
3177 DEFUN ("widen", Fwiden
, Swiden
, 0, 0, "",
3178 doc
: /* Remove restrictions (narrowing) from current buffer.
3179 This allows the buffer's full text to be seen and edited. */)
3182 if (BEG
!= BEGV
|| Z
!= ZV
)
3183 current_buffer
->clip_changed
= 1;
3185 BEGV_BYTE
= BEG_BYTE
;
3186 SET_BUF_ZV_BOTH (current_buffer
, Z
, Z_BYTE
);
3187 /* Changing the buffer bounds invalidates any recorded current column. */
3188 invalidate_current_column ();
3192 DEFUN ("narrow-to-region", Fnarrow_to_region
, Snarrow_to_region
, 2, 2, "r",
3193 doc
: /* Restrict editing in this buffer to the current region.
3194 The rest of the text becomes temporarily invisible and untouchable
3195 but is not deleted; if you save the buffer in a file, the invisible
3196 text is included in the file. \\[widen] makes all visible again.
3197 See also `save-restriction'.
3199 When calling from a program, pass two arguments; positions (integers
3200 or markers) bounding the text that should remain visible. */)
3202 register Lisp_Object start
, end
;
3204 CHECK_NUMBER_COERCE_MARKER (start
);
3205 CHECK_NUMBER_COERCE_MARKER (end
);
3207 if (XINT (start
) > XINT (end
))
3210 tem
= start
; start
= end
; end
= tem
;
3213 if (!(BEG
<= XINT (start
) && XINT (start
) <= XINT (end
) && XINT (end
) <= Z
))
3214 args_out_of_range (start
, end
);
3216 if (BEGV
!= XFASTINT (start
) || ZV
!= XFASTINT (end
))
3217 current_buffer
->clip_changed
= 1;
3219 SET_BUF_BEGV (current_buffer
, XFASTINT (start
));
3220 SET_BUF_ZV (current_buffer
, XFASTINT (end
));
3221 if (PT
< XFASTINT (start
))
3222 SET_PT (XFASTINT (start
));
3223 if (PT
> XFASTINT (end
))
3224 SET_PT (XFASTINT (end
));
3225 /* Changing the buffer bounds invalidates any recorded current column. */
3226 invalidate_current_column ();
3231 save_restriction_save (void)
3233 if (BEGV
== BEG
&& ZV
== Z
)
3234 /* The common case that the buffer isn't narrowed.
3235 We return just the buffer object, which save_restriction_restore
3236 recognizes as meaning `no restriction'. */
3237 return Fcurrent_buffer ();
3239 /* We have to save a restriction, so return a pair of markers, one
3240 for the beginning and one for the end. */
3242 Lisp_Object beg
, end
;
3244 beg
= buildmark (BEGV
, BEGV_BYTE
);
3245 end
= buildmark (ZV
, ZV_BYTE
);
3247 /* END must move forward if text is inserted at its exact location. */
3248 XMARKER(end
)->insertion_type
= 1;
3250 return Fcons (beg
, end
);
3255 save_restriction_restore (Lisp_Object data
)
3257 struct buffer
*cur
= NULL
;
3258 struct buffer
*buf
= (CONSP (data
)
3259 ? XMARKER (XCAR (data
))->buffer
3262 if (buf
&& buf
!= current_buffer
&& !NILP (buf
->pt_marker
))
3263 { /* If `buf' uses markers to keep track of PT, BEGV, and ZV (as
3264 is the case if it is or has an indirect buffer), then make
3265 sure it is current before we update BEGV, so
3266 set_buffer_internal takes care of managing those markers. */
3267 cur
= current_buffer
;
3268 set_buffer_internal (buf
);
3272 /* A pair of marks bounding a saved restriction. */
3274 struct Lisp_Marker
*beg
= XMARKER (XCAR (data
));
3275 struct Lisp_Marker
*end
= XMARKER (XCDR (data
));
3276 eassert (buf
== end
->buffer
);
3278 if (buf
/* Verify marker still points to a buffer. */
3279 && (beg
->charpos
!= BUF_BEGV (buf
) || end
->charpos
!= BUF_ZV (buf
)))
3280 /* The restriction has changed from the saved one, so restore
3281 the saved restriction. */
3283 int pt
= BUF_PT (buf
);
3285 SET_BUF_BEGV_BOTH (buf
, beg
->charpos
, beg
->bytepos
);
3286 SET_BUF_ZV_BOTH (buf
, end
->charpos
, end
->bytepos
);
3288 if (pt
< beg
->charpos
|| pt
> end
->charpos
)
3289 /* The point is outside the new visible range, move it inside. */
3290 SET_BUF_PT_BOTH (buf
,
3291 clip_to_bounds (beg
->charpos
, pt
, end
->charpos
),
3292 clip_to_bounds (beg
->bytepos
, BUF_PT_BYTE (buf
),
3295 buf
->clip_changed
= 1; /* Remember that the narrowing changed. */
3299 /* A buffer, which means that there was no old restriction. */
3301 if (buf
/* Verify marker still points to a buffer. */
3302 && (BUF_BEGV (buf
) != BUF_BEG (buf
) || BUF_ZV (buf
) != BUF_Z (buf
)))
3303 /* The buffer has been narrowed, get rid of the narrowing. */
3305 SET_BUF_BEGV_BOTH (buf
, BUF_BEG (buf
), BUF_BEG_BYTE (buf
));
3306 SET_BUF_ZV_BOTH (buf
, BUF_Z (buf
), BUF_Z_BYTE (buf
));
3308 buf
->clip_changed
= 1; /* Remember that the narrowing changed. */
3313 set_buffer_internal (cur
);
3318 DEFUN ("save-restriction", Fsave_restriction
, Ssave_restriction
, 0, UNEVALLED
, 0,
3319 doc
: /* Execute BODY, saving and restoring current buffer's restrictions.
3320 The buffer's restrictions make parts of the beginning and end invisible.
3321 \(They are set up with `narrow-to-region' and eliminated with `widen'.)
3322 This special form, `save-restriction', saves the current buffer's restrictions
3323 when it is entered, and restores them when it is exited.
3324 So any `narrow-to-region' within BODY lasts only until the end of the form.
3325 The old restrictions settings are restored
3326 even in case of abnormal exit (throw or error).
3328 The value returned is the value of the last form in BODY.
3330 Note: if you are using both `save-excursion' and `save-restriction',
3331 use `save-excursion' outermost:
3332 (save-excursion (save-restriction ...))
3334 usage: (save-restriction &rest BODY) */)
3338 register Lisp_Object val
;
3339 int count
= SPECPDL_INDEX ();
3341 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
3342 val
= Fprogn (body
);
3343 return unbind_to (count
, val
);
3346 /* Buffer for the most recent text displayed by Fmessage_box. */
3347 static char *message_text
;
3349 /* Allocated length of that buffer. */
3350 static int message_length
;
3352 DEFUN ("message", Fmessage
, Smessage
, 1, MANY
, 0,
3353 doc
: /* Display a message at the bottom of the screen.
3354 The message also goes into the `*Messages*' buffer.
3355 \(In keyboard macros, that's all it does.)
3358 The first argument is a format control string, and the rest are data
3359 to be formatted under control of the string. See `format' for details.
3361 Note: Use (message "%s" VALUE) to print the value of expressions and
3362 variables to avoid accidentally interpreting `%' as format specifiers.
3364 If the first argument is nil or the empty string, the function clears
3365 any existing message; this lets the minibuffer contents show. See
3366 also `current-message'.
3368 usage: (message FORMAT-STRING &rest ARGS) */)
3374 || (STRINGP (args
[0])
3375 && SBYTES (args
[0]) == 0))
3382 register Lisp_Object val
;
3383 val
= Fformat (nargs
, args
);
3384 message3 (val
, SBYTES (val
), STRING_MULTIBYTE (val
));
3389 DEFUN ("message-box", Fmessage_box
, Smessage_box
, 1, MANY
, 0,
3390 doc
: /* Display a message, in a dialog box if possible.
3391 If a dialog box is not available, use the echo area.
3392 The first argument is a format control string, and the rest are data
3393 to be formatted under control of the string. See `format' for details.
3395 If the first argument is nil or the empty string, clear any existing
3396 message; let the minibuffer contents show.
3398 usage: (message-box FORMAT-STRING &rest ARGS) */)
3410 register Lisp_Object val
;
3411 val
= Fformat (nargs
, args
);
3413 /* The MS-DOS frames support popup menus even though they are
3414 not FRAME_WINDOW_P. */
3415 if (FRAME_WINDOW_P (XFRAME (selected_frame
))
3416 || FRAME_MSDOS_P (XFRAME (selected_frame
)))
3418 Lisp_Object pane
, menu
, obj
;
3419 struct gcpro gcpro1
;
3420 pane
= Fcons (Fcons (build_string ("OK"), Qt
), Qnil
);
3422 menu
= Fcons (val
, pane
);
3423 obj
= Fx_popup_dialog (Qt
, menu
, Qt
);
3427 #endif /* HAVE_MENUS */
3428 /* Copy the data so that it won't move when we GC. */
3431 message_text
= (char *)xmalloc (80);
3432 message_length
= 80;
3434 if (SBYTES (val
) > message_length
)
3436 message_length
= SBYTES (val
);
3437 message_text
= (char *)xrealloc (message_text
, message_length
);
3439 memcpy (message_text
, SDATA (val
), SBYTES (val
));
3440 message2 (message_text
, SBYTES (val
),
3441 STRING_MULTIBYTE (val
));
3446 extern Lisp_Object last_nonmenu_event
;
3449 DEFUN ("message-or-box", Fmessage_or_box
, Smessage_or_box
, 1, MANY
, 0,
3450 doc
: /* Display a message in a dialog box or in the echo area.
3451 If this command was invoked with the mouse, use a dialog box if
3452 `use-dialog-box' is non-nil.
3453 Otherwise, use the echo area.
3454 The first argument is a format control string, and the rest are data
3455 to be formatted under control of the string. See `format' for details.
3457 If the first argument is nil or the empty string, clear any existing
3458 message; let the minibuffer contents show.
3460 usage: (message-or-box FORMAT-STRING &rest ARGS) */)
3466 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
3468 return Fmessage_box (nargs
, args
);
3470 return Fmessage (nargs
, args
);
3473 DEFUN ("current-message", Fcurrent_message
, Scurrent_message
, 0, 0, 0,
3474 doc
: /* Return the string currently displayed in the echo area, or nil if none. */)
3477 return current_message ();
3481 DEFUN ("propertize", Fpropertize
, Spropertize
, 1, MANY
, 0,
3482 doc
: /* Return a copy of STRING with text properties added.
3483 First argument is the string to copy.
3484 Remaining arguments form a sequence of PROPERTY VALUE pairs for text
3485 properties to add to the result.
3486 usage: (propertize STRING &rest PROPERTIES) */)
3491 Lisp_Object properties
, string
;
3492 struct gcpro gcpro1
, gcpro2
;
3495 /* Number of args must be odd. */
3496 if ((nargs
& 1) == 0 || nargs
< 1)
3497 error ("Wrong number of arguments");
3499 properties
= string
= Qnil
;
3500 GCPRO2 (properties
, string
);
3502 /* First argument must be a string. */
3503 CHECK_STRING (args
[0]);
3504 string
= Fcopy_sequence (args
[0]);
3506 for (i
= 1; i
< nargs
; i
+= 2)
3507 properties
= Fcons (args
[i
], Fcons (args
[i
+ 1], properties
));
3509 Fadd_text_properties (make_number (0),
3510 make_number (SCHARS (string
)),
3511 properties
, string
);
3512 RETURN_UNGCPRO (string
);
3516 /* Number of bytes that STRING will occupy when put into the result.
3517 MULTIBYTE is nonzero if the result should be multibyte. */
3519 #define CONVERTED_BYTE_SIZE(MULTIBYTE, STRING) \
3520 (((MULTIBYTE) && ! STRING_MULTIBYTE (STRING)) \
3521 ? count_size_as_multibyte (SDATA (STRING), SBYTES (STRING)) \
3524 DEFUN ("format", Fformat
, Sformat
, 1, MANY
, 0,
3525 doc
: /* Format a string out of a format-string and arguments.
3526 The first argument is a format control string.
3527 The other arguments are substituted into it to make the result, a string.
3529 The format control string may contain %-sequences meaning to substitute
3530 the next available argument:
3532 %s means print a string argument. Actually, prints any object, with `princ'.
3533 %d means print as number in decimal (%o octal, %x hex).
3534 %X is like %x, but uses upper case.
3535 %e means print a number in exponential notation.
3536 %f means print a number in decimal-point notation.
3537 %g means print a number in exponential notation
3538 or decimal-point notation, whichever uses fewer characters.
3539 %c means print a number as a single character.
3540 %S means print any object as an s-expression (using `prin1').
3542 The argument used for %d, %o, %x, %e, %f, %g or %c must be a number.
3543 Use %% to put a single % into the output.
3545 A %-sequence may contain optional flag, width, and precision
3546 specifiers, as follows:
3548 %<flags><width><precision>character
3550 where flags is [+ #-0]+, width is [0-9]+, and precision is .[0-9]+
3552 The + flag character inserts a + before any positive number, while a
3553 space inserts a space before any positive number; these flags only
3554 affect %d, %e, %f, and %g sequences, and the + flag takes precedence.
3555 The # flag means to use an alternate display form for %o, %x, %X, %e,
3556 %f, and %g sequences. The - and 0 flags affect the width specifier,
3559 The width specifier supplies a lower limit for the length of the
3560 printed representation. The padding, if any, normally goes on the
3561 left, but it goes on the right if the - flag is present. The padding
3562 character is normally a space, but it is 0 if the 0 flag is present.
3563 The - flag takes precedence over the 0 flag.
3565 For %e, %f, and %g sequences, the number after the "." in the
3566 precision specifier says how many decimal places to show; if zero, the
3567 decimal point itself is omitted. For %s and %S, the precision
3568 specifier truncates the string to the given width.
3570 usage: (format STRING &rest OBJECTS) */)
3573 register Lisp_Object
*args
;
3575 register int n
; /* The number of the next arg to substitute */
3576 register int total
; /* An estimate of the final length */
3578 register unsigned char *format
, *end
, *format_start
;
3580 /* Nonzero if the output should be a multibyte string,
3581 which is true if any of the inputs is one. */
3583 /* When we make a multibyte string, we must pay attention to the
3584 byte combining problem, i.e., a byte may be combined with a
3585 multibyte charcter of the previous string. This flag tells if we
3586 must consider such a situation or not. */
3587 int maybe_combine_byte
;
3588 unsigned char *this_format
;
3589 /* Precision for each spec, or -1, a flag value meaning no precision
3590 was given in that spec. Element 0, corresonding to the format
3591 string itself, will not be used. Element NARGS, corresponding to
3592 no argument, *will* be assigned to in the case that a `%' and `.'
3593 occur after the final format specifier. */
3594 int *precision
= (int *) (alloca ((nargs
+ 1) * sizeof (int)));
3597 int arg_intervals
= 0;
3600 /* discarded[I] is 1 if byte I of the format
3601 string was not copied into the output.
3602 It is 2 if byte I was not the first byte of its character. */
3603 char *discarded
= 0;
3605 /* Each element records, for one argument,
3606 the start and end bytepos in the output string,
3607 and whether the argument is a string with intervals.
3608 info[0] is unused. Unused elements have -1 for start. */
3611 int start
, end
, intervals
;
3614 /* It should not be necessary to GCPRO ARGS, because
3615 the caller in the interpreter should take care of that. */
3617 /* Try to determine whether the result should be multibyte.
3618 This is not always right; sometimes the result needs to be multibyte
3619 because of an object that we will pass through prin1,
3620 and in that case, we won't know it here. */
3621 for (n
= 0; n
< nargs
; n
++)
3623 if (STRINGP (args
[n
]) && STRING_MULTIBYTE (args
[n
]))
3625 /* Piggyback on this loop to initialize precision[N]. */
3628 precision
[nargs
] = -1;
3630 CHECK_STRING (args
[0]);
3631 /* We may have to change "%S" to "%s". */
3632 args
[0] = Fcopy_sequence (args
[0]);
3634 /* GC should never happen here, so abort if it does. */
3637 /* If we start out planning a unibyte result,
3638 then discover it has to be multibyte, we jump back to retry.
3639 That can only happen from the first large while loop below. */
3642 format
= SDATA (args
[0]);
3643 format_start
= format
;
3644 end
= format
+ SBYTES (args
[0]);
3647 /* Make room in result for all the non-%-codes in the control string. */
3648 total
= 5 + CONVERTED_BYTE_SIZE (multibyte
, args
[0]) + 1;
3650 /* Allocate the info and discarded tables. */
3652 int nbytes
= (nargs
+1) * sizeof *info
;
3655 info
= (struct info
*) alloca (nbytes
);
3656 memset (info
, 0, nbytes
);
3657 for (i
= 0; i
<= nargs
; i
++)
3660 SAFE_ALLOCA (discarded
, char *, SBYTES (args
[0]));
3661 memset (discarded
, 0, SBYTES (args
[0]));
3664 /* Add to TOTAL enough space to hold the converted arguments. */
3667 while (format
!= end
)
3668 if (*format
++ == '%')
3671 int actual_width
= 0;
3672 unsigned char *this_format_start
= format
- 1;
3673 int field_width
= 0;
3675 /* General format specifications look like
3677 '%' [flags] [field-width] [precision] format
3682 field-width ::= [0-9]+
3683 precision ::= '.' [0-9]*
3685 If a field-width is specified, it specifies to which width
3686 the output should be padded with blanks, if the output
3687 string is shorter than field-width.
3689 If precision is specified, it specifies the number of
3690 digits to print after the '.' for floats, or the max.
3691 number of chars to print from a string. */
3693 while (format
!= end
3694 && (*format
== '-' || *format
== '0' || *format
== '#'
3695 || * format
== ' ' || *format
== '+'))
3698 if (*format
>= '0' && *format
<= '9')
3700 for (field_width
= 0; *format
>= '0' && *format
<= '9'; ++format
)
3701 field_width
= 10 * field_width
+ *format
- '0';
3704 /* N is not incremented for another few lines below, so refer to
3705 element N+1 (which might be precision[NARGS]). */
3709 for (precision
[n
+1] = 0; *format
>= '0' && *format
<= '9'; ++format
)
3710 precision
[n
+1] = 10 * precision
[n
+1] + *format
- '0';
3713 /* Extra +1 for 'l' that we may need to insert into the
3715 if (format
- this_format_start
+ 2 > longest_format
)
3716 longest_format
= format
- this_format_start
+ 2;
3719 error ("Format string ends in middle of format specifier");
3722 else if (++n
>= nargs
)
3723 error ("Not enough arguments for format string");
3724 else if (*format
== 'S')
3726 /* For `S', prin1 the argument and then treat like a string. */
3727 register Lisp_Object tem
;
3728 tem
= Fprin1_to_string (args
[n
], Qnil
);
3729 if (STRING_MULTIBYTE (tem
) && ! multibyte
)
3735 /* If we restart the loop, we should not come here again
3736 because args[n] is now a string and calling
3737 Fprin1_to_string on it produces superflous double
3738 quotes. So, change "%S" to "%s" now. */
3742 else if (SYMBOLP (args
[n
]))
3744 args
[n
] = SYMBOL_NAME (args
[n
]);
3745 if (STRING_MULTIBYTE (args
[n
]) && ! multibyte
)
3752 else if (STRINGP (args
[n
]))
3755 if (*format
!= 's' && *format
!= 'S')
3756 error ("Format specifier doesn't match argument type");
3757 /* In the case (PRECISION[N] > 0), THISSIZE may not need
3758 to be as large as is calculated here. Easy check for
3759 the case PRECISION = 0. */
3760 thissize
= precision
[n
] ? CONVERTED_BYTE_SIZE (multibyte
, args
[n
]) : 0;
3761 /* The precision also constrains how much of the argument
3762 string will finally appear (Bug#5710). */
3763 actual_width
= lisp_string_width (args
[n
], -1, NULL
, NULL
);
3764 if (precision
[n
] != -1)
3765 actual_width
= min (actual_width
, precision
[n
]);
3767 /* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */
3768 else if (INTEGERP (args
[n
]) && *format
!= 's')
3770 /* The following loop assumes the Lisp type indicates
3771 the proper way to pass the argument.
3772 So make sure we have a flonum if the argument should
3774 if (*format
== 'e' || *format
== 'f' || *format
== 'g')
3775 args
[n
] = Ffloat (args
[n
]);
3777 if (*format
!= 'd' && *format
!= 'o' && *format
!= 'x'
3778 && *format
!= 'i' && *format
!= 'X' && *format
!= 'c')
3779 error ("Invalid format operation %%%c", *format
);
3781 thissize
= 30 + (precision
[n
] > 0 ? precision
[n
] : 0);
3784 if (! ASCII_CHAR_P (XINT (args
[n
]))
3785 /* Note: No one can remeber why we have to treat
3786 the character 0 as a multibyte character here.
3787 But, until it causes a real problem, let's
3789 || XINT (args
[n
]) == 0)
3796 args
[n
] = Fchar_to_string (args
[n
]);
3797 thissize
= SBYTES (args
[n
]);
3799 else if (! ASCII_BYTE_P (XINT (args
[n
])) && multibyte
)
3802 = Fchar_to_string (Funibyte_char_to_multibyte (args
[n
]));
3803 thissize
= SBYTES (args
[n
]);
3807 else if (FLOATP (args
[n
]) && *format
!= 's')
3809 if (! (*format
== 'e' || *format
== 'f' || *format
== 'g'))
3811 if (*format
!= 'd' && *format
!= 'o' && *format
!= 'x'
3812 && *format
!= 'i' && *format
!= 'X' && *format
!= 'c')
3813 error ("Invalid format operation %%%c", *format
);
3814 /* This fails unnecessarily if args[n] is bigger than
3815 most-positive-fixnum but smaller than MAXINT.
3816 These cases are important because we sometimes use floats
3817 to represent such integer values (typically such values
3818 come from UIDs or PIDs). */
3819 /* args[n] = Ftruncate (args[n], Qnil); */
3822 /* Note that we're using sprintf to print floats,
3823 so we have to take into account what that function
3825 /* Filter out flag value of -1. */
3826 thissize
= (MAX_10_EXP
+ 100
3827 + (precision
[n
] > 0 ? precision
[n
] : 0));
3831 /* Anything but a string, convert to a string using princ. */
3832 register Lisp_Object tem
;
3833 tem
= Fprin1_to_string (args
[n
], Qt
);
3834 if (STRING_MULTIBYTE (tem
) && ! multibyte
)
3843 thissize
+= max (0, field_width
- actual_width
);
3844 total
+= thissize
+ 4;
3849 /* Now we can no longer jump to retry.
3850 TOTAL and LONGEST_FORMAT are known for certain. */
3852 this_format
= (unsigned char *) alloca (longest_format
+ 1);
3854 /* Allocate the space for the result.
3855 Note that TOTAL is an overestimate. */
3856 SAFE_ALLOCA (buf
, char *, total
);
3862 /* Scan the format and store result in BUF. */
3863 format
= SDATA (args
[0]);
3864 format_start
= format
;
3865 end
= format
+ SBYTES (args
[0]);
3866 maybe_combine_byte
= 0;
3867 while (format
!= end
)
3873 unsigned char *this_format_start
= format
;
3875 discarded
[format
- format_start
] = 1;
3878 while (index ("-+0# ", *format
))
3884 discarded
[format
- format_start
] = 1;
3888 minlen
= atoi (format
);
3890 while ((*format
>= '0' && *format
<= '9') || *format
== '.')
3892 discarded
[format
- format_start
] = 1;
3896 if (*format
++ == '%')
3905 discarded
[format
- format_start
- 1] = 1;
3906 info
[n
].start
= nchars
;
3908 if (STRINGP (args
[n
]))
3910 /* handle case (precision[n] >= 0) */
3913 int nbytes
, start
, end
;
3916 /* lisp_string_width ignores a precision of 0, but GNU
3917 libc functions print 0 characters when the precision
3918 is 0. Imitate libc behavior here. Changing
3919 lisp_string_width is the right thing, and will be
3920 done, but meanwhile we work with it. */
3922 if (precision
[n
] == 0)
3923 width
= nchars_string
= nbytes
= 0;
3924 else if (precision
[n
] > 0)
3925 width
= lisp_string_width (args
[n
], precision
[n
], &nchars_string
, &nbytes
);
3927 { /* no precision spec given for this argument */
3928 width
= lisp_string_width (args
[n
], -1, NULL
, NULL
);
3929 nbytes
= SBYTES (args
[n
]);
3930 nchars_string
= SCHARS (args
[n
]);
3933 /* If spec requires it, pad on right with spaces. */
3934 padding
= minlen
- width
;
3936 while (padding
-- > 0)
3942 info
[n
].start
= start
= nchars
;
3943 nchars
+= nchars_string
;
3948 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
3949 && STRING_MULTIBYTE (args
[n
])
3950 && !CHAR_HEAD_P (SREF (args
[n
], 0)))
3951 maybe_combine_byte
= 1;
3953 p
+= copy_text (SDATA (args
[n
]), p
,
3955 STRING_MULTIBYTE (args
[n
]), multibyte
);
3957 info
[n
].end
= nchars
;
3960 while (padding
-- > 0)
3966 /* If this argument has text properties, record where
3967 in the result string it appears. */
3968 if (STRING_INTERVALS (args
[n
]))
3969 info
[n
].intervals
= arg_intervals
= 1;
3971 else if (INTEGERP (args
[n
]) || FLOATP (args
[n
]))
3975 memcpy (this_format
, this_format_start
,
3976 format
- this_format_start
);
3977 this_format
[format
- this_format_start
] = 0;
3979 if (format
[-1] == 'e' || format
[-1] == 'f' || format
[-1] == 'g')
3980 sprintf (p
, this_format
, XFLOAT_DATA (args
[n
]));
3983 if (sizeof (EMACS_INT
) > sizeof (int)
3984 && format
[-1] != 'c')
3986 /* Insert 'l' before format spec. */
3987 this_format
[format
- this_format_start
]
3988 = this_format
[format
- this_format_start
- 1];
3989 this_format
[format
- this_format_start
- 1] = 'l';
3990 this_format
[format
- this_format_start
+ 1] = 0;
3993 if (INTEGERP (args
[n
]))
3995 if (format
[-1] == 'c')
3996 sprintf (p
, this_format
, (int) XINT (args
[n
]));
3997 else if (format
[-1] == 'd')
3998 sprintf (p
, this_format
, XINT (args
[n
]));
3999 /* Don't sign-extend for octal or hex printing. */
4001 sprintf (p
, this_format
, XUINT (args
[n
]));
4003 else if (format
[-1] == 'c')
4004 sprintf (p
, this_format
, (int) XFLOAT_DATA (args
[n
]));
4005 else if (format
[-1] == 'd')
4006 /* Maybe we should use "%1.0f" instead so it also works
4007 for values larger than MAXINT. */
4008 sprintf (p
, this_format
, (EMACS_INT
) XFLOAT_DATA (args
[n
]));
4010 /* Don't sign-extend for octal or hex printing. */
4011 sprintf (p
, this_format
, (EMACS_UINT
) XFLOAT_DATA (args
[n
]));
4016 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
4017 && !CHAR_HEAD_P (*((unsigned char *) p
)))
4018 maybe_combine_byte
= 1;
4019 this_nchars
= strlen (p
);
4021 p
+= str_to_multibyte (p
, buf
+ total
- 1 - p
, this_nchars
);
4024 nchars
+= this_nchars
;
4025 info
[n
].end
= nchars
;
4029 else if (STRING_MULTIBYTE (args
[0]))
4031 /* Copy a whole multibyte character. */
4034 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
4035 && !CHAR_HEAD_P (*format
))
4036 maybe_combine_byte
= 1;
4038 while (! CHAR_HEAD_P (*format
))
4040 discarded
[format
- format_start
] = 2;
4047 /* Convert a single-byte character to multibyte. */
4048 int len
= copy_text (format
, p
, 1, 0, 1);
4055 *p
++ = *format
++, nchars
++;
4058 if (p
> buf
+ total
)
4061 if (maybe_combine_byte
)
4062 nchars
= multibyte_chars_in_text (buf
, p
- buf
);
4063 val
= make_specified_string (buf
, nchars
, p
- buf
, multibyte
);
4065 /* If we allocated BUF with malloc, free it too. */
4068 /* If the format string has text properties, or any of the string
4069 arguments has text properties, set up text properties of the
4072 if (STRING_INTERVALS (args
[0]) || arg_intervals
)
4074 Lisp_Object len
, new_len
, props
;
4075 struct gcpro gcpro1
;
4077 /* Add text properties from the format string. */
4078 len
= make_number (SCHARS (args
[0]));
4079 props
= text_property_list (args
[0], make_number (0), len
, Qnil
);
4084 int bytepos
= 0, position
= 0, translated
= 0, argn
= 1;
4087 /* Adjust the bounds of each text property
4088 to the proper start and end in the output string. */
4090 /* Put the positions in PROPS in increasing order, so that
4091 we can do (effectively) one scan through the position
4092 space of the format string. */
4093 props
= Fnreverse (props
);
4095 /* BYTEPOS is the byte position in the format string,
4096 POSITION is the untranslated char position in it,
4097 TRANSLATED is the translated char position in BUF,
4098 and ARGN is the number of the next arg we will come to. */
4099 for (list
= props
; CONSP (list
); list
= XCDR (list
))
4106 /* First adjust the property start position. */
4107 pos
= XINT (XCAR (item
));
4109 /* Advance BYTEPOS, POSITION, TRANSLATED and ARGN
4110 up to this position. */
4111 for (; position
< pos
; bytepos
++)
4113 if (! discarded
[bytepos
])
4114 position
++, translated
++;
4115 else if (discarded
[bytepos
] == 1)
4118 if (translated
== info
[argn
].start
)
4120 translated
+= info
[argn
].end
- info
[argn
].start
;
4126 XSETCAR (item
, make_number (translated
));
4128 /* Likewise adjust the property end position. */
4129 pos
= XINT (XCAR (XCDR (item
)));
4131 for (; position
< pos
; bytepos
++)
4133 if (! discarded
[bytepos
])
4134 position
++, translated
++;
4135 else if (discarded
[bytepos
] == 1)
4138 if (translated
== info
[argn
].start
)
4140 translated
+= info
[argn
].end
- info
[argn
].start
;
4146 XSETCAR (XCDR (item
), make_number (translated
));
4149 add_text_properties_from_list (val
, props
, make_number (0));
4152 /* Add text properties from arguments. */
4154 for (n
= 1; n
< nargs
; ++n
)
4155 if (info
[n
].intervals
)
4157 len
= make_number (SCHARS (args
[n
]));
4158 new_len
= make_number (info
[n
].end
- info
[n
].start
);
4159 props
= text_property_list (args
[n
], make_number (0), len
, Qnil
);
4160 props
= extend_property_ranges (props
, new_len
);
4161 /* If successive arguments have properties, be sure that
4162 the value of `composition' property be the copy. */
4163 if (n
> 1 && info
[n
- 1].end
)
4164 make_composition_value_copy (props
);
4165 add_text_properties_from_list (val
, props
,
4166 make_number (info
[n
].start
));
4176 format2 (char *string1
, Lisp_Object arg0
, Lisp_Object arg1
)
4178 Lisp_Object args
[3];
4179 args
[0] = build_string (string1
);
4182 return Fformat (3, args
);
4185 DEFUN ("char-equal", Fchar_equal
, Schar_equal
, 2, 2, 0,
4186 doc
: /* Return t if two characters match, optionally ignoring case.
4187 Both arguments must be characters (i.e. integers).
4188 Case is ignored if `case-fold-search' is non-nil in the current buffer. */)
4190 register Lisp_Object c1
, c2
;
4193 /* Check they're chars, not just integers, otherwise we could get array
4194 bounds violations in DOWNCASE. */
4195 CHECK_CHARACTER (c1
);
4196 CHECK_CHARACTER (c2
);
4198 if (XINT (c1
) == XINT (c2
))
4200 if (NILP (current_buffer
->case_fold_search
))
4203 /* Do these in separate statements,
4204 then compare the variables.
4205 because of the way DOWNCASE uses temp variables. */
4207 if (NILP (current_buffer
->enable_multibyte_characters
)
4208 && ! ASCII_CHAR_P (i1
))
4210 MAKE_CHAR_MULTIBYTE (i1
);
4213 if (NILP (current_buffer
->enable_multibyte_characters
)
4214 && ! ASCII_CHAR_P (i2
))
4216 MAKE_CHAR_MULTIBYTE (i2
);
4220 return (i1
== i2
? Qt
: Qnil
);
4223 /* Transpose the markers in two regions of the current buffer, and
4224 adjust the ones between them if necessary (i.e.: if the regions
4227 START1, END1 are the character positions of the first region.
4228 START1_BYTE, END1_BYTE are the byte positions.
4229 START2, END2 are the character positions of the second region.
4230 START2_BYTE, END2_BYTE are the byte positions.
4232 Traverses the entire marker list of the buffer to do so, adding an
4233 appropriate amount to some, subtracting from some, and leaving the
4234 rest untouched. Most of this is copied from adjust_markers in insdel.c.
4236 It's the caller's job to ensure that START1 <= END1 <= START2 <= END2. */
4239 transpose_markers (start1
, end1
, start2
, end2
,
4240 start1_byte
, end1_byte
, start2_byte
, end2_byte
)
4241 register int start1
, end1
, start2
, end2
;
4242 register int start1_byte
, end1_byte
, start2_byte
, end2_byte
;
4244 register int amt1
, amt1_byte
, amt2
, amt2_byte
, diff
, diff_byte
, mpos
;
4245 register struct Lisp_Marker
*marker
;
4247 /* Update point as if it were a marker. */
4251 TEMP_SET_PT_BOTH (PT
+ (end2
- end1
),
4252 PT_BYTE
+ (end2_byte
- end1_byte
));
4253 else if (PT
< start2
)
4254 TEMP_SET_PT_BOTH (PT
+ (end2
- start2
) - (end1
- start1
),
4255 (PT_BYTE
+ (end2_byte
- start2_byte
)
4256 - (end1_byte
- start1_byte
)));
4258 TEMP_SET_PT_BOTH (PT
- (start2
- start1
),
4259 PT_BYTE
- (start2_byte
- start1_byte
));
4261 /* We used to adjust the endpoints here to account for the gap, but that
4262 isn't good enough. Even if we assume the caller has tried to move the
4263 gap out of our way, it might still be at start1 exactly, for example;
4264 and that places it `inside' the interval, for our purposes. The amount
4265 of adjustment is nontrivial if there's a `denormalized' marker whose
4266 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
4267 the dirty work to Fmarker_position, below. */
4269 /* The difference between the region's lengths */
4270 diff
= (end2
- start2
) - (end1
- start1
);
4271 diff_byte
= (end2_byte
- start2_byte
) - (end1_byte
- start1_byte
);
4273 /* For shifting each marker in a region by the length of the other
4274 region plus the distance between the regions. */
4275 amt1
= (end2
- start2
) + (start2
- end1
);
4276 amt2
= (end1
- start1
) + (start2
- end1
);
4277 amt1_byte
= (end2_byte
- start2_byte
) + (start2_byte
- end1_byte
);
4278 amt2_byte
= (end1_byte
- start1_byte
) + (start2_byte
- end1_byte
);
4280 for (marker
= BUF_MARKERS (current_buffer
); marker
; marker
= marker
->next
)
4282 mpos
= marker
->bytepos
;
4283 if (mpos
>= start1_byte
&& mpos
< end2_byte
)
4285 if (mpos
< end1_byte
)
4287 else if (mpos
< start2_byte
)
4291 marker
->bytepos
= mpos
;
4293 mpos
= marker
->charpos
;
4294 if (mpos
>= start1
&& mpos
< end2
)
4298 else if (mpos
< start2
)
4303 marker
->charpos
= mpos
;
4307 DEFUN ("transpose-regions", Ftranspose_regions
, Stranspose_regions
, 4, 5, 0,
4308 doc
: /* Transpose region STARTR1 to ENDR1 with STARTR2 to ENDR2.
4309 The regions should not be overlapping, because the size of the buffer is
4310 never changed in a transposition.
4312 Optional fifth arg LEAVE-MARKERS, if non-nil, means don't update
4313 any markers that happen to be located in the regions.
4315 Transposing beyond buffer boundaries is an error. */)
4316 (startr1
, endr1
, startr2
, endr2
, leave_markers
)
4317 Lisp_Object startr1
, endr1
, startr2
, endr2
, leave_markers
;
4319 register EMACS_INT start1
, end1
, start2
, end2
;
4320 EMACS_INT start1_byte
, start2_byte
, len1_byte
, len2_byte
;
4321 EMACS_INT gap
, len1
, len_mid
, len2
;
4322 unsigned char *start1_addr
, *start2_addr
, *temp
;
4324 INTERVAL cur_intv
, tmp_interval1
, tmp_interval_mid
, tmp_interval2
, tmp_interval3
;
4327 XSETBUFFER (buf
, current_buffer
);
4328 cur_intv
= BUF_INTERVALS (current_buffer
);
4330 validate_region (&startr1
, &endr1
);
4331 validate_region (&startr2
, &endr2
);
4333 start1
= XFASTINT (startr1
);
4334 end1
= XFASTINT (endr1
);
4335 start2
= XFASTINT (startr2
);
4336 end2
= XFASTINT (endr2
);
4339 /* Swap the regions if they're reversed. */
4342 register int glumph
= start1
;
4350 len1
= end1
- start1
;
4351 len2
= end2
- start2
;
4354 error ("Transposed regions overlap");
4355 else if (start1
== end1
|| start2
== end2
)
4356 error ("Transposed region has length 0");
4358 /* The possibilities are:
4359 1. Adjacent (contiguous) regions, or separate but equal regions
4360 (no, really equal, in this case!), or
4361 2. Separate regions of unequal size.
4363 The worst case is usually No. 2. It means that (aside from
4364 potential need for getting the gap out of the way), there also
4365 needs to be a shifting of the text between the two regions. So
4366 if they are spread far apart, we are that much slower... sigh. */
4368 /* It must be pointed out that the really studly thing to do would
4369 be not to move the gap at all, but to leave it in place and work
4370 around it if necessary. This would be extremely efficient,
4371 especially considering that people are likely to do
4372 transpositions near where they are working interactively, which
4373 is exactly where the gap would be found. However, such code
4374 would be much harder to write and to read. So, if you are
4375 reading this comment and are feeling squirrely, by all means have
4376 a go! I just didn't feel like doing it, so I will simply move
4377 the gap the minimum distance to get it out of the way, and then
4378 deal with an unbroken array. */
4380 /* Make sure the gap won't interfere, by moving it out of the text
4381 we will operate on. */
4382 if (start1
< gap
&& gap
< end2
)
4384 if (gap
- start1
< end2
- gap
)
4390 start1_byte
= CHAR_TO_BYTE (start1
);
4391 start2_byte
= CHAR_TO_BYTE (start2
);
4392 len1_byte
= CHAR_TO_BYTE (end1
) - start1_byte
;
4393 len2_byte
= CHAR_TO_BYTE (end2
) - start2_byte
;
4395 #ifdef BYTE_COMBINING_DEBUG
4398 if (count_combining_before (BYTE_POS_ADDR (start2_byte
),
4399 len2_byte
, start1
, start1_byte
)
4400 || count_combining_before (BYTE_POS_ADDR (start1_byte
),
4401 len1_byte
, end2
, start2_byte
+ len2_byte
)
4402 || count_combining_after (BYTE_POS_ADDR (start1_byte
),
4403 len1_byte
, end2
, start2_byte
+ len2_byte
))
4408 if (count_combining_before (BYTE_POS_ADDR (start2_byte
),
4409 len2_byte
, start1
, start1_byte
)
4410 || count_combining_before (BYTE_POS_ADDR (start1_byte
),
4411 len1_byte
, start2
, start2_byte
)
4412 || count_combining_after (BYTE_POS_ADDR (start2_byte
),
4413 len2_byte
, end1
, start1_byte
+ len1_byte
)
4414 || count_combining_after (BYTE_POS_ADDR (start1_byte
),
4415 len1_byte
, end2
, start2_byte
+ len2_byte
))
4420 /* Hmmm... how about checking to see if the gap is large
4421 enough to use as the temporary storage? That would avoid an
4422 allocation... interesting. Later, don't fool with it now. */
4424 /* Working without memmove, for portability (sigh), so must be
4425 careful of overlapping subsections of the array... */
4427 if (end1
== start2
) /* adjacent regions */
4429 modify_region (current_buffer
, start1
, end2
, 0);
4430 record_change (start1
, len1
+ len2
);
4432 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4433 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4434 /* Don't use Fset_text_properties: that can cause GC, which can
4435 clobber objects stored in the tmp_intervals. */
4436 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4437 if (!NULL_INTERVAL_P (tmp_interval3
))
4438 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4440 /* First region smaller than second. */
4441 if (len1_byte
< len2_byte
)
4445 SAFE_ALLOCA (temp
, unsigned char *, len2_byte
);
4447 /* Don't precompute these addresses. We have to compute them
4448 at the last minute, because the relocating allocator might
4449 have moved the buffer around during the xmalloc. */
4450 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4451 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4453 memcpy (temp
, start2_addr
, len2_byte
);
4454 memcpy (start1_addr
+ len2_byte
, start1_addr
, len1_byte
);
4455 memcpy (start1_addr
, temp
, len2_byte
);
4459 /* First region not smaller than second. */
4463 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4464 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4465 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4466 memcpy (temp
, start1_addr
, len1_byte
);
4467 memcpy (start1_addr
, start2_addr
, len2_byte
);
4468 memcpy (start1_addr
+ len2_byte
, temp
, len1_byte
);
4471 graft_intervals_into_buffer (tmp_interval1
, start1
+ len2
,
4472 len1
, current_buffer
, 0);
4473 graft_intervals_into_buffer (tmp_interval2
, start1
,
4474 len2
, current_buffer
, 0);
4475 update_compositions (start1
, start1
+ len2
, CHECK_BORDER
);
4476 update_compositions (start1
+ len2
, end2
, CHECK_TAIL
);
4478 /* Non-adjacent regions, because end1 != start2, bleagh... */
4481 len_mid
= start2_byte
- (start1_byte
+ len1_byte
);
4483 if (len1_byte
== len2_byte
)
4484 /* Regions are same size, though, how nice. */
4488 modify_region (current_buffer
, start1
, end1
, 0);
4489 modify_region (current_buffer
, start2
, end2
, 0);
4490 record_change (start1
, len1
);
4491 record_change (start2
, len2
);
4492 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4493 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4495 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr1
, 0);
4496 if (!NULL_INTERVAL_P (tmp_interval3
))
4497 set_text_properties_1 (startr1
, endr1
, Qnil
, buf
, tmp_interval3
);
4499 tmp_interval3
= validate_interval_range (buf
, &startr2
, &endr2
, 0);
4500 if (!NULL_INTERVAL_P (tmp_interval3
))
4501 set_text_properties_1 (startr2
, endr2
, Qnil
, buf
, tmp_interval3
);
4503 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4504 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4505 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4506 memcpy (temp
, start1_addr
, len1_byte
);
4507 memcpy (start1_addr
, start2_addr
, len2_byte
);
4508 memcpy (start2_addr
, temp
, len1_byte
);
4511 graft_intervals_into_buffer (tmp_interval1
, start2
,
4512 len1
, current_buffer
, 0);
4513 graft_intervals_into_buffer (tmp_interval2
, start1
,
4514 len2
, current_buffer
, 0);
4517 else if (len1_byte
< len2_byte
) /* Second region larger than first */
4518 /* Non-adjacent & unequal size, area between must also be shifted. */
4522 modify_region (current_buffer
, start1
, end2
, 0);
4523 record_change (start1
, (end2
- start1
));
4524 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4525 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
4526 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4528 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4529 if (!NULL_INTERVAL_P (tmp_interval3
))
4530 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4532 /* holds region 2 */
4533 SAFE_ALLOCA (temp
, unsigned char *, len2_byte
);
4534 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4535 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4536 memcpy (temp
, start2_addr
, len2_byte
);
4537 memcpy (start1_addr
+ len_mid
+ len2_byte
, start1_addr
, len1_byte
);
4538 memmove (start1_addr
+ len2_byte
, start1_addr
+ len1_byte
, len_mid
);
4539 memcpy (start1_addr
, temp
, len2_byte
);
4542 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
4543 len1
, current_buffer
, 0);
4544 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
4545 len_mid
, current_buffer
, 0);
4546 graft_intervals_into_buffer (tmp_interval2
, start1
,
4547 len2
, current_buffer
, 0);
4550 /* Second region smaller than first. */
4554 record_change (start1
, (end2
- start1
));
4555 modify_region (current_buffer
, start1
, end2
, 0);
4557 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4558 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
4559 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4561 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4562 if (!NULL_INTERVAL_P (tmp_interval3
))
4563 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4565 /* holds region 1 */
4566 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4567 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4568 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4569 memcpy (temp
, start1_addr
, len1_byte
);
4570 memcpy (start1_addr
, start2_addr
, len2_byte
);
4571 memcpy (start1_addr
+ len2_byte
, start1_addr
+ len1_byte
, len_mid
);
4572 memcpy (start1_addr
+ len2_byte
+ len_mid
, temp
, len1_byte
);
4575 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
4576 len1
, current_buffer
, 0);
4577 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
4578 len_mid
, current_buffer
, 0);
4579 graft_intervals_into_buffer (tmp_interval2
, start1
,
4580 len2
, current_buffer
, 0);
4583 update_compositions (start1
, start1
+ len2
, CHECK_BORDER
);
4584 update_compositions (end2
- len1
, end2
, CHECK_BORDER
);
4587 /* When doing multiple transpositions, it might be nice
4588 to optimize this. Perhaps the markers in any one buffer
4589 should be organized in some sorted data tree. */
4590 if (NILP (leave_markers
))
4592 transpose_markers (start1
, end1
, start2
, end2
,
4593 start1_byte
, start1_byte
+ len1_byte
,
4594 start2_byte
, start2_byte
+ len2_byte
);
4595 fix_start_end_in_overlays (start1
, end2
);
4598 signal_after_change (start1
, end2
- start1
, end2
- start1
);
4604 syms_of_editfns (void)
4609 Qbuffer_access_fontify_functions
4610 = intern_c_string ("buffer-access-fontify-functions");
4611 staticpro (&Qbuffer_access_fontify_functions
);
4613 DEFVAR_LISP ("inhibit-field-text-motion", &Vinhibit_field_text_motion
,
4614 doc
: /* Non-nil means text motion commands don't notice fields. */);
4615 Vinhibit_field_text_motion
= Qnil
;
4617 DEFVAR_LISP ("buffer-access-fontify-functions",
4618 &Vbuffer_access_fontify_functions
,
4619 doc
: /* List of functions called by `buffer-substring' to fontify if necessary.
4620 Each function is called with two arguments which specify the range
4621 of the buffer being accessed. */);
4622 Vbuffer_access_fontify_functions
= Qnil
;
4626 extern Lisp_Object Vprin1_to_string_buffer
;
4627 obuf
= Fcurrent_buffer ();
4628 /* Do this here, because init_buffer_once is too early--it won't work. */
4629 Fset_buffer (Vprin1_to_string_buffer
);
4630 /* Make sure buffer-access-fontify-functions is nil in this buffer. */
4631 Fset (Fmake_local_variable (intern_c_string ("buffer-access-fontify-functions")),
4636 DEFVAR_LISP ("buffer-access-fontified-property",
4637 &Vbuffer_access_fontified_property
,
4638 doc
: /* Property which (if non-nil) indicates text has been fontified.
4639 `buffer-substring' need not call the `buffer-access-fontify-functions'
4640 functions if all the text being accessed has this property. */);
4641 Vbuffer_access_fontified_property
= Qnil
;
4643 DEFVAR_LISP ("system-name", &Vsystem_name
,
4644 doc
: /* The host name of the machine Emacs is running on. */);
4646 DEFVAR_LISP ("user-full-name", &Vuser_full_name
,
4647 doc
: /* The full name of the user logged in. */);
4649 DEFVAR_LISP ("user-login-name", &Vuser_login_name
,
4650 doc
: /* The user's name, taken from environment variables if possible. */);
4652 DEFVAR_LISP ("user-real-login-name", &Vuser_real_login_name
,
4653 doc
: /* The user's name, based upon the real uid only. */);
4655 DEFVAR_LISP ("operating-system-release", &Voperating_system_release
,
4656 doc
: /* The release of the operating system Emacs is running on. */);
4658 defsubr (&Spropertize
);
4659 defsubr (&Schar_equal
);
4660 defsubr (&Sgoto_char
);
4661 defsubr (&Sstring_to_char
);
4662 defsubr (&Schar_to_string
);
4663 defsubr (&Sbyte_to_string
);
4664 defsubr (&Sbuffer_substring
);
4665 defsubr (&Sbuffer_substring_no_properties
);
4666 defsubr (&Sbuffer_string
);
4668 defsubr (&Spoint_marker
);
4669 defsubr (&Smark_marker
);
4671 defsubr (&Sregion_beginning
);
4672 defsubr (&Sregion_end
);
4674 staticpro (&Qfield
);
4675 Qfield
= intern_c_string ("field");
4676 staticpro (&Qboundary
);
4677 Qboundary
= intern_c_string ("boundary");
4678 defsubr (&Sfield_beginning
);
4679 defsubr (&Sfield_end
);
4680 defsubr (&Sfield_string
);
4681 defsubr (&Sfield_string_no_properties
);
4682 defsubr (&Sdelete_field
);
4683 defsubr (&Sconstrain_to_field
);
4685 defsubr (&Sline_beginning_position
);
4686 defsubr (&Sline_end_position
);
4688 /* defsubr (&Smark); */
4689 /* defsubr (&Sset_mark); */
4690 defsubr (&Ssave_excursion
);
4691 defsubr (&Ssave_current_buffer
);
4693 defsubr (&Sbufsize
);
4694 defsubr (&Spoint_max
);
4695 defsubr (&Spoint_min
);
4696 defsubr (&Spoint_min_marker
);
4697 defsubr (&Spoint_max_marker
);
4698 defsubr (&Sgap_position
);
4699 defsubr (&Sgap_size
);
4700 defsubr (&Sposition_bytes
);
4701 defsubr (&Sbyte_to_position
);
4707 defsubr (&Sfollowing_char
);
4708 defsubr (&Sprevious_char
);
4709 defsubr (&Schar_after
);
4710 defsubr (&Schar_before
);
4712 defsubr (&Sinsert_before_markers
);
4713 defsubr (&Sinsert_and_inherit
);
4714 defsubr (&Sinsert_and_inherit_before_markers
);
4715 defsubr (&Sinsert_char
);
4716 defsubr (&Sinsert_byte
);
4718 defsubr (&Suser_login_name
);
4719 defsubr (&Suser_real_login_name
);
4720 defsubr (&Suser_uid
);
4721 defsubr (&Suser_real_uid
);
4722 defsubr (&Suser_full_name
);
4723 defsubr (&Semacs_pid
);
4724 defsubr (&Scurrent_time
);
4725 defsubr (&Sget_internal_run_time
);
4726 defsubr (&Sformat_time_string
);
4727 defsubr (&Sfloat_time
);
4728 defsubr (&Sdecode_time
);
4729 defsubr (&Sencode_time
);
4730 defsubr (&Scurrent_time_string
);
4731 defsubr (&Scurrent_time_zone
);
4732 defsubr (&Sset_time_zone_rule
);
4733 defsubr (&Ssystem_name
);
4734 defsubr (&Smessage
);
4735 defsubr (&Smessage_box
);
4736 defsubr (&Smessage_or_box
);
4737 defsubr (&Scurrent_message
);
4740 defsubr (&Sinsert_buffer_substring
);
4741 defsubr (&Scompare_buffer_substrings
);
4742 defsubr (&Ssubst_char_in_region
);
4743 defsubr (&Stranslate_region_internal
);
4744 defsubr (&Sdelete_region
);
4745 defsubr (&Sdelete_and_extract_region
);
4747 defsubr (&Snarrow_to_region
);
4748 defsubr (&Ssave_restriction
);
4749 defsubr (&Stranspose_regions
);
4752 /* arch-tag: fc3827d8-6f60-4067-b11e-c3218031b018
4753 (do not change this comment) */