1 /* Lisp functions pertaining to editing.
2 Copyright (C) 1985, 1986, 1987, 1989, 1993, 1994, 1995, 1996,
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
23 #include <sys/types.h>
35 #ifdef HAVE_SYS_UTSNAME_H
36 #include <sys/utsname.h>
41 /* systime.h includes <sys/time.h> which, on some systems, is required
42 for <sys/resource.h>; thus systime.h must be included before
46 #if defined HAVE_SYS_RESOURCE_H
47 #include <sys/resource.h>
52 #include "intervals.h"
54 #include "character.h"
58 #include "blockinput.h"
62 #define MAX_10_EXP DBL_MAX_10_EXP
64 #define MAX_10_EXP 310
71 #ifndef USER_FULL_NAME
72 #define USER_FULL_NAME pw->pw_gecos
76 extern char **environ
;
79 #define TM_YEAR_BASE 1900
81 /* Nonzero if TM_YEAR is a struct tm's tm_year value that causes
82 asctime to have well-defined behavior. */
83 #ifndef TM_YEAR_IN_ASCTIME_RANGE
84 # define TM_YEAR_IN_ASCTIME_RANGE(tm_year) \
85 (1000 - TM_YEAR_BASE <= (tm_year) && (tm_year) <= 9999 - TM_YEAR_BASE)
88 extern size_t emacs_strftimeu
P_ ((char *, size_t, const char *,
89 const struct tm
*, int));
92 extern Lisp_Object
w32_get_internal_run_time ();
95 static int tm_diff
P_ ((struct tm
*, struct tm
*));
96 static void find_field
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
, int *, Lisp_Object
, int *));
97 static void update_buffer_properties
P_ ((int, int));
98 static Lisp_Object region_limit
P_ ((int));
99 int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
100 static size_t emacs_memftimeu
P_ ((char *, size_t, const char *,
101 size_t, const struct tm
*, int));
102 static void general_insert_function (void (*) (const unsigned char *, EMACS_INT
),
103 void (*) (Lisp_Object
, EMACS_INT
,
104 EMACS_INT
, EMACS_INT
,
106 int, int, Lisp_Object
*);
107 static Lisp_Object subst_char_in_region_unwind
P_ ((Lisp_Object
));
108 static Lisp_Object subst_char_in_region_unwind_1
P_ ((Lisp_Object
));
109 static void transpose_markers
P_ ((int, int, int, int, int, int, int, int));
112 extern char *index
P_ ((const char *, int));
115 Lisp_Object impl_Vbuffer_access_fontify_functions
;
116 Lisp_Object Qbuffer_access_fontify_functions
;
117 Lisp_Object impl_Vbuffer_access_fontified_property
;
119 Lisp_Object Fuser_full_name
P_ ((Lisp_Object
));
121 /* Non-nil means don't stop at field boundary in text motion commands. */
123 Lisp_Object impl_Vinhibit_field_text_motion
;
125 /* Some static data, and a function to initialize it for each run */
127 Lisp_Object impl_Vsystem_name
;
128 Lisp_Object impl_Vuser_real_login_name
; /* login name of current user ID */
129 Lisp_Object impl_Vuser_full_name
; /* full name of current user */
130 Lisp_Object impl_Vuser_login_name
; /* user name from LOGNAME or USER */
131 Lisp_Object impl_Voperating_system_release
; /* Operating System Release */
133 /* Symbol for the text property used to mark fields. */
137 /* A special value for Qfield properties. */
139 Lisp_Object Qboundary
;
146 register unsigned char *p
;
147 struct passwd
*pw
; /* password entry for the current user */
150 /* Set up system_name even when dumping. */
154 /* Don't bother with this on initial start when just dumping out */
157 #endif /* not CANNOT_DUMP */
159 pw
= (struct passwd
*) getpwuid (getuid ());
161 /* We let the real user name default to "root" because that's quite
162 accurate on MSDOG and because it lets Emacs find the init file.
163 (The DVX libraries override the Djgpp libraries here.) */
164 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "root");
166 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "unknown");
169 /* Get the effective user name, by consulting environment variables,
170 or the effective uid if those are unset. */
171 user_name
= (char *) getenv ("LOGNAME");
174 user_name
= (char *) getenv ("USERNAME"); /* it's USERNAME on NT */
175 #else /* WINDOWSNT */
176 user_name
= (char *) getenv ("USER");
177 #endif /* WINDOWSNT */
180 pw
= (struct passwd
*) getpwuid (geteuid ());
181 user_name
= (char *) (pw
? pw
->pw_name
: "unknown");
183 Vuser_login_name
= build_string (user_name
);
185 /* If the user name claimed in the environment vars differs from
186 the real uid, use the claimed name to find the full name. */
187 tem
= Fstring_equal (Vuser_login_name
, Vuser_real_login_name
);
188 Vuser_full_name
= Fuser_full_name (NILP (tem
)? make_number (geteuid())
191 p
= (unsigned char *) getenv ("NAME");
193 Vuser_full_name
= build_string (p
);
194 else if (NILP (Vuser_full_name
))
195 Vuser_full_name
= build_string ("unknown");
197 #ifdef HAVE_SYS_UTSNAME_H
201 Voperating_system_release
= build_string (uts
.release
);
204 Voperating_system_release
= Qnil
;
208 DEFUN ("char-to-string", Fchar_to_string
, Schar_to_string
, 1, 1, 0,
209 doc
: /* Convert arg CHAR to a string containing that character.
210 usage: (char-to-string CHAR) */)
212 Lisp_Object character
;
215 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
217 CHECK_CHARACTER (character
);
219 len
= CHAR_STRING (XFASTINT (character
), str
);
220 return make_string_from_bytes (str
, 1, len
);
223 DEFUN ("string-to-char", Fstring_to_char
, Sstring_to_char
, 1, 1, 0,
224 doc
: /* Convert arg STRING to a character, the first character of that string.
225 A multibyte character is handled correctly. */)
227 register Lisp_Object string
;
229 register Lisp_Object val
;
230 CHECK_STRING (string
);
233 if (STRING_MULTIBYTE (string
))
234 XSETFASTINT (val
, STRING_CHAR (SDATA (string
)));
236 XSETFASTINT (val
, SREF (string
, 0));
239 XSETFASTINT (val
, 0);
244 buildmark (charpos
, bytepos
)
245 int charpos
, bytepos
;
247 register Lisp_Object mark
;
248 mark
= Fmake_marker ();
249 set_marker_both (mark
, Qnil
, charpos
, bytepos
);
253 DEFUN ("point", Fpoint
, Spoint
, 0, 0, 0,
254 doc
: /* Return value of point, as an integer.
255 Beginning of buffer is position (point-min). */)
259 XSETFASTINT (temp
, PT
);
263 DEFUN ("point-marker", Fpoint_marker
, Spoint_marker
, 0, 0, 0,
264 doc
: /* Return value of point, as a marker object. */)
267 return buildmark (PT
, PT_BYTE
);
271 clip_to_bounds (lower
, num
, upper
)
272 int lower
, num
, upper
;
276 else if (num
> upper
)
282 DEFUN ("goto-char", Fgoto_char
, Sgoto_char
, 1, 1, "NGoto char: ",
283 doc
: /* Set point to POSITION, a number or marker.
284 Beginning of buffer is position (point-min), end is (point-max).
286 The return value is POSITION. */)
288 register Lisp_Object position
;
292 if (MARKERP (position
)
293 && current_buffer
== XMARKER (position
)->buffer
)
295 pos
= marker_position (position
);
297 SET_PT_BOTH (BEGV
, BEGV_BYTE
);
299 SET_PT_BOTH (ZV
, ZV_BYTE
);
301 SET_PT_BOTH (pos
, marker_byte_position (position
));
306 CHECK_NUMBER_COERCE_MARKER (position
);
308 pos
= clip_to_bounds (BEGV
, XINT (position
), ZV
);
314 /* Return the start or end position of the region.
315 BEGINNINGP non-zero means return the start.
316 If there is no region active, signal an error. */
319 region_limit (beginningp
)
324 if (!NILP (Vtransient_mark_mode
)
325 && NILP (Vmark_even_if_inactive
)
326 && NILP (current_buffer
->mark_active
))
327 xsignal0 (Qmark_inactive
);
329 m
= Fmarker_position (current_buffer
->mark
);
331 error ("The mark is not set now, so there is no region");
333 if ((PT
< XFASTINT (m
)) == (beginningp
!= 0))
334 m
= make_number (PT
);
338 DEFUN ("region-beginning", Fregion_beginning
, Sregion_beginning
, 0, 0, 0,
339 doc
: /* Return position of beginning of region, as an integer. */)
342 return region_limit (1);
345 DEFUN ("region-end", Fregion_end
, Sregion_end
, 0, 0, 0,
346 doc
: /* Return position of end of region, as an integer. */)
349 return region_limit (0);
352 DEFUN ("mark-marker", Fmark_marker
, Smark_marker
, 0, 0, 0,
353 doc
: /* Return this buffer's mark, as a marker object.
354 Watch out! Moving this marker changes the mark position.
355 If you set the marker not to point anywhere, the buffer will have no mark. */)
358 return current_buffer
->mark
;
362 /* Find all the overlays in the current buffer that touch position POS.
363 Return the number found, and store them in a vector in VEC
367 overlays_around (pos
, vec
, len
)
372 Lisp_Object overlay
, start
, end
;
373 struct Lisp_Overlay
*tail
;
374 int startpos
, endpos
;
377 for (tail
= current_buffer
->overlays_before
; tail
; tail
= tail
->next
)
379 XSETMISC (overlay
, tail
);
381 end
= OVERLAY_END (overlay
);
382 endpos
= OVERLAY_POSITION (end
);
385 start
= OVERLAY_START (overlay
);
386 startpos
= OVERLAY_POSITION (start
);
391 /* Keep counting overlays even if we can't return them all. */
396 for (tail
= current_buffer
->overlays_after
; tail
; tail
= tail
->next
)
398 XSETMISC (overlay
, tail
);
400 start
= OVERLAY_START (overlay
);
401 startpos
= OVERLAY_POSITION (start
);
404 end
= OVERLAY_END (overlay
);
405 endpos
= OVERLAY_POSITION (end
);
417 /* Return the value of property PROP, in OBJECT at POSITION.
418 It's the value of PROP that a char inserted at POSITION would get.
419 OBJECT is optional and defaults to the current buffer.
420 If OBJECT is a buffer, then overlay properties are considered as well as
422 If OBJECT is a window, then that window's buffer is used, but
423 window-specific overlays are considered only if they are associated
426 get_pos_property (position
, prop
, object
)
427 Lisp_Object position
, object
;
428 register Lisp_Object prop
;
430 CHECK_NUMBER_COERCE_MARKER (position
);
433 XSETBUFFER (object
, current_buffer
);
434 else if (WINDOWP (object
))
435 object
= XWINDOW (object
)->buffer
;
437 if (!BUFFERP (object
))
438 /* pos-property only makes sense in buffers right now, since strings
439 have no overlays and no notion of insertion for which stickiness
441 return Fget_text_property (position
, prop
, object
);
444 int posn
= XINT (position
);
446 Lisp_Object
*overlay_vec
, tem
;
447 struct buffer
*obuf
= current_buffer
;
449 set_buffer_temp (XBUFFER (object
));
451 /* First try with room for 40 overlays. */
453 overlay_vec
= (Lisp_Object
*) alloca (noverlays
* sizeof (Lisp_Object
));
454 noverlays
= overlays_around (posn
, overlay_vec
, noverlays
);
456 /* If there are more than 40,
457 make enough space for all, and try again. */
460 overlay_vec
= (Lisp_Object
*) alloca (noverlays
* sizeof (Lisp_Object
));
461 noverlays
= overlays_around (posn
, overlay_vec
, noverlays
);
463 noverlays
= sort_overlays (overlay_vec
, noverlays
, NULL
);
465 set_buffer_temp (obuf
);
467 /* Now check the overlays in order of decreasing priority. */
468 while (--noverlays
>= 0)
470 Lisp_Object ol
= overlay_vec
[noverlays
];
471 tem
= Foverlay_get (ol
, prop
);
474 /* Check the overlay is indeed active at point. */
475 Lisp_Object start
= OVERLAY_START (ol
), finish
= OVERLAY_END (ol
);
476 if ((OVERLAY_POSITION (start
) == posn
477 && XMARKER (start
)->insertion_type
== 1)
478 || (OVERLAY_POSITION (finish
) == posn
479 && XMARKER (finish
)->insertion_type
== 0))
480 ; /* The overlay will not cover a char inserted at point. */
488 { /* Now check the text properties. */
489 int stickiness
= text_property_stickiness (prop
, position
, object
);
491 return Fget_text_property (position
, prop
, object
);
492 else if (stickiness
< 0
493 && XINT (position
) > BUF_BEGV (XBUFFER (object
)))
494 return Fget_text_property (make_number (XINT (position
) - 1),
502 /* Find the field surrounding POS in *BEG and *END. If POS is nil,
503 the value of point is used instead. If BEG or END is null,
504 means don't store the beginning or end of the field.
506 BEG_LIMIT and END_LIMIT serve to limit the ranged of the returned
507 results; they do not effect boundary behavior.
509 If MERGE_AT_BOUNDARY is nonzero, then if POS is at the very first
510 position of a field, then the beginning of the previous field is
511 returned instead of the beginning of POS's field (since the end of a
512 field is actually also the beginning of the next input field, this
513 behavior is sometimes useful). Additionally in the MERGE_AT_BOUNDARY
514 true case, if two fields are separated by a field with the special
515 value `boundary', and POS lies within it, then the two separated
516 fields are considered to be adjacent, and POS between them, when
517 finding the beginning and ending of the "merged" field.
519 Either BEG or END may be 0, in which case the corresponding value
523 find_field (pos
, merge_at_boundary
, beg_limit
, beg
, end_limit
, end
)
525 Lisp_Object merge_at_boundary
;
526 Lisp_Object beg_limit
, end_limit
;
529 /* Fields right before and after the point. */
530 Lisp_Object before_field
, after_field
;
531 /* 1 if POS counts as the start of a field. */
532 int at_field_start
= 0;
533 /* 1 if POS counts as the end of a field. */
534 int at_field_end
= 0;
537 XSETFASTINT (pos
, PT
);
539 CHECK_NUMBER_COERCE_MARKER (pos
);
542 = get_char_property_and_overlay (pos
, Qfield
, Qnil
, NULL
);
544 = (XFASTINT (pos
) > BEGV
545 ? get_char_property_and_overlay (make_number (XINT (pos
) - 1),
547 /* Using nil here would be a more obvious choice, but it would
548 fail when the buffer starts with a non-sticky field. */
551 /* See if we need to handle the case where MERGE_AT_BOUNDARY is nil
552 and POS is at beginning of a field, which can also be interpreted
553 as the end of the previous field. Note that the case where if
554 MERGE_AT_BOUNDARY is non-nil (see function comment) is actually the
555 more natural one; then we avoid treating the beginning of a field
557 if (NILP (merge_at_boundary
))
559 Lisp_Object field
= get_pos_property (pos
, Qfield
, Qnil
);
560 if (!EQ (field
, after_field
))
562 if (!EQ (field
, before_field
))
564 if (NILP (field
) && at_field_start
&& at_field_end
)
565 /* If an inserted char would have a nil field while the surrounding
566 text is non-nil, we're probably not looking at a
567 zero-length field, but instead at a non-nil field that's
568 not intended for editing (such as comint's prompts). */
569 at_field_end
= at_field_start
= 0;
572 /* Note about special `boundary' fields:
574 Consider the case where the point (`.') is between the fields `x' and `y':
578 In this situation, if merge_at_boundary is true, we consider the
579 `x' and `y' fields as forming one big merged field, and so the end
580 of the field is the end of `y'.
582 However, if `x' and `y' are separated by a special `boundary' field
583 (a field with a `field' char-property of 'boundary), then we ignore
584 this special field when merging adjacent fields. Here's the same
585 situation, but with a `boundary' field between the `x' and `y' fields:
589 Here, if point is at the end of `x', the beginning of `y', or
590 anywhere in-between (within the `boundary' field), we merge all
591 three fields and consider the beginning as being the beginning of
592 the `x' field, and the end as being the end of the `y' field. */
597 /* POS is at the edge of a field, and we should consider it as
598 the beginning of the following field. */
599 *beg
= XFASTINT (pos
);
601 /* Find the previous field boundary. */
604 if (!NILP (merge_at_boundary
) && EQ (before_field
, Qboundary
))
605 /* Skip a `boundary' field. */
606 p
= Fprevious_single_char_property_change (p
, Qfield
, Qnil
,
609 p
= Fprevious_single_char_property_change (p
, Qfield
, Qnil
,
611 *beg
= NILP (p
) ? BEGV
: XFASTINT (p
);
618 /* POS is at the edge of a field, and we should consider it as
619 the end of the previous field. */
620 *end
= XFASTINT (pos
);
622 /* Find the next field boundary. */
624 if (!NILP (merge_at_boundary
) && EQ (after_field
, Qboundary
))
625 /* Skip a `boundary' field. */
626 pos
= Fnext_single_char_property_change (pos
, Qfield
, Qnil
,
629 pos
= Fnext_single_char_property_change (pos
, Qfield
, Qnil
,
631 *end
= NILP (pos
) ? ZV
: XFASTINT (pos
);
637 DEFUN ("delete-field", Fdelete_field
, Sdelete_field
, 0, 1, 0,
638 doc
: /* Delete the field surrounding POS.
639 A field is a region of text with the same `field' property.
640 If POS is nil, the value of point is used for POS. */)
645 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
647 del_range (beg
, end
);
651 DEFUN ("field-string", Ffield_string
, Sfield_string
, 0, 1, 0,
652 doc
: /* Return the contents of the field surrounding POS as a string.
653 A field is a region of text with the same `field' property.
654 If POS is nil, the value of point is used for POS. */)
659 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
660 return make_buffer_string (beg
, end
, 1);
663 DEFUN ("field-string-no-properties", Ffield_string_no_properties
, Sfield_string_no_properties
, 0, 1, 0,
664 doc
: /* Return the contents of the field around POS, without text properties.
665 A field is a region of text with the same `field' property.
666 If POS is nil, the value of point is used for POS. */)
671 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
672 return make_buffer_string (beg
, end
, 0);
675 DEFUN ("field-beginning", Ffield_beginning
, Sfield_beginning
, 0, 3, 0,
676 doc
: /* Return the beginning of the field surrounding POS.
677 A field is a region of text with the same `field' property.
678 If POS is nil, the value of point is used for POS.
679 If ESCAPE-FROM-EDGE is non-nil and POS is at the beginning of its
680 field, then the beginning of the *previous* field is returned.
681 If LIMIT is non-nil, it is a buffer position; if the beginning of the field
682 is before LIMIT, then LIMIT will be returned instead. */)
683 (pos
, escape_from_edge
, limit
)
684 Lisp_Object pos
, escape_from_edge
, limit
;
687 find_field (pos
, escape_from_edge
, limit
, &beg
, Qnil
, 0);
688 return make_number (beg
);
691 DEFUN ("field-end", Ffield_end
, Sfield_end
, 0, 3, 0,
692 doc
: /* Return the end of the field surrounding POS.
693 A field is a region of text with the same `field' property.
694 If POS is nil, the value of point is used for POS.
695 If ESCAPE-FROM-EDGE is non-nil and POS is at the end of its field,
696 then the end of the *following* field is returned.
697 If LIMIT is non-nil, it is a buffer position; if the end of the field
698 is after LIMIT, then LIMIT will be returned instead. */)
699 (pos
, escape_from_edge
, limit
)
700 Lisp_Object pos
, escape_from_edge
, limit
;
703 find_field (pos
, escape_from_edge
, Qnil
, 0, limit
, &end
);
704 return make_number (end
);
707 DEFUN ("constrain-to-field", Fconstrain_to_field
, Sconstrain_to_field
, 2, 5, 0,
708 doc
: /* Return the position closest to NEW-POS that is in the same field as OLD-POS.
710 A field is a region of text with the same `field' property.
711 If NEW-POS is nil, then the current point is used instead, and set to the
712 constrained position if that is different.
714 If OLD-POS is at the boundary of two fields, then the allowable
715 positions for NEW-POS depends on the value of the optional argument
716 ESCAPE-FROM-EDGE: If ESCAPE-FROM-EDGE is nil, then NEW-POS is
717 constrained to the field that has the same `field' char-property
718 as any new characters inserted at OLD-POS, whereas if ESCAPE-FROM-EDGE
719 is non-nil, NEW-POS is constrained to the union of the two adjacent
720 fields. Additionally, if two fields are separated by another field with
721 the special value `boundary', then any point within this special field is
722 also considered to be `on the boundary'.
724 If the optional argument ONLY-IN-LINE is non-nil and constraining
725 NEW-POS would move it to a different line, NEW-POS is returned
726 unconstrained. This useful for commands that move by line, like
727 \\[next-line] or \\[beginning-of-line], which should generally respect field boundaries
728 only in the case where they can still move to the right line.
730 If the optional argument INHIBIT-CAPTURE-PROPERTY is non-nil, and OLD-POS has
731 a non-nil property of that name, then any field boundaries are ignored.
733 Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil. */)
734 (new_pos
, old_pos
, escape_from_edge
, only_in_line
, inhibit_capture_property
)
735 Lisp_Object new_pos
, old_pos
;
736 Lisp_Object escape_from_edge
, only_in_line
, inhibit_capture_property
;
738 /* If non-zero, then the original point, before re-positioning. */
741 Lisp_Object prev_old
, prev_new
;
744 /* Use the current point, and afterwards, set it. */
747 XSETFASTINT (new_pos
, PT
);
750 CHECK_NUMBER_COERCE_MARKER (new_pos
);
751 CHECK_NUMBER_COERCE_MARKER (old_pos
);
753 fwd
= (XFASTINT (new_pos
) > XFASTINT (old_pos
));
755 prev_old
= make_number (XFASTINT (old_pos
) - 1);
756 prev_new
= make_number (XFASTINT (new_pos
) - 1);
758 if (NILP (Vinhibit_field_text_motion
)
759 && !EQ (new_pos
, old_pos
)
760 && (!NILP (Fget_char_property (new_pos
, Qfield
, Qnil
))
761 || !NILP (Fget_char_property (old_pos
, Qfield
, Qnil
))
762 /* To recognize field boundaries, we must also look at the
763 previous positions; we could use `get_pos_property'
764 instead, but in itself that would fail inside non-sticky
765 fields (like comint prompts). */
766 || (XFASTINT (new_pos
) > BEGV
767 && !NILP (Fget_char_property (prev_new
, Qfield
, Qnil
)))
768 || (XFASTINT (old_pos
) > BEGV
769 && !NILP (Fget_char_property (prev_old
, Qfield
, Qnil
))))
770 && (NILP (inhibit_capture_property
)
771 /* Field boundaries are again a problem; but now we must
772 decide the case exactly, so we need to call
773 `get_pos_property' as well. */
774 || (NILP (get_pos_property (old_pos
, inhibit_capture_property
, Qnil
))
775 && (XFASTINT (old_pos
) <= BEGV
776 || NILP (Fget_char_property (old_pos
, inhibit_capture_property
, Qnil
))
777 || NILP (Fget_char_property (prev_old
, inhibit_capture_property
, Qnil
))))))
778 /* It is possible that NEW_POS is not within the same field as
779 OLD_POS; try to move NEW_POS so that it is. */
782 Lisp_Object field_bound
;
785 field_bound
= Ffield_end (old_pos
, escape_from_edge
, new_pos
);
787 field_bound
= Ffield_beginning (old_pos
, escape_from_edge
, new_pos
);
789 if (/* See if ESCAPE_FROM_EDGE caused FIELD_BOUND to jump to the
790 other side of NEW_POS, which would mean that NEW_POS is
791 already acceptable, and it's not necessary to constrain it
793 ((XFASTINT (field_bound
) < XFASTINT (new_pos
)) ? fwd
: !fwd
)
794 /* NEW_POS should be constrained, but only if either
795 ONLY_IN_LINE is nil (in which case any constraint is OK),
796 or NEW_POS and FIELD_BOUND are on the same line (in which
797 case the constraint is OK even if ONLY_IN_LINE is non-nil). */
798 && (NILP (only_in_line
)
799 /* This is the ONLY_IN_LINE case, check that NEW_POS and
800 FIELD_BOUND are on the same line by seeing whether
801 there's an intervening newline or not. */
802 || (scan_buffer ('\n',
803 XFASTINT (new_pos
), XFASTINT (field_bound
),
804 fwd
? -1 : 1, &shortage
, 1),
806 /* Constrain NEW_POS to FIELD_BOUND. */
807 new_pos
= field_bound
;
809 if (orig_point
&& XFASTINT (new_pos
) != orig_point
)
810 /* The NEW_POS argument was originally nil, so automatically set PT. */
811 SET_PT (XFASTINT (new_pos
));
818 DEFUN ("line-beginning-position",
819 Fline_beginning_position
, Sline_beginning_position
, 0, 1, 0,
820 doc
: /* Return the character position of the first character on the current line.
821 With argument N not nil or 1, move forward N - 1 lines first.
822 If scan reaches end of buffer, return that position.
824 This function constrains the returned position to the current field
825 unless that would be on a different line than the original,
826 unconstrained result. If N is nil or 1, and a front-sticky field
827 starts at point, the scan stops as soon as it starts. To ignore field
828 boundaries bind `inhibit-field-text-motion' to t.
830 This function does not move point. */)
834 int orig
, orig_byte
, end
;
835 int count
= SPECPDL_INDEX ();
836 specbind (Qinhibit_point_motion_hooks
, Qt
);
845 Fforward_line (make_number (XINT (n
) - 1));
848 SET_PT_BOTH (orig
, orig_byte
);
850 unbind_to (count
, Qnil
);
852 /* Return END constrained to the current input field. */
853 return Fconstrain_to_field (make_number (end
), make_number (orig
),
854 XINT (n
) != 1 ? Qt
: Qnil
,
858 DEFUN ("line-end-position", Fline_end_position
, Sline_end_position
, 0, 1, 0,
859 doc
: /* Return the character position of the last character on the current line.
860 With argument N not nil or 1, move forward N - 1 lines first.
861 If scan reaches end of buffer, return that position.
863 This function constrains the returned position to the current field
864 unless that would be on a different line than the original,
865 unconstrained result. If N is nil or 1, and a rear-sticky field ends
866 at point, the scan stops as soon as it starts. To ignore field
867 boundaries bind `inhibit-field-text-motion' to t.
869 This function does not move point. */)
881 end_pos
= find_before_next_newline (orig
, 0, XINT (n
) - (XINT (n
) <= 0));
883 /* Return END_POS constrained to the current input field. */
884 return Fconstrain_to_field (make_number (end_pos
), make_number (orig
),
890 save_excursion_save ()
892 int visible
= (XBUFFER (XWINDOW (selected_window
)->buffer
)
895 return Fcons (Fpoint_marker (),
896 Fcons (Fcopy_marker (current_buffer
->mark
, Qnil
),
897 Fcons (visible
? Qt
: Qnil
,
898 Fcons (current_buffer
->mark_active
,
903 save_excursion_restore (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 bcopy (p
, r
, 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 */
1432 if (STRINGP (Vsystem_name
))
1433 return (char *) SDATA (Vsystem_name
);
1439 get_operating_system_release()
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 (specified_time
, result
, usec
)
1518 Lisp_Object specified_time
;
1522 if (NILP (specified_time
))
1529 *usec
= EMACS_USECS (t
);
1530 *result
= EMACS_SECS (t
);
1534 return time (result
) != -1;
1538 Lisp_Object high
, low
;
1539 high
= Fcar (specified_time
);
1540 CHECK_NUMBER (high
);
1541 low
= Fcdr (specified_time
);
1546 Lisp_Object usec_l
= Fcdr (low
);
1548 usec_l
= Fcar (usec_l
);
1553 CHECK_NUMBER (usec_l
);
1554 *usec
= XINT (usec_l
);
1562 *result
= (XINT (high
) << 16) + (XINT (low
) & 0xffff);
1563 return *result
>> 16 == XINT (high
);
1567 DEFUN ("float-time", Ffloat_time
, Sfloat_time
, 0, 1, 0,
1568 doc
: /* Return the current time, as a float number of seconds since the epoch.
1569 If SPECIFIED-TIME is given, it is the time to convert to float
1570 instead of the current time. The argument should have the form
1571 (HIGH LOW) or (HIGH LOW USEC). Thus, you can use times obtained from
1572 `current-time' and from `file-attributes'. SPECIFIED-TIME can also
1573 have the form (HIGH . LOW), but this is considered obsolete.
1575 WARNING: Since the result is floating point, it may not be exact.
1576 If precise time stamps are required, use either `current-time',
1577 or (if you need time as a string) `format-time-string'. */)
1579 Lisp_Object specified_time
;
1584 if (! lisp_time_argument (specified_time
, &sec
, &usec
))
1585 error ("Invalid time specification");
1587 return make_float ((sec
* 1e6
+ usec
) / 1e6
);
1590 /* Write information into buffer S of size MAXSIZE, according to the
1591 FORMAT of length FORMAT_LEN, using time information taken from *TP.
1592 Default to Universal Time if UT is nonzero, local time otherwise.
1593 Return the number of bytes written, not including the terminating
1594 '\0'. If S is NULL, nothing will be written anywhere; so to
1595 determine how many bytes would be written, use NULL for S and
1596 ((size_t) -1) for MAXSIZE.
1598 This function behaves like emacs_strftimeu, except it allows null
1601 emacs_memftimeu (s
, maxsize
, format
, format_len
, tp
, ut
)
1606 const struct tm
*tp
;
1611 /* Loop through all the null-terminated strings in the format
1612 argument. Normally there's just one null-terminated string, but
1613 there can be arbitrarily many, concatenated together, if the
1614 format contains '\0' bytes. emacs_strftimeu stops at the first
1615 '\0' byte so we must invoke it separately for each such string. */
1624 result
= emacs_strftimeu (s
, maxsize
, format
, tp
, ut
);
1628 if (result
== 0 && s
[0] != '\0')
1633 maxsize
-= result
+ 1;
1635 len
= strlen (format
);
1636 if (len
== format_len
)
1640 format_len
-= len
+ 1;
1644 DEFUN ("format-time-string", Fformat_time_string
, Sformat_time_string
, 1, 3, 0,
1645 doc
: /* Use FORMAT-STRING to format the time TIME, or now if omitted.
1646 TIME is specified as (HIGH LOW . IGNORED), as returned by
1647 `current-time' or `file-attributes'. The obsolete form (HIGH . LOW)
1648 is also still accepted.
1649 The third, optional, argument UNIVERSAL, if non-nil, means describe TIME
1650 as Universal Time; nil means describe TIME in the local time zone.
1651 The value is a copy of FORMAT-STRING, but with certain constructs replaced
1652 by text that describes the specified date and time in TIME:
1654 %Y is the year, %y within the century, %C the century.
1655 %G is the year corresponding to the ISO week, %g within the century.
1656 %m is the numeric month.
1657 %b and %h are the locale's abbreviated month name, %B the full name.
1658 %d is the day of the month, zero-padded, %e is blank-padded.
1659 %u is the numeric day of week from 1 (Monday) to 7, %w from 0 (Sunday) to 6.
1660 %a is the locale's abbreviated name of the day of week, %A the full name.
1661 %U is the week number starting on Sunday, %W starting on Monday,
1662 %V according to ISO 8601.
1663 %j is the day of the year.
1665 %H is the hour on a 24-hour clock, %I is on a 12-hour clock, %k is like %H
1666 only blank-padded, %l is like %I blank-padded.
1667 %p is the locale's equivalent of either AM or PM.
1670 %Z is the time zone name, %z is the numeric form.
1671 %s is the number of seconds since 1970-01-01 00:00:00 +0000.
1673 %c is the locale's date and time format.
1674 %x is the locale's "preferred" date format.
1675 %D is like "%m/%d/%y".
1677 %R is like "%H:%M", %T is like "%H:%M:%S", %r is like "%I:%M:%S %p".
1678 %X is the locale's "preferred" time format.
1680 Finally, %n is a newline, %t is a tab, %% is a literal %.
1682 Certain flags and modifiers are available with some format controls.
1683 The flags are `_', `-', `^' and `#'. For certain characters X,
1684 %_X is like %X, but padded with blanks; %-X is like %X,
1685 but without padding. %^X is like %X, but with all textual
1686 characters up-cased; %#X is like %X, but with letter-case of
1687 all textual characters reversed.
1688 %NX (where N stands for an integer) is like %X,
1689 but takes up at least N (a number) positions.
1690 The modifiers are `E' and `O'. For certain characters X,
1691 %EX is a locale's alternative version of %X;
1692 %OX is like %X, but uses the locale's number symbols.
1694 For example, to produce full ISO 8601 format, use "%Y-%m-%dT%T%z". */)
1695 (format_string
, time
, universal
)
1696 Lisp_Object format_string
, time
, universal
;
1701 int ut
= ! NILP (universal
);
1703 CHECK_STRING (format_string
);
1705 if (! lisp_time_argument (time
, &value
, NULL
))
1706 error ("Invalid time specification");
1708 format_string
= code_convert_string_norecord (format_string
,
1709 Vlocale_coding_system
, 1);
1711 /* This is probably enough. */
1712 size
= SBYTES (format_string
) * 6 + 50;
1715 tm
= ut
? gmtime (&value
) : localtime (&value
);
1718 error ("Specified time is not representable");
1720 synchronize_system_time_locale ();
1724 char *buf
= (char *) alloca (size
+ 1);
1729 result
= emacs_memftimeu (buf
, size
, SDATA (format_string
),
1730 SBYTES (format_string
),
1733 if ((result
> 0 && result
< size
) || (result
== 0 && buf
[0] == '\0'))
1734 return code_convert_string_norecord (make_unibyte_string (buf
, result
),
1735 Vlocale_coding_system
, 0);
1737 /* If buffer was too small, make it bigger and try again. */
1739 result
= emacs_memftimeu (NULL
, (size_t) -1,
1740 SDATA (format_string
),
1741 SBYTES (format_string
),
1748 DEFUN ("decode-time", Fdecode_time
, Sdecode_time
, 0, 1, 0,
1749 doc
: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).
1750 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED),
1751 as from `current-time' and `file-attributes', or nil to use the
1752 current time. The obsolete form (HIGH . LOW) is also still accepted.
1753 The list has the following nine members: SEC is an integer between 0
1754 and 60; SEC is 60 for a leap second, which only some operating systems
1755 support. MINUTE is an integer between 0 and 59. HOUR is an integer
1756 between 0 and 23. DAY is an integer between 1 and 31. MONTH is an
1757 integer between 1 and 12. YEAR is an integer indicating the
1758 four-digit year. DOW is the day of week, an integer between 0 and 6,
1759 where 0 is Sunday. DST is t if daylight saving time is in effect,
1760 otherwise nil. ZONE is an integer indicating the number of seconds
1761 east of Greenwich. (Note that Common Lisp has different meanings for
1764 Lisp_Object specified_time
;
1768 struct tm
*decoded_time
;
1769 Lisp_Object list_args
[9];
1771 if (! lisp_time_argument (specified_time
, &time_spec
, NULL
))
1772 error ("Invalid time specification");
1775 decoded_time
= localtime (&time_spec
);
1778 error ("Specified time is not representable");
1779 XSETFASTINT (list_args
[0], decoded_time
->tm_sec
);
1780 XSETFASTINT (list_args
[1], decoded_time
->tm_min
);
1781 XSETFASTINT (list_args
[2], decoded_time
->tm_hour
);
1782 XSETFASTINT (list_args
[3], decoded_time
->tm_mday
);
1783 XSETFASTINT (list_args
[4], decoded_time
->tm_mon
+ 1);
1784 /* On 64-bit machines an int is narrower than EMACS_INT, thus the
1785 cast below avoids overflow in int arithmetics. */
1786 XSETINT (list_args
[5], TM_YEAR_BASE
+ (EMACS_INT
) decoded_time
->tm_year
);
1787 XSETFASTINT (list_args
[6], decoded_time
->tm_wday
);
1788 list_args
[7] = (decoded_time
->tm_isdst
)? Qt
: Qnil
;
1790 /* Make a copy, in case gmtime modifies the struct. */
1791 save_tm
= *decoded_time
;
1793 decoded_time
= gmtime (&time_spec
);
1795 if (decoded_time
== 0)
1796 list_args
[8] = Qnil
;
1798 XSETINT (list_args
[8], tm_diff (&save_tm
, decoded_time
));
1799 return Flist (9, list_args
);
1802 DEFUN ("encode-time", Fencode_time
, Sencode_time
, 6, MANY
, 0,
1803 doc
: /* Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
1804 This is the reverse operation of `decode-time', which see.
1805 ZONE defaults to the current time zone rule. This can
1806 be a string or t (as from `set-time-zone-rule'), or it can be a list
1807 \(as from `current-time-zone') or an integer (as from `decode-time')
1808 applied without consideration for daylight saving time.
1810 You can pass more than 7 arguments; then the first six arguments
1811 are used as SECOND through YEAR, and the *last* argument is used as ZONE.
1812 The intervening arguments are ignored.
1813 This feature lets (apply 'encode-time (decode-time ...)) work.
1815 Out-of-range values for SECOND, MINUTE, HOUR, DAY, or MONTH are allowed;
1816 for example, a DAY of 0 means the day preceding the given month.
1817 Year numbers less than 100 are treated just like other year numbers.
1818 If you want them to stand for years in this century, you must do that yourself.
1820 Years before 1970 are not guaranteed to work. On some systems,
1821 year values as low as 1901 do work.
1823 usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */)
1826 register Lisp_Object
*args
;
1830 Lisp_Object zone
= (nargs
> 6 ? args
[nargs
- 1] : Qnil
);
1832 CHECK_NUMBER (args
[0]); /* second */
1833 CHECK_NUMBER (args
[1]); /* minute */
1834 CHECK_NUMBER (args
[2]); /* hour */
1835 CHECK_NUMBER (args
[3]); /* day */
1836 CHECK_NUMBER (args
[4]); /* month */
1837 CHECK_NUMBER (args
[5]); /* year */
1839 tm
.tm_sec
= XINT (args
[0]);
1840 tm
.tm_min
= XINT (args
[1]);
1841 tm
.tm_hour
= XINT (args
[2]);
1842 tm
.tm_mday
= XINT (args
[3]);
1843 tm
.tm_mon
= XINT (args
[4]) - 1;
1844 tm
.tm_year
= XINT (args
[5]) - TM_YEAR_BASE
;
1852 time
= mktime (&tm
);
1859 char **oldenv
= environ
, **newenv
;
1863 else if (STRINGP (zone
))
1864 tzstring
= (char *) SDATA (zone
);
1865 else if (INTEGERP (zone
))
1867 int abszone
= eabs (XINT (zone
));
1868 sprintf (tzbuf
, "XXX%s%d:%02d:%02d", "-" + (XINT (zone
) < 0),
1869 abszone
/ (60*60), (abszone
/60) % 60, abszone
% 60);
1873 error ("Invalid time zone specification");
1875 /* Set TZ before calling mktime; merely adjusting mktime's returned
1876 value doesn't suffice, since that would mishandle leap seconds. */
1877 set_time_zone_rule (tzstring
);
1880 time
= mktime (&tm
);
1883 /* Restore TZ to previous value. */
1887 #ifdef LOCALTIME_CACHE
1892 if (time
== (time_t) -1)
1893 error ("Specified time is not representable");
1895 return make_time (time
);
1898 DEFUN ("current-time-string", Fcurrent_time_string
, Scurrent_time_string
, 0, 1, 0,
1899 doc
: /* Return the current local time, as a human-readable string.
1900 Programs can use this function to decode a time,
1901 since the number of columns in each field is fixed
1902 if the year is in the range 1000-9999.
1903 The format is `Sun Sep 16 01:03:52 1973'.
1904 However, see also the functions `decode-time' and `format-time-string'
1905 which provide a much more powerful and general facility.
1907 If SPECIFIED-TIME is given, it is a time to format instead of the
1908 current time. The argument should have the form (HIGH LOW . IGNORED).
1909 Thus, you can use times obtained from `current-time' and from
1910 `file-attributes'. SPECIFIED-TIME can also have the form (HIGH . LOW),
1911 but this is considered obsolete. */)
1913 Lisp_Object specified_time
;
1919 if (! lisp_time_argument (specified_time
, &value
, NULL
))
1920 error ("Invalid time specification");
1922 /* Convert to a string, checking for out-of-range time stamps.
1923 Don't use 'ctime', as that might dump core if VALUE is out of
1926 tm
= localtime (&value
);
1928 if (! (tm
&& TM_YEAR_IN_ASCTIME_RANGE (tm
->tm_year
) && (tem
= asctime (tm
))))
1929 error ("Specified time is not representable");
1931 /* Remove the trailing newline. */
1932 tem
[strlen (tem
) - 1] = '\0';
1934 return build_string (tem
);
1937 /* Yield A - B, measured in seconds.
1938 This function is copied from the GNU C Library. */
1943 /* Compute intervening leap days correctly even if year is negative.
1944 Take care to avoid int overflow in leap day calculations,
1945 but it's OK to assume that A and B are close to each other. */
1946 int a4
= (a
->tm_year
>> 2) + (TM_YEAR_BASE
>> 2) - ! (a
->tm_year
& 3);
1947 int b4
= (b
->tm_year
>> 2) + (TM_YEAR_BASE
>> 2) - ! (b
->tm_year
& 3);
1948 int a100
= a4
/ 25 - (a4
% 25 < 0);
1949 int b100
= b4
/ 25 - (b4
% 25 < 0);
1950 int a400
= a100
>> 2;
1951 int b400
= b100
>> 2;
1952 int intervening_leap_days
= (a4
- b4
) - (a100
- b100
) + (a400
- b400
);
1953 int years
= a
->tm_year
- b
->tm_year
;
1954 int days
= (365 * years
+ intervening_leap_days
1955 + (a
->tm_yday
- b
->tm_yday
));
1956 return (60 * (60 * (24 * days
+ (a
->tm_hour
- b
->tm_hour
))
1957 + (a
->tm_min
- b
->tm_min
))
1958 + (a
->tm_sec
- b
->tm_sec
));
1961 DEFUN ("current-time-zone", Fcurrent_time_zone
, Scurrent_time_zone
, 0, 1, 0,
1962 doc
: /* Return the offset and name for the local time zone.
1963 This returns a list of the form (OFFSET NAME).
1964 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
1965 A negative value means west of Greenwich.
1966 NAME is a string giving the name of the time zone.
1967 If SPECIFIED-TIME is given, the time zone offset is determined from it
1968 instead of using the current time. The argument should have the form
1969 (HIGH LOW . IGNORED). Thus, you can use times obtained from
1970 `current-time' and from `file-attributes'. SPECIFIED-TIME can also
1971 have the form (HIGH . LOW), but this is considered obsolete.
1973 Some operating systems cannot provide all this information to Emacs;
1974 in this case, `current-time-zone' returns a list containing nil for
1975 the data it can't find. */)
1977 Lisp_Object specified_time
;
1983 if (!lisp_time_argument (specified_time
, &value
, NULL
))
1988 t
= gmtime (&value
);
1992 t
= localtime (&value
);
1999 int offset
= tm_diff (t
, &gmt
);
2005 s
= (char *)t
->tm_zone
;
2006 #else /* not HAVE_TM_ZONE */
2008 if (t
->tm_isdst
== 0 || t
->tm_isdst
== 1)
2009 s
= tzname
[t
->tm_isdst
];
2011 #endif /* not HAVE_TM_ZONE */
2015 /* No local time zone name is available; use "+-NNNN" instead. */
2016 int am
= (offset
< 0 ? -offset
: offset
) / 60;
2017 sprintf (buf
, "%c%02d%02d", (offset
< 0 ? '-' : '+'), am
/60, am
%60);
2021 return Fcons (make_number (offset
), Fcons (build_string (s
), Qnil
));
2024 return Fmake_list (make_number (2), Qnil
);
2027 /* This holds the value of `environ' produced by the previous
2028 call to Fset_time_zone_rule, or 0 if Fset_time_zone_rule
2029 has never been called. */
2030 static char **environbuf
;
2032 /* This holds the startup value of the TZ environment variable so it
2033 can be restored if the user calls set-time-zone-rule with a nil
2035 static char *initial_tz
;
2037 DEFUN ("set-time-zone-rule", Fset_time_zone_rule
, Sset_time_zone_rule
, 1, 1, 0,
2038 doc
: /* Set the local time zone using TZ, a string specifying a time zone rule.
2039 If TZ is nil, use implementation-defined default time zone information.
2040 If TZ is t, use Universal Time. */)
2046 /* When called for the first time, save the original TZ. */
2048 initial_tz
= (char *) getenv ("TZ");
2051 tzstring
= initial_tz
;
2052 else if (EQ (tz
, Qt
))
2057 tzstring
= (char *) SDATA (tz
);
2060 set_time_zone_rule (tzstring
);
2062 environbuf
= environ
;
2067 #ifdef LOCALTIME_CACHE
2069 /* These two values are known to load tz files in buggy implementations,
2070 i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2.
2071 Their values shouldn't matter in non-buggy implementations.
2072 We don't use string literals for these strings,
2073 since if a string in the environment is in readonly
2074 storage, it runs afoul of bugs in SVR4 and Solaris 2.3.
2075 See Sun bugs 1113095 and 1114114, ``Timezone routines
2076 improperly modify environment''. */
2078 static char set_time_zone_rule_tz1
[] = "TZ=GMT+0";
2079 static char set_time_zone_rule_tz2
[] = "TZ=GMT+1";
2083 /* Set the local time zone rule to TZSTRING.
2084 This allocates memory into `environ', which it is the caller's
2085 responsibility to free. */
2088 set_time_zone_rule (tzstring
)
2092 char **from
, **to
, **newenv
;
2094 /* Make the ENVIRON vector longer with room for TZSTRING. */
2095 for (from
= environ
; *from
; from
++)
2097 envptrs
= from
- environ
+ 2;
2098 newenv
= to
= (char **) xmalloc (envptrs
* sizeof (char *)
2099 + (tzstring
? strlen (tzstring
) + 4 : 0));
2101 /* Add TZSTRING to the end of environ, as a value for TZ. */
2104 char *t
= (char *) (to
+ envptrs
);
2106 strcat (t
, tzstring
);
2110 /* Copy the old environ vector elements into NEWENV,
2111 but don't copy the TZ variable.
2112 So we have only one definition of TZ, which came from TZSTRING. */
2113 for (from
= environ
; *from
; from
++)
2114 if (strncmp (*from
, "TZ=", 3) != 0)
2120 /* If we do have a TZSTRING, NEWENV points to the vector slot where
2121 the TZ variable is stored. If we do not have a TZSTRING,
2122 TO points to the vector slot which has the terminating null. */
2124 #ifdef LOCALTIME_CACHE
2126 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like
2127 "US/Pacific" that loads a tz file, then changes to a value like
2128 "XXX0" that does not load a tz file, and then changes back to
2129 its original value, the last change is (incorrectly) ignored.
2130 Also, if TZ changes twice in succession to values that do
2131 not load a tz file, tzset can dump core (see Sun bug#1225179).
2132 The following code works around these bugs. */
2136 /* Temporarily set TZ to a value that loads a tz file
2137 and that differs from tzstring. */
2139 *newenv
= (strcmp (tzstring
, set_time_zone_rule_tz1
+ 3) == 0
2140 ? set_time_zone_rule_tz2
: set_time_zone_rule_tz1
);
2146 /* The implied tzstring is unknown, so temporarily set TZ to
2147 two different values that each load a tz file. */
2148 *to
= set_time_zone_rule_tz1
;
2151 *to
= set_time_zone_rule_tz2
;
2156 /* Now TZ has the desired value, and tzset can be invoked safely. */
2163 /* Insert NARGS Lisp objects in the array ARGS by calling INSERT_FUNC
2164 (if a type of object is Lisp_Int) or INSERT_FROM_STRING_FUNC (if a
2165 type of object is Lisp_String). INHERIT is passed to
2166 INSERT_FROM_STRING_FUNC as the last argument. */
2169 general_insert_function (void (*insert_func
)
2170 (const unsigned char *, EMACS_INT
),
2171 void (*insert_from_string_func
)
2172 (Lisp_Object
, EMACS_INT
, EMACS_INT
,
2173 EMACS_INT
, EMACS_INT
, int),
2174 int inherit
, int nargs
, Lisp_Object
*args
)
2176 register int argnum
;
2177 register Lisp_Object val
;
2179 for (argnum
= 0; argnum
< nargs
; argnum
++)
2182 if (CHARACTERP (val
))
2184 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
2187 if (!NILP (current_buffer
->enable_multibyte_characters
))
2188 len
= CHAR_STRING (XFASTINT (val
), str
);
2191 str
[0] = (ASCII_CHAR_P (XINT (val
))
2193 : multibyte_char_to_unibyte (XINT (val
), Qnil
));
2196 (*insert_func
) (str
, len
);
2198 else if (STRINGP (val
))
2200 (*insert_from_string_func
) (val
, 0, 0,
2206 wrong_type_argument (Qchar_or_string_p
, val
);
2218 /* Callers passing one argument to Finsert need not gcpro the
2219 argument "array", since the only element of the array will
2220 not be used after calling insert or insert_from_string, so
2221 we don't care if it gets trashed. */
2223 DEFUN ("insert", Finsert
, Sinsert
, 0, MANY
, 0,
2224 doc
: /* Insert the arguments, either strings or characters, at point.
2225 Point and before-insertion markers move forward to end up
2226 after the inserted text.
2227 Any other markers at the point of insertion remain before the text.
2229 If the current buffer is multibyte, unibyte strings are converted
2230 to multibyte for insertion (see `string-make-multibyte').
2231 If the current buffer is unibyte, multibyte strings are converted
2232 to unibyte for insertion (see `string-make-unibyte').
2234 When operating on binary data, it may be necessary to preserve the
2235 original bytes of a unibyte string when inserting it into a multibyte
2236 buffer; to accomplish this, apply `string-as-multibyte' to the string
2237 and insert the result.
2239 usage: (insert &rest ARGS) */)
2242 register Lisp_Object
*args
;
2244 general_insert_function (insert
, insert_from_string
, 0, nargs
, args
);
2248 DEFUN ("insert-and-inherit", Finsert_and_inherit
, Sinsert_and_inherit
,
2250 doc
: /* Insert the arguments at point, inheriting properties from adjoining text.
2251 Point and before-insertion markers move forward to end up
2252 after the inserted text.
2253 Any other markers at the point of insertion remain before the text.
2255 If the current buffer is multibyte, unibyte strings are converted
2256 to multibyte for insertion (see `unibyte-char-to-multibyte').
2257 If the current buffer is unibyte, multibyte strings are converted
2258 to unibyte for insertion.
2260 usage: (insert-and-inherit &rest ARGS) */)
2263 register Lisp_Object
*args
;
2265 general_insert_function (insert_and_inherit
, insert_from_string
, 1,
2270 DEFUN ("insert-before-markers", Finsert_before_markers
, Sinsert_before_markers
, 0, MANY
, 0,
2271 doc
: /* Insert strings or characters at point, relocating markers after the text.
2272 Point and markers move forward to end up after the inserted text.
2274 If the current buffer is multibyte, unibyte strings are converted
2275 to multibyte for insertion (see `unibyte-char-to-multibyte').
2276 If the current buffer is unibyte, multibyte strings are converted
2277 to unibyte for insertion.
2279 usage: (insert-before-markers &rest ARGS) */)
2282 register Lisp_Object
*args
;
2284 general_insert_function (insert_before_markers
,
2285 insert_from_string_before_markers
, 0,
2290 DEFUN ("insert-before-markers-and-inherit", Finsert_and_inherit_before_markers
,
2291 Sinsert_and_inherit_before_markers
, 0, MANY
, 0,
2292 doc
: /* Insert text at point, relocating markers and inheriting properties.
2293 Point and markers move forward to end up after the inserted text.
2295 If the current buffer is multibyte, unibyte strings are converted
2296 to multibyte for insertion (see `unibyte-char-to-multibyte').
2297 If the current buffer is unibyte, multibyte strings are converted
2298 to unibyte for insertion.
2300 usage: (insert-before-markers-and-inherit &rest ARGS) */)
2303 register Lisp_Object
*args
;
2305 general_insert_function (insert_before_markers_and_inherit
,
2306 insert_from_string_before_markers
, 1,
2311 DEFUN ("insert-char", Finsert_char
, Sinsert_char
, 2, 3, 0,
2312 doc
: /* Insert COUNT copies of CHARACTER.
2313 Point, and before-insertion markers, are relocated as in the function `insert'.
2314 The optional third arg INHERIT, if non-nil, says to inherit text properties
2315 from adjoining text, if those properties are sticky. */)
2316 (character
, count
, inherit
)
2317 Lisp_Object character
, count
, inherit
;
2319 register unsigned char *string
;
2320 register int strlen
;
2323 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
2325 CHECK_NUMBER (character
);
2326 CHECK_NUMBER (count
);
2328 if (!NILP (current_buffer
->enable_multibyte_characters
))
2329 len
= CHAR_STRING (XFASTINT (character
), str
);
2331 str
[0] = XFASTINT (character
), len
= 1;
2332 n
= XINT (count
) * len
;
2335 strlen
= min (n
, 256 * len
);
2336 string
= (unsigned char *) alloca (strlen
);
2337 for (i
= 0; i
< strlen
; i
++)
2338 string
[i
] = str
[i
% len
];
2342 if (!NILP (inherit
))
2343 insert_and_inherit (string
, strlen
);
2345 insert (string
, strlen
);
2350 if (!NILP (inherit
))
2351 insert_and_inherit (string
, n
);
2358 DEFUN ("insert-byte", Finsert_byte
, Sinsert_byte
, 2, 3, 0,
2359 doc
: /* Insert COUNT (second arg) copies of BYTE (first arg).
2360 Both arguments are required.
2361 BYTE is a number of the range 0..255.
2363 If BYTE is 128..255 and the current buffer is multibyte, the
2364 corresponding eight-bit character is inserted.
2366 Point, and before-insertion markers, are relocated as in the function `insert'.
2367 The optional third arg INHERIT, if non-nil, says to inherit text properties
2368 from adjoining text, if those properties are sticky. */)
2369 (byte
, count
, inherit
)
2370 Lisp_Object byte
, count
, inherit
;
2372 CHECK_NUMBER (byte
);
2373 if (XINT (byte
) < 0 || XINT (byte
) > 255)
2374 args_out_of_range_3 (byte
, make_number (0), make_number (255));
2375 if (XINT (byte
) >= 128
2376 && ! NILP (current_buffer
->enable_multibyte_characters
))
2377 XSETFASTINT (byte
, BYTE8_TO_CHAR (XINT (byte
)));
2378 return Finsert_char (byte
, count
, inherit
);
2382 /* Making strings from buffer contents. */
2384 /* Return a Lisp_String containing the text of the current buffer from
2385 START to END. If text properties are in use and the current buffer
2386 has properties in the range specified, the resulting string will also
2387 have them, if PROPS is nonzero.
2389 We don't want to use plain old make_string here, because it calls
2390 make_uninit_string, which can cause the buffer arena to be
2391 compacted. make_string has no way of knowing that the data has
2392 been moved, and thus copies the wrong data into the string. This
2393 doesn't effect most of the other users of make_string, so it should
2394 be left as is. But we should use this function when conjuring
2395 buffer substrings. */
2398 make_buffer_string (start
, end
, props
)
2402 int start_byte
= CHAR_TO_BYTE (start
);
2403 int end_byte
= CHAR_TO_BYTE (end
);
2405 return make_buffer_string_both (start
, start_byte
, end
, end_byte
, props
);
2408 /* Return a Lisp_String containing the text of the current buffer from
2409 START / START_BYTE to END / END_BYTE.
2411 If text properties are in use and the current buffer
2412 has properties in the range specified, the resulting string will also
2413 have them, if PROPS is nonzero.
2415 We don't want to use plain old make_string here, because it calls
2416 make_uninit_string, which can cause the buffer arena to be
2417 compacted. make_string has no way of knowing that the data has
2418 been moved, and thus copies the wrong data into the string. This
2419 doesn't effect most of the other users of make_string, so it should
2420 be left as is. But we should use this function when conjuring
2421 buffer substrings. */
2424 make_buffer_string_both (start
, start_byte
, end
, end_byte
, props
)
2425 int start
, start_byte
, end
, end_byte
;
2428 Lisp_Object result
, tem
, tem1
;
2430 if (start
< GPT
&& GPT
< end
)
2433 if (! NILP (current_buffer
->enable_multibyte_characters
))
2434 result
= make_uninit_multibyte_string (end
- start
, end_byte
- start_byte
);
2436 result
= make_uninit_string (end
- start
);
2437 bcopy (BYTE_POS_ADDR (start_byte
), SDATA (result
),
2438 end_byte
- start_byte
);
2440 /* If desired, update and copy the text properties. */
2443 update_buffer_properties (start
, end
);
2445 tem
= Fnext_property_change (make_number (start
), Qnil
, make_number (end
));
2446 tem1
= Ftext_properties_at (make_number (start
), Qnil
);
2448 if (XINT (tem
) != end
|| !NILP (tem1
))
2449 copy_intervals_to_string (result
, current_buffer
, start
,
2456 /* Call Vbuffer_access_fontify_functions for the range START ... END
2457 in the current buffer, if necessary. */
2460 update_buffer_properties (start
, end
)
2463 /* If this buffer has some access functions,
2464 call them, specifying the range of the buffer being accessed. */
2465 if (!NILP (Vbuffer_access_fontify_functions
))
2467 Lisp_Object args
[3];
2470 args
[0] = Qbuffer_access_fontify_functions
;
2471 XSETINT (args
[1], start
);
2472 XSETINT (args
[2], end
);
2474 /* But don't call them if we can tell that the work
2475 has already been done. */
2476 if (!NILP (Vbuffer_access_fontified_property
))
2478 tem
= Ftext_property_any (args
[1], args
[2],
2479 Vbuffer_access_fontified_property
,
2482 Frun_hook_with_args (3, args
);
2485 Frun_hook_with_args (3, args
);
2489 DEFUN ("buffer-substring", Fbuffer_substring
, Sbuffer_substring
, 2, 2, 0,
2490 doc
: /* Return the contents of part of the current buffer as a string.
2491 The two arguments START and END are character positions;
2492 they can be in either order.
2493 The string returned is multibyte if the buffer is multibyte.
2495 This function copies the text properties of that part of the buffer
2496 into the result string; if you don't want the text properties,
2497 use `buffer-substring-no-properties' instead. */)
2499 Lisp_Object start
, end
;
2503 validate_region (&start
, &end
);
2507 return make_buffer_string (b
, e
, 1);
2510 DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties
,
2511 Sbuffer_substring_no_properties
, 2, 2, 0,
2512 doc
: /* Return the characters of part of the buffer, without the text properties.
2513 The two arguments START and END are character positions;
2514 they can be in either order. */)
2516 Lisp_Object start
, end
;
2520 validate_region (&start
, &end
);
2524 return make_buffer_string (b
, e
, 0);
2527 DEFUN ("buffer-string", Fbuffer_string
, Sbuffer_string
, 0, 0, 0,
2528 doc
: /* Return the contents of the current buffer as a string.
2529 If narrowing is in effect, this function returns only the visible part
2533 return make_buffer_string (BEGV
, ZV
, 1);
2536 DEFUN ("insert-buffer-substring", Finsert_buffer_substring
, Sinsert_buffer_substring
,
2538 doc
: /* Insert before point a substring of the contents of BUFFER.
2539 BUFFER may be a buffer or a buffer name.
2540 Arguments START and END are character positions specifying the substring.
2541 They default to the values of (point-min) and (point-max) in BUFFER. */)
2542 (buffer
, start
, end
)
2543 Lisp_Object buffer
, start
, end
;
2545 register int b
, e
, temp
;
2546 register struct buffer
*bp
, *obuf
;
2549 buf
= Fget_buffer (buffer
);
2553 if (NILP (bp
->name
))
2554 error ("Selecting deleted buffer");
2560 CHECK_NUMBER_COERCE_MARKER (start
);
2567 CHECK_NUMBER_COERCE_MARKER (end
);
2572 temp
= b
, b
= e
, e
= temp
;
2574 if (!(BUF_BEGV (bp
) <= b
&& e
<= BUF_ZV (bp
)))
2575 args_out_of_range (start
, end
);
2577 obuf
= current_buffer
;
2578 set_buffer_internal_1 (bp
);
2579 update_buffer_properties (b
, e
);
2580 set_buffer_internal_1 (obuf
);
2582 insert_from_buffer (bp
, b
, e
- b
, 0);
2586 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings
, Scompare_buffer_substrings
,
2588 doc
: /* Compare two substrings of two buffers; return result as number.
2589 the value is -N if first string is less after N-1 chars,
2590 +N if first string is greater after N-1 chars, or 0 if strings match.
2591 Each substring is represented as three arguments: BUFFER, START and END.
2592 That makes six args in all, three for each substring.
2594 The value of `case-fold-search' in the current buffer
2595 determines whether case is significant or ignored. */)
2596 (buffer1
, start1
, end1
, buffer2
, start2
, end2
)
2597 Lisp_Object buffer1
, start1
, end1
, buffer2
, start2
, end2
;
2599 register int begp1
, endp1
, begp2
, endp2
, temp
;
2600 register struct buffer
*bp1
, *bp2
;
2601 register Lisp_Object trt
2602 = (!NILP (current_buffer
->case_fold_search
)
2603 ? current_buffer
->case_canon_table
: Qnil
);
2605 int i1
, i2
, i1_byte
, i2_byte
;
2607 /* Find the first buffer and its substring. */
2610 bp1
= current_buffer
;
2614 buf1
= Fget_buffer (buffer1
);
2617 bp1
= XBUFFER (buf1
);
2618 if (NILP (bp1
->name
))
2619 error ("Selecting deleted buffer");
2623 begp1
= BUF_BEGV (bp1
);
2626 CHECK_NUMBER_COERCE_MARKER (start1
);
2627 begp1
= XINT (start1
);
2630 endp1
= BUF_ZV (bp1
);
2633 CHECK_NUMBER_COERCE_MARKER (end1
);
2634 endp1
= XINT (end1
);
2638 temp
= begp1
, begp1
= endp1
, endp1
= temp
;
2640 if (!(BUF_BEGV (bp1
) <= begp1
2642 && endp1
<= BUF_ZV (bp1
)))
2643 args_out_of_range (start1
, end1
);
2645 /* Likewise for second substring. */
2648 bp2
= current_buffer
;
2652 buf2
= Fget_buffer (buffer2
);
2655 bp2
= XBUFFER (buf2
);
2656 if (NILP (bp2
->name
))
2657 error ("Selecting deleted buffer");
2661 begp2
= BUF_BEGV (bp2
);
2664 CHECK_NUMBER_COERCE_MARKER (start2
);
2665 begp2
= XINT (start2
);
2668 endp2
= BUF_ZV (bp2
);
2671 CHECK_NUMBER_COERCE_MARKER (end2
);
2672 endp2
= XINT (end2
);
2676 temp
= begp2
, begp2
= endp2
, endp2
= temp
;
2678 if (!(BUF_BEGV (bp2
) <= begp2
2680 && endp2
<= BUF_ZV (bp2
)))
2681 args_out_of_range (start2
, end2
);
2685 i1_byte
= buf_charpos_to_bytepos (bp1
, i1
);
2686 i2_byte
= buf_charpos_to_bytepos (bp2
, i2
);
2688 while (i1
< endp1
&& i2
< endp2
)
2690 /* When we find a mismatch, we must compare the
2691 characters, not just the bytes. */
2696 if (! NILP (bp1
->enable_multibyte_characters
))
2698 c1
= BUF_FETCH_MULTIBYTE_CHAR (bp1
, i1_byte
);
2699 BUF_INC_POS (bp1
, i1_byte
);
2704 c1
= BUF_FETCH_BYTE (bp1
, i1
);
2705 MAKE_CHAR_MULTIBYTE (c1
);
2709 if (! NILP (bp2
->enable_multibyte_characters
))
2711 c2
= BUF_FETCH_MULTIBYTE_CHAR (bp2
, i2_byte
);
2712 BUF_INC_POS (bp2
, i2_byte
);
2717 c2
= BUF_FETCH_BYTE (bp2
, i2
);
2718 MAKE_CHAR_MULTIBYTE (c2
);
2724 c1
= CHAR_TABLE_TRANSLATE (trt
, c1
);
2725 c2
= CHAR_TABLE_TRANSLATE (trt
, c2
);
2728 return make_number (- 1 - chars
);
2730 return make_number (chars
+ 1);
2735 /* The strings match as far as they go.
2736 If one is shorter, that one is less. */
2737 if (chars
< endp1
- begp1
)
2738 return make_number (chars
+ 1);
2739 else if (chars
< endp2
- begp2
)
2740 return make_number (- chars
- 1);
2742 /* Same length too => they are equal. */
2743 return make_number (0);
2747 subst_char_in_region_unwind (arg
)
2750 return current_buffer
->undo_list
= arg
;
2754 subst_char_in_region_unwind_1 (arg
)
2757 return current_buffer
->filename
= arg
;
2760 DEFUN ("subst-char-in-region", Fsubst_char_in_region
,
2761 Ssubst_char_in_region
, 4, 5, 0,
2762 doc
: /* From START to END, replace FROMCHAR with TOCHAR each time it occurs.
2763 If optional arg NOUNDO is non-nil, don't record this change for undo
2764 and don't mark the buffer as really changed.
2765 Both characters must have the same length of multi-byte form. */)
2766 (start
, end
, fromchar
, tochar
, noundo
)
2767 Lisp_Object start
, end
, fromchar
, tochar
, noundo
;
2769 register int pos
, pos_byte
, stop
, i
, len
, end_byte
;
2770 /* Keep track of the first change in the buffer:
2771 if 0 we haven't found it yet.
2772 if < 0 we've found it and we've run the before-change-function.
2773 if > 0 we've actually performed it and the value is its position. */
2775 unsigned char fromstr
[MAX_MULTIBYTE_LENGTH
], tostr
[MAX_MULTIBYTE_LENGTH
];
2777 int count
= SPECPDL_INDEX ();
2778 #define COMBINING_NO 0
2779 #define COMBINING_BEFORE 1
2780 #define COMBINING_AFTER 2
2781 #define COMBINING_BOTH (COMBINING_BEFORE | COMBINING_AFTER)
2782 int maybe_byte_combining
= COMBINING_NO
;
2783 int last_changed
= 0;
2784 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
2788 validate_region (&start
, &end
);
2789 CHECK_NUMBER (fromchar
);
2790 CHECK_NUMBER (tochar
);
2794 len
= CHAR_STRING (XFASTINT (fromchar
), fromstr
);
2795 if (CHAR_STRING (XFASTINT (tochar
), tostr
) != len
)
2796 error ("Characters in `subst-char-in-region' have different byte-lengths");
2797 if (!ASCII_BYTE_P (*tostr
))
2799 /* If *TOSTR is in the range 0x80..0x9F and TOCHAR is not a
2800 complete multibyte character, it may be combined with the
2801 after bytes. If it is in the range 0xA0..0xFF, it may be
2802 combined with the before and after bytes. */
2803 if (!CHAR_HEAD_P (*tostr
))
2804 maybe_byte_combining
= COMBINING_BOTH
;
2805 else if (BYTES_BY_CHAR_HEAD (*tostr
) > len
)
2806 maybe_byte_combining
= COMBINING_AFTER
;
2812 fromstr
[0] = XFASTINT (fromchar
);
2813 tostr
[0] = XFASTINT (tochar
);
2817 pos_byte
= CHAR_TO_BYTE (pos
);
2818 stop
= CHAR_TO_BYTE (XINT (end
));
2821 /* If we don't want undo, turn off putting stuff on the list.
2822 That's faster than getting rid of things,
2823 and it prevents even the entry for a first change.
2824 Also inhibit locking the file. */
2825 if (!changed
&& !NILP (noundo
))
2827 record_unwind_protect (subst_char_in_region_unwind
,
2828 current_buffer
->undo_list
);
2829 current_buffer
->undo_list
= Qt
;
2830 /* Don't do file-locking. */
2831 record_unwind_protect (subst_char_in_region_unwind_1
,
2832 current_buffer
->filename
);
2833 current_buffer
->filename
= Qnil
;
2836 if (pos_byte
< GPT_BYTE
)
2837 stop
= min (stop
, GPT_BYTE
);
2840 int pos_byte_next
= pos_byte
;
2842 if (pos_byte
>= stop
)
2844 if (pos_byte
>= end_byte
) break;
2847 p
= BYTE_POS_ADDR (pos_byte
);
2849 INC_POS (pos_byte_next
);
2852 if (pos_byte_next
- pos_byte
== len
2853 && p
[0] == fromstr
[0]
2855 || (p
[1] == fromstr
[1]
2856 && (len
== 2 || (p
[2] == fromstr
[2]
2857 && (len
== 3 || p
[3] == fromstr
[3]))))))
2860 /* We've already seen this and run the before-change-function;
2861 this time we only need to record the actual position. */
2866 modify_region (current_buffer
, pos
, XINT (end
), 0);
2868 if (! NILP (noundo
))
2870 if (MODIFF
- 1 == SAVE_MODIFF
)
2872 if (MODIFF
- 1 == BUF_AUTOSAVE_MODIFF (current_buffer
))
2873 BUF_AUTOSAVE_MODIFF (current_buffer
)++;
2876 /* The before-change-function may have moved the gap
2877 or even modified the buffer so we should start over. */
2881 /* Take care of the case where the new character
2882 combines with neighboring bytes. */
2883 if (maybe_byte_combining
2884 && (maybe_byte_combining
== COMBINING_AFTER
2885 ? (pos_byte_next
< Z_BYTE
2886 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next
)))
2887 : ((pos_byte_next
< Z_BYTE
2888 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next
)))
2889 || (pos_byte
> BEG_BYTE
2890 && ! ASCII_BYTE_P (FETCH_BYTE (pos_byte
- 1))))))
2892 Lisp_Object tem
, string
;
2894 struct gcpro gcpro1
;
2896 tem
= current_buffer
->undo_list
;
2899 /* Make a multibyte string containing this single character. */
2900 string
= make_multibyte_string (tostr
, 1, len
);
2901 /* replace_range is less efficient, because it moves the gap,
2902 but it handles combining correctly. */
2903 replace_range (pos
, pos
+ 1, string
,
2905 pos_byte_next
= CHAR_TO_BYTE (pos
);
2906 if (pos_byte_next
> pos_byte
)
2907 /* Before combining happened. We should not increment
2908 POS. So, to cancel the later increment of POS,
2912 INC_POS (pos_byte_next
);
2914 if (! NILP (noundo
))
2915 current_buffer
->undo_list
= tem
;
2922 record_change (pos
, 1);
2923 for (i
= 0; i
< len
; i
++) *p
++ = tostr
[i
];
2925 last_changed
= pos
+ 1;
2927 pos_byte
= pos_byte_next
;
2933 signal_after_change (changed
,
2934 last_changed
- changed
, last_changed
- changed
);
2935 update_compositions (changed
, last_changed
, CHECK_ALL
);
2938 unbind_to (count
, Qnil
);
2943 static Lisp_Object check_translation
P_ ((int, int, int, Lisp_Object
));
2945 /* Helper function for Ftranslate_region_internal.
2947 Check if a character sequence at POS (POS_BYTE) matches an element
2948 of VAL. VAL is a list (([FROM-CHAR ...] . TO) ...). If a matching
2949 element is found, return it. Otherwise return Qnil. */
2952 check_translation (pos
, pos_byte
, end
, val
)
2953 int pos
, pos_byte
, end
;
2956 int buf_size
= 16, buf_used
= 0;
2957 int *buf
= alloca (sizeof (int) * buf_size
);
2959 for (; CONSP (val
); val
= XCDR (val
))
2968 if (! VECTORP (elt
))
2971 if (len
<= end
- pos
)
2973 for (i
= 0; i
< len
; i
++)
2977 unsigned char *p
= BYTE_POS_ADDR (pos_byte
);
2980 if (buf_used
== buf_size
)
2985 newbuf
= alloca (sizeof (int) * buf_size
);
2986 memcpy (newbuf
, buf
, sizeof (int) * buf_used
);
2989 buf
[buf_used
++] = STRING_CHAR_AND_LENGTH (p
, len
);
2992 if (XINT (AREF (elt
, i
)) != buf
[i
])
3003 DEFUN ("translate-region-internal", Ftranslate_region_internal
,
3004 Stranslate_region_internal
, 3, 3, 0,
3005 doc
: /* Internal use only.
3006 From START to END, translate characters according to TABLE.
3007 TABLE is a string or a char-table; the Nth character in it is the
3008 mapping for the character with code N.
3009 It returns the number of characters changed. */)
3013 register Lisp_Object table
;
3015 register unsigned char *tt
; /* Trans table. */
3016 register int nc
; /* New character. */
3017 int cnt
; /* Number of changes made. */
3018 int size
; /* Size of translate table. */
3019 int pos
, pos_byte
, end_pos
;
3020 int multibyte
= !NILP (current_buffer
->enable_multibyte_characters
);
3021 int string_multibyte
;
3024 validate_region (&start
, &end
);
3025 if (CHAR_TABLE_P (table
))
3027 if (! EQ (XCHAR_TABLE (table
)->purpose
, Qtranslation_table
))
3028 error ("Not a translation table");
3034 CHECK_STRING (table
);
3036 if (! multibyte
&& (SCHARS (table
) < SBYTES (table
)))
3037 table
= string_make_unibyte (table
);
3038 string_multibyte
= SCHARS (table
) < SBYTES (table
);
3039 size
= SBYTES (table
);
3044 pos_byte
= CHAR_TO_BYTE (pos
);
3045 end_pos
= XINT (end
);
3046 modify_region (current_buffer
, pos
, end_pos
, 0);
3049 for (; pos
< end_pos
; )
3051 register unsigned char *p
= BYTE_POS_ADDR (pos_byte
);
3052 unsigned char *str
, buf
[MAX_MULTIBYTE_LENGTH
];
3058 oc
= STRING_CHAR_AND_LENGTH (p
, len
);
3065 /* Reload as signal_after_change in last iteration may GC. */
3067 if (string_multibyte
)
3069 str
= tt
+ string_char_to_byte (table
, oc
);
3070 nc
= STRING_CHAR_AND_LENGTH (str
, str_len
);
3075 if (! ASCII_BYTE_P (nc
) && multibyte
)
3077 str_len
= BYTE8_STRING (nc
, buf
);
3092 val
= CHAR_TABLE_REF (table
, oc
);
3093 if (CHARACTERP (val
)
3094 && (c
= XINT (val
), CHAR_VALID_P (c
, 0)))
3097 str_len
= CHAR_STRING (nc
, buf
);
3100 else if (VECTORP (val
) || (CONSP (val
)))
3102 /* VAL is [TO_CHAR ...] or (([FROM-CHAR ...] . TO) ...)
3103 where TO is TO-CHAR or [TO-CHAR ...]. */
3108 if (nc
!= oc
&& nc
>= 0)
3110 /* Simple one char to one char translation. */
3115 /* This is less efficient, because it moves the gap,
3116 but it should handle multibyte characters correctly. */
3117 string
= make_multibyte_string (str
, 1, str_len
);
3118 replace_range (pos
, pos
+ 1, string
, 1, 0, 1);
3123 record_change (pos
, 1);
3124 while (str_len
-- > 0)
3126 signal_after_change (pos
, 1, 1);
3127 update_compositions (pos
, pos
+ 1, CHECK_BORDER
);
3137 val
= check_translation (pos
, pos_byte
, end_pos
, val
);
3144 /* VAL is ([FROM-CHAR ...] . TO). */
3145 len
= ASIZE (XCAR (val
));
3153 string
= Fconcat (1, &val
);
3157 string
= Fmake_string (make_number (1), val
);
3159 replace_range (pos
, pos
+ len
, string
, 1, 0, 1);
3160 pos_byte
+= SBYTES (string
);
3161 pos
+= SCHARS (string
);
3162 cnt
+= SCHARS (string
);
3163 end_pos
+= SCHARS (string
) - len
;
3171 return make_number (cnt
);
3174 DEFUN ("delete-region", Fdelete_region
, Sdelete_region
, 2, 2, "r",
3175 doc
: /* Delete the text between point and mark.
3177 When called from a program, expects two arguments,
3178 positions (integers or markers) specifying the stretch to be deleted. */)
3180 Lisp_Object start
, end
;
3182 validate_region (&start
, &end
);
3183 del_range (XINT (start
), XINT (end
));
3187 DEFUN ("delete-and-extract-region", Fdelete_and_extract_region
,
3188 Sdelete_and_extract_region
, 2, 2, 0,
3189 doc
: /* Delete the text between START and END and return it. */)
3191 Lisp_Object start
, end
;
3193 validate_region (&start
, &end
);
3194 if (XINT (start
) == XINT (end
))
3195 return empty_unibyte_string
;
3196 return del_range_1 (XINT (start
), XINT (end
), 1, 1);
3199 DEFUN ("widen", Fwiden
, Swiden
, 0, 0, "",
3200 doc
: /* Remove restrictions (narrowing) from current buffer.
3201 This allows the buffer's full text to be seen and edited. */)
3204 if (BEG
!= BEGV
|| Z
!= ZV
)
3205 current_buffer
->clip_changed
= 1;
3207 BEGV_BYTE
= BEG_BYTE
;
3208 SET_BUF_ZV_BOTH (current_buffer
, Z
, Z_BYTE
);
3209 /* Changing the buffer bounds invalidates any recorded current column. */
3210 invalidate_current_column ();
3214 DEFUN ("narrow-to-region", Fnarrow_to_region
, Snarrow_to_region
, 2, 2, "r",
3215 doc
: /* Restrict editing in this buffer to the current region.
3216 The rest of the text becomes temporarily invisible and untouchable
3217 but is not deleted; if you save the buffer in a file, the invisible
3218 text is included in the file. \\[widen] makes all visible again.
3219 See also `save-restriction'.
3221 When calling from a program, pass two arguments; positions (integers
3222 or markers) bounding the text that should remain visible. */)
3224 register Lisp_Object start
, end
;
3226 CHECK_NUMBER_COERCE_MARKER (start
);
3227 CHECK_NUMBER_COERCE_MARKER (end
);
3229 if (XINT (start
) > XINT (end
))
3232 tem
= start
; start
= end
; end
= tem
;
3235 if (!(BEG
<= XINT (start
) && XINT (start
) <= XINT (end
) && XINT (end
) <= Z
))
3236 args_out_of_range (start
, end
);
3238 if (BEGV
!= XFASTINT (start
) || ZV
!= XFASTINT (end
))
3239 current_buffer
->clip_changed
= 1;
3241 SET_BUF_BEGV (current_buffer
, XFASTINT (start
));
3242 SET_BUF_ZV (current_buffer
, XFASTINT (end
));
3243 if (PT
< XFASTINT (start
))
3244 SET_PT (XFASTINT (start
));
3245 if (PT
> XFASTINT (end
))
3246 SET_PT (XFASTINT (end
));
3247 /* Changing the buffer bounds invalidates any recorded current column. */
3248 invalidate_current_column ();
3253 save_restriction_save ()
3255 if (BEGV
== BEG
&& ZV
== Z
)
3256 /* The common case that the buffer isn't narrowed.
3257 We return just the buffer object, which save_restriction_restore
3258 recognizes as meaning `no restriction'. */
3259 return Fcurrent_buffer ();
3261 /* We have to save a restriction, so return a pair of markers, one
3262 for the beginning and one for the end. */
3264 Lisp_Object beg
, end
;
3266 beg
= buildmark (BEGV
, BEGV_BYTE
);
3267 end
= buildmark (ZV
, ZV_BYTE
);
3269 /* END must move forward if text is inserted at its exact location. */
3270 XMARKER(end
)->insertion_type
= 1;
3272 return Fcons (beg
, end
);
3277 save_restriction_restore (data
)
3280 struct buffer
*cur
= NULL
;
3281 struct buffer
*buf
= (CONSP (data
)
3282 ? XMARKER (XCAR (data
))->buffer
3285 if (buf
&& buf
!= current_buffer
&& !NILP (buf
->pt_marker
))
3286 { /* If `buf' uses markers to keep track of PT, BEGV, and ZV (as
3287 is the case if it is or has an indirect buffer), then make
3288 sure it is current before we update BEGV, so
3289 set_buffer_internal takes care of managing those markers. */
3290 cur
= current_buffer
;
3291 set_buffer_internal (buf
);
3295 /* A pair of marks bounding a saved restriction. */
3297 struct Lisp_Marker
*beg
= XMARKER (XCAR (data
));
3298 struct Lisp_Marker
*end
= XMARKER (XCDR (data
));
3299 eassert (buf
== end
->buffer
);
3301 if (buf
/* Verify marker still points to a buffer. */
3302 && (beg
->charpos
!= BUF_BEGV (buf
) || end
->charpos
!= BUF_ZV (buf
)))
3303 /* The restriction has changed from the saved one, so restore
3304 the saved restriction. */
3306 int pt
= BUF_PT (buf
);
3308 SET_BUF_BEGV_BOTH (buf
, beg
->charpos
, beg
->bytepos
);
3309 SET_BUF_ZV_BOTH (buf
, end
->charpos
, end
->bytepos
);
3311 if (pt
< beg
->charpos
|| pt
> end
->charpos
)
3312 /* The point is outside the new visible range, move it inside. */
3313 SET_BUF_PT_BOTH (buf
,
3314 clip_to_bounds (beg
->charpos
, pt
, end
->charpos
),
3315 clip_to_bounds (beg
->bytepos
, BUF_PT_BYTE (buf
),
3318 buf
->clip_changed
= 1; /* Remember that the narrowing changed. */
3322 /* A buffer, which means that there was no old restriction. */
3324 if (buf
/* Verify marker still points to a buffer. */
3325 && (BUF_BEGV (buf
) != BUF_BEG (buf
) || BUF_ZV (buf
) != BUF_Z (buf
)))
3326 /* The buffer has been narrowed, get rid of the narrowing. */
3328 SET_BUF_BEGV_BOTH (buf
, BUF_BEG (buf
), BUF_BEG_BYTE (buf
));
3329 SET_BUF_ZV_BOTH (buf
, BUF_Z (buf
), BUF_Z_BYTE (buf
));
3331 buf
->clip_changed
= 1; /* Remember that the narrowing changed. */
3336 set_buffer_internal (cur
);
3341 DEFUN ("save-restriction", Fsave_restriction
, Ssave_restriction
, 0, UNEVALLED
, 0,
3342 doc
: /* Execute BODY, saving and restoring current buffer's restrictions.
3343 The buffer's restrictions make parts of the beginning and end invisible.
3344 \(They are set up with `narrow-to-region' and eliminated with `widen'.)
3345 This special form, `save-restriction', saves the current buffer's restrictions
3346 when it is entered, and restores them when it is exited.
3347 So any `narrow-to-region' within BODY lasts only until the end of the form.
3348 The old restrictions settings are restored
3349 even in case of abnormal exit (throw or error).
3351 The value returned is the value of the last form in BODY.
3353 Note: if you are using both `save-excursion' and `save-restriction',
3354 use `save-excursion' outermost:
3355 (save-excursion (save-restriction ...))
3357 usage: (save-restriction &rest BODY) */)
3361 register Lisp_Object val
;
3362 int count
= SPECPDL_INDEX ();
3364 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
3365 val
= Fprogn (body
);
3366 return unbind_to (count
, val
);
3369 /* Buffer for the most recent text displayed by Fmessage_box. */
3370 static char *message_text
;
3372 /* Allocated length of that buffer. */
3373 static int message_length
;
3375 DEFUN ("message", Fmessage
, Smessage
, 1, MANY
, 0,
3376 doc
: /* Display a message at the bottom of the screen.
3377 The message also goes into the `*Messages*' buffer.
3378 \(In keyboard macros, that's all it does.)
3381 The first argument is a format control string, and the rest are data
3382 to be formatted under control of the string. See `format' for details.
3384 Note: Use (message "%s" VALUE) to print the value of expressions and
3385 variables to avoid accidentally interpreting `%' as format specifiers.
3387 If the first argument is nil or the empty string, the function clears
3388 any existing message; this lets the minibuffer contents show. See
3389 also `current-message'.
3391 usage: (message FORMAT-STRING &rest ARGS) */)
3397 || (STRINGP (args
[0])
3398 && SBYTES (args
[0]) == 0))
3405 register Lisp_Object val
;
3406 val
= Fformat (nargs
, args
);
3407 message3 (val
, SBYTES (val
), STRING_MULTIBYTE (val
));
3412 DEFUN ("message-box", Fmessage_box
, Smessage_box
, 1, MANY
, 0,
3413 doc
: /* Display a message, in a dialog box if possible.
3414 If a dialog box is not available, use the echo area.
3415 The first argument is a format control string, and the rest are data
3416 to be formatted under control of the string. See `format' for details.
3418 If the first argument is nil or the empty string, clear any existing
3419 message; let the minibuffer contents show.
3421 usage: (message-box FORMAT-STRING &rest ARGS) */)
3433 register Lisp_Object val
;
3434 val
= Fformat (nargs
, args
);
3436 /* The MS-DOS frames support popup menus even though they are
3437 not FRAME_WINDOW_P. */
3438 if (FRAME_WINDOW_P (XFRAME (selected_frame
))
3439 || FRAME_MSDOS_P (XFRAME (selected_frame
)))
3441 Lisp_Object pane
, menu
, obj
;
3442 struct gcpro gcpro1
;
3443 pane
= Fcons (Fcons (build_string ("OK"), Qt
), Qnil
);
3445 menu
= Fcons (val
, pane
);
3446 obj
= Fx_popup_dialog (Qt
, menu
, Qt
);
3450 #endif /* HAVE_MENUS */
3451 /* Copy the data so that it won't move when we GC. */
3454 message_text
= (char *)xmalloc (80);
3455 message_length
= 80;
3457 if (SBYTES (val
) > message_length
)
3459 message_length
= SBYTES (val
);
3460 message_text
= (char *)xrealloc (message_text
, message_length
);
3462 bcopy (SDATA (val
), message_text
, SBYTES (val
));
3463 message2 (message_text
, SBYTES (val
),
3464 STRING_MULTIBYTE (val
));
3469 extern Lisp_Object impl_last_nonmenu_event
;
3472 DEFUN ("message-or-box", Fmessage_or_box
, Smessage_or_box
, 1, MANY
, 0,
3473 doc
: /* Display a message in a dialog box or in the echo area.
3474 If this command was invoked with the mouse, use a dialog box if
3475 `use-dialog-box' is non-nil.
3476 Otherwise, use the echo area.
3477 The first argument is a format control string, and the rest are data
3478 to be formatted under control of the string. See `format' for details.
3480 If the first argument is nil or the empty string, clear any existing
3481 message; let the minibuffer contents show.
3483 usage: (message-or-box FORMAT-STRING &rest ARGS) */)
3489 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
3491 return Fmessage_box (nargs
, args
);
3493 return Fmessage (nargs
, args
);
3496 DEFUN ("current-message", Fcurrent_message
, Scurrent_message
, 0, 0, 0,
3497 doc
: /* Return the string currently displayed in the echo area, or nil if none. */)
3500 return current_message ();
3504 DEFUN ("propertize", Fpropertize
, Spropertize
, 1, MANY
, 0,
3505 doc
: /* Return a copy of STRING with text properties added.
3506 First argument is the string to copy.
3507 Remaining arguments form a sequence of PROPERTY VALUE pairs for text
3508 properties to add to the result.
3509 usage: (propertize STRING &rest PROPERTIES) */)
3514 Lisp_Object properties
, string
;
3515 struct gcpro gcpro1
, gcpro2
;
3518 /* Number of args must be odd. */
3519 if ((nargs
& 1) == 0 || nargs
< 1)
3520 error ("Wrong number of arguments");
3522 properties
= string
= Qnil
;
3523 GCPRO2 (properties
, string
);
3525 /* First argument must be a string. */
3526 CHECK_STRING (args
[0]);
3527 string
= Fcopy_sequence (args
[0]);
3529 for (i
= 1; i
< nargs
; i
+= 2)
3530 properties
= Fcons (args
[i
], Fcons (args
[i
+ 1], properties
));
3532 Fadd_text_properties (make_number (0),
3533 make_number (SCHARS (string
)),
3534 properties
, string
);
3535 RETURN_UNGCPRO (string
);
3539 /* Number of bytes that STRING will occupy when put into the result.
3540 MULTIBYTE is nonzero if the result should be multibyte. */
3542 #define CONVERTED_BYTE_SIZE(MULTIBYTE, STRING) \
3543 (((MULTIBYTE) && ! STRING_MULTIBYTE (STRING)) \
3544 ? count_size_as_multibyte (SDATA (STRING), SBYTES (STRING)) \
3547 DEFUN ("format", Fformat
, Sformat
, 1, MANY
, 0,
3548 doc
: /* Format a string out of a format-string and arguments.
3549 The first argument is a format control string.
3550 The other arguments are substituted into it to make the result, a string.
3552 The format control string may contain %-sequences meaning to substitute
3553 the next available argument:
3555 %s means print a string argument. Actually, prints any object, with `princ'.
3556 %d means print as number in decimal (%o octal, %x hex).
3557 %X is like %x, but uses upper case.
3558 %e means print a number in exponential notation.
3559 %f means print a number in decimal-point notation.
3560 %g means print a number in exponential notation
3561 or decimal-point notation, whichever uses fewer characters.
3562 %c means print a number as a single character.
3563 %S means print any object as an s-expression (using `prin1').
3565 The argument used for %d, %o, %x, %e, %f, %g or %c must be a number.
3566 Use %% to put a single % into the output.
3568 A %-sequence may contain optional flag, width, and precision
3569 specifiers, as follows:
3571 %<flags><width><precision>character
3573 where flags is [+ #-0]+, width is [0-9]+, and precision is .[0-9]+
3575 The + flag character inserts a + before any positive number, while a
3576 space inserts a space before any positive number; these flags only
3577 affect %d, %e, %f, and %g sequences, and the + flag takes precedence.
3578 The # flag means to use an alternate display form for %o, %x, %X, %e,
3579 %f, and %g sequences. The - and 0 flags affect the width specifier,
3582 The width specifier supplies a lower limit for the length of the
3583 printed representation. The padding, if any, normally goes on the
3584 left, but it goes on the right if the - flag is present. The padding
3585 character is normally a space, but it is 0 if the 0 flag is present.
3586 The - flag takes precedence over the 0 flag.
3588 For %e, %f, and %g sequences, the number after the "." in the
3589 precision specifier says how many decimal places to show; if zero, the
3590 decimal point itself is omitted. For %s and %S, the precision
3591 specifier truncates the string to the given width.
3593 usage: (format STRING &rest OBJECTS) */)
3596 register Lisp_Object
*args
;
3598 register int n
; /* The number of the next arg to substitute */
3599 register int total
; /* An estimate of the final length */
3601 register unsigned char *format
, *end
, *format_start
;
3603 /* Nonzero if the output should be a multibyte string,
3604 which is true if any of the inputs is one. */
3606 /* When we make a multibyte string, we must pay attention to the
3607 byte combining problem, i.e., a byte may be combined with a
3608 multibyte charcter of the previous string. This flag tells if we
3609 must consider such a situation or not. */
3610 int maybe_combine_byte
;
3611 unsigned char *this_format
;
3612 /* Precision for each spec, or -1, a flag value meaning no precision
3613 was given in that spec. Element 0, corresonding to the format
3614 string itself, will not be used. Element NARGS, corresponding to
3615 no argument, *will* be assigned to in the case that a `%' and `.'
3616 occur after the final format specifier. */
3617 int *precision
= (int *) (alloca((nargs
+ 1) * sizeof (int)));
3620 int arg_intervals
= 0;
3623 /* discarded[I] is 1 if byte I of the format
3624 string was not copied into the output.
3625 It is 2 if byte I was not the first byte of its character. */
3626 char *discarded
= 0;
3628 /* Each element records, for one argument,
3629 the start and end bytepos in the output string,
3630 and whether the argument is a string with intervals.
3631 info[0] is unused. Unused elements have -1 for start. */
3634 int start
, end
, intervals
;
3637 /* It should not be necessary to GCPRO ARGS, because
3638 the caller in the interpreter should take care of that. */
3640 /* Try to determine whether the result should be multibyte.
3641 This is not always right; sometimes the result needs to be multibyte
3642 because of an object that we will pass through prin1,
3643 and in that case, we won't know it here. */
3644 for (n
= 0; n
< nargs
; n
++)
3646 if (STRINGP (args
[n
]) && STRING_MULTIBYTE (args
[n
]))
3648 /* Piggyback on this loop to initialize precision[N]. */
3651 precision
[nargs
] = -1;
3653 CHECK_STRING (args
[0]);
3654 /* We may have to change "%S" to "%s". */
3655 args
[0] = Fcopy_sequence (args
[0]);
3657 /* GC should never happen here, so abort if it does. */
3660 /* If we start out planning a unibyte result,
3661 then discover it has to be multibyte, we jump back to retry.
3662 That can only happen from the first large while loop below. */
3665 format
= SDATA (args
[0]);
3666 format_start
= format
;
3667 end
= format
+ SBYTES (args
[0]);
3670 /* Make room in result for all the non-%-codes in the control string. */
3671 total
= 5 + CONVERTED_BYTE_SIZE (multibyte
, args
[0]) + 1;
3673 /* Allocate the info and discarded tables. */
3675 int nbytes
= (nargs
+1) * sizeof *info
;
3678 info
= (struct info
*) alloca (nbytes
);
3679 bzero (info
, nbytes
);
3680 for (i
= 0; i
<= nargs
; i
++)
3683 SAFE_ALLOCA (discarded
, char *, SBYTES (args
[0]));
3684 bzero (discarded
, SBYTES (args
[0]));
3687 /* Add to TOTAL enough space to hold the converted arguments. */
3690 while (format
!= end
)
3691 if (*format
++ == '%')
3694 int actual_width
= 0;
3695 unsigned char *this_format_start
= format
- 1;
3696 int field_width
= 0;
3698 /* General format specifications look like
3700 '%' [flags] [field-width] [precision] format
3705 field-width ::= [0-9]+
3706 precision ::= '.' [0-9]*
3708 If a field-width is specified, it specifies to which width
3709 the output should be padded with blanks, if the output
3710 string is shorter than field-width.
3712 If precision is specified, it specifies the number of
3713 digits to print after the '.' for floats, or the max.
3714 number of chars to print from a string. */
3716 while (format
!= end
3717 && (*format
== '-' || *format
== '0' || *format
== '#'
3718 || * format
== ' ' || *format
== '+'))
3721 if (*format
>= '0' && *format
<= '9')
3723 for (field_width
= 0; *format
>= '0' && *format
<= '9'; ++format
)
3724 field_width
= 10 * field_width
+ *format
- '0';
3727 /* N is not incremented for another few lines below, so refer to
3728 element N+1 (which might be precision[NARGS]). */
3732 for (precision
[n
+1] = 0; *format
>= '0' && *format
<= '9'; ++format
)
3733 precision
[n
+1] = 10 * precision
[n
+1] + *format
- '0';
3736 /* Extra +1 for 'l' that we may need to insert into the
3738 if (format
- this_format_start
+ 2 > longest_format
)
3739 longest_format
= format
- this_format_start
+ 2;
3742 error ("Format string ends in middle of format specifier");
3745 else if (++n
>= nargs
)
3746 error ("Not enough arguments for format string");
3747 else if (*format
== 'S')
3749 /* For `S', prin1 the argument and then treat like a string. */
3750 register Lisp_Object tem
;
3751 tem
= Fprin1_to_string (args
[n
], Qnil
);
3752 if (STRING_MULTIBYTE (tem
) && ! multibyte
)
3758 /* If we restart the loop, we should not come here again
3759 because args[n] is now a string and calling
3760 Fprin1_to_string on it produces superflous double
3761 quotes. So, change "%S" to "%s" now. */
3765 else if (SYMBOLP (args
[n
]))
3767 args
[n
] = SYMBOL_NAME (args
[n
]);
3768 if (STRING_MULTIBYTE (args
[n
]) && ! multibyte
)
3775 else if (STRINGP (args
[n
]))
3778 if (*format
!= 's' && *format
!= 'S')
3779 error ("Format specifier doesn't match argument type");
3780 /* In the case (PRECISION[N] > 0), THISSIZE may not need
3781 to be as large as is calculated here. Easy check for
3782 the case PRECISION = 0. */
3783 thissize
= precision
[n
] ? CONVERTED_BYTE_SIZE (multibyte
, args
[n
]) : 0;
3784 /* The precision also constrains how much of the argument
3785 string will finally appear (Bug#5710). */
3786 actual_width
= lisp_string_width (args
[n
], -1, NULL
, NULL
);
3787 if (precision
[n
] != -1)
3788 actual_width
= min(actual_width
,precision
[n
]);
3790 /* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */
3791 else if (INTEGERP (args
[n
]) && *format
!= 's')
3793 /* The following loop assumes the Lisp type indicates
3794 the proper way to pass the argument.
3795 So make sure we have a flonum if the argument should
3797 if (*format
== 'e' || *format
== 'f' || *format
== 'g')
3798 args
[n
] = Ffloat (args
[n
]);
3800 if (*format
!= 'd' && *format
!= 'o' && *format
!= 'x'
3801 && *format
!= 'i' && *format
!= 'X' && *format
!= 'c')
3802 error ("Invalid format operation %%%c", *format
);
3804 thissize
= 30 + (precision
[n
] > 0 ? precision
[n
] : 0);
3807 if (! ASCII_CHAR_P (XINT (args
[n
]))
3808 /* Note: No one can remeber why we have to treat
3809 the character 0 as a multibyte character here.
3810 But, until it causes a real problem, let's
3812 || XINT (args
[n
]) == 0)
3819 args
[n
] = Fchar_to_string (args
[n
]);
3820 thissize
= SBYTES (args
[n
]);
3822 else if (! ASCII_BYTE_P (XINT (args
[n
])) && multibyte
)
3825 = Fchar_to_string (Funibyte_char_to_multibyte (args
[n
]));
3826 thissize
= SBYTES (args
[n
]);
3830 else if (FLOATP (args
[n
]) && *format
!= 's')
3832 if (! (*format
== 'e' || *format
== 'f' || *format
== 'g'))
3834 if (*format
!= 'd' && *format
!= 'o' && *format
!= 'x'
3835 && *format
!= 'i' && *format
!= 'X' && *format
!= 'c')
3836 error ("Invalid format operation %%%c", *format
);
3837 /* This fails unnecessarily if args[n] is bigger than
3838 most-positive-fixnum but smaller than MAXINT.
3839 These cases are important because we sometimes use floats
3840 to represent such integer values (typically such values
3841 come from UIDs or PIDs). */
3842 /* args[n] = Ftruncate (args[n], Qnil); */
3845 /* Note that we're using sprintf to print floats,
3846 so we have to take into account what that function
3848 /* Filter out flag value of -1. */
3849 thissize
= (MAX_10_EXP
+ 100
3850 + (precision
[n
] > 0 ? precision
[n
] : 0));
3854 /* Anything but a string, convert to a string using princ. */
3855 register Lisp_Object tem
;
3856 tem
= Fprin1_to_string (args
[n
], Qt
);
3857 if (STRING_MULTIBYTE (tem
) && ! multibyte
)
3866 thissize
+= max (0, field_width
- actual_width
);
3867 total
+= thissize
+ 4;
3872 /* Now we can no longer jump to retry.
3873 TOTAL and LONGEST_FORMAT are known for certain. */
3875 this_format
= (unsigned char *) alloca (longest_format
+ 1);
3877 /* Allocate the space for the result.
3878 Note that TOTAL is an overestimate. */
3879 SAFE_ALLOCA (buf
, char *, total
);
3885 /* Scan the format and store result in BUF. */
3886 format
= SDATA (args
[0]);
3887 format_start
= format
;
3888 end
= format
+ SBYTES (args
[0]);
3889 maybe_combine_byte
= 0;
3890 while (format
!= end
)
3896 unsigned char *this_format_start
= format
;
3898 discarded
[format
- format_start
] = 1;
3901 while (index("-+0# ", *format
))
3907 discarded
[format
- format_start
] = 1;
3911 minlen
= atoi (format
);
3913 while ((*format
>= '0' && *format
<= '9') || *format
== '.')
3915 discarded
[format
- format_start
] = 1;
3919 if (*format
++ == '%')
3928 discarded
[format
- format_start
- 1] = 1;
3929 info
[n
].start
= nchars
;
3931 if (STRINGP (args
[n
]))
3933 /* handle case (precision[n] >= 0) */
3936 int nbytes
, start
, end
;
3939 /* lisp_string_width ignores a precision of 0, but GNU
3940 libc functions print 0 characters when the precision
3941 is 0. Imitate libc behavior here. Changing
3942 lisp_string_width is the right thing, and will be
3943 done, but meanwhile we work with it. */
3945 if (precision
[n
] == 0)
3946 width
= nchars_string
= nbytes
= 0;
3947 else if (precision
[n
] > 0)
3948 width
= lisp_string_width (args
[n
], precision
[n
], &nchars_string
, &nbytes
);
3950 { /* no precision spec given for this argument */
3951 width
= lisp_string_width (args
[n
], -1, NULL
, NULL
);
3952 nbytes
= SBYTES (args
[n
]);
3953 nchars_string
= SCHARS (args
[n
]);
3956 /* If spec requires it, pad on right with spaces. */
3957 padding
= minlen
- width
;
3959 while (padding
-- > 0)
3965 info
[n
].start
= start
= nchars
;
3966 nchars
+= nchars_string
;
3971 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
3972 && STRING_MULTIBYTE (args
[n
])
3973 && !CHAR_HEAD_P (SREF (args
[n
], 0)))
3974 maybe_combine_byte
= 1;
3976 p
+= copy_text (SDATA (args
[n
]), p
,
3978 STRING_MULTIBYTE (args
[n
]), multibyte
);
3980 info
[n
].end
= nchars
;
3983 while (padding
-- > 0)
3989 /* If this argument has text properties, record where
3990 in the result string it appears. */
3991 if (STRING_INTERVALS (args
[n
]))
3992 info
[n
].intervals
= arg_intervals
= 1;
3994 else if (INTEGERP (args
[n
]) || FLOATP (args
[n
]))
3998 bcopy (this_format_start
, this_format
,
3999 format
- this_format_start
);
4000 this_format
[format
- this_format_start
] = 0;
4002 if (format
[-1] == 'e' || format
[-1] == 'f' || format
[-1] == 'g')
4003 sprintf (p
, this_format
, XFLOAT_DATA (args
[n
]));
4006 if (sizeof (EMACS_INT
) > sizeof (int)
4007 && format
[-1] != 'c')
4009 /* Insert 'l' before format spec. */
4010 this_format
[format
- this_format_start
]
4011 = this_format
[format
- this_format_start
- 1];
4012 this_format
[format
- this_format_start
- 1] = 'l';
4013 this_format
[format
- this_format_start
+ 1] = 0;
4016 if (INTEGERP (args
[n
]))
4018 if (format
[-1] == 'c')
4019 sprintf (p
, this_format
, (int) XINT (args
[n
]));
4020 else if (format
[-1] == 'd')
4021 sprintf (p
, this_format
, XINT (args
[n
]));
4022 /* Don't sign-extend for octal or hex printing. */
4024 sprintf (p
, this_format
, XUINT (args
[n
]));
4026 else if (format
[-1] == 'c')
4027 sprintf (p
, this_format
, (int) XFLOAT_DATA (args
[n
]));
4028 else if (format
[-1] == 'd')
4029 /* Maybe we should use "%1.0f" instead so it also works
4030 for values larger than MAXINT. */
4031 sprintf (p
, this_format
, (EMACS_INT
) XFLOAT_DATA (args
[n
]));
4033 /* Don't sign-extend for octal or hex printing. */
4034 sprintf (p
, this_format
, (EMACS_UINT
) XFLOAT_DATA (args
[n
]));
4039 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
4040 && !CHAR_HEAD_P (*((unsigned char *) p
)))
4041 maybe_combine_byte
= 1;
4042 this_nchars
= strlen (p
);
4044 p
+= str_to_multibyte (p
, buf
+ total
- 1 - p
, this_nchars
);
4047 nchars
+= this_nchars
;
4048 info
[n
].end
= nchars
;
4052 else if (STRING_MULTIBYTE (args
[0]))
4054 /* Copy a whole multibyte character. */
4057 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
4058 && !CHAR_HEAD_P (*format
))
4059 maybe_combine_byte
= 1;
4061 while (! CHAR_HEAD_P (*format
))
4063 discarded
[format
- format_start
] = 2;
4070 /* Convert a single-byte character to multibyte. */
4071 int len
= copy_text (format
, p
, 1, 0, 1);
4078 *p
++ = *format
++, nchars
++;
4081 if (p
> buf
+ total
)
4084 if (maybe_combine_byte
)
4085 nchars
= multibyte_chars_in_text (buf
, p
- buf
);
4086 val
= make_specified_string (buf
, nchars
, p
- buf
, multibyte
);
4088 /* If we allocated BUF with malloc, free it too. */
4091 /* If the format string has text properties, or any of the string
4092 arguments has text properties, set up text properties of the
4095 if (STRING_INTERVALS (args
[0]) || arg_intervals
)
4097 Lisp_Object len
, new_len
, props
;
4098 struct gcpro gcpro1
;
4100 /* Add text properties from the format string. */
4101 len
= make_number (SCHARS (args
[0]));
4102 props
= text_property_list (args
[0], make_number (0), len
, Qnil
);
4107 int bytepos
= 0, position
= 0, translated
= 0, argn
= 1;
4110 /* Adjust the bounds of each text property
4111 to the proper start and end in the output string. */
4113 /* Put the positions in PROPS in increasing order, so that
4114 we can do (effectively) one scan through the position
4115 space of the format string. */
4116 props
= Fnreverse (props
);
4118 /* BYTEPOS is the byte position in the format string,
4119 POSITION is the untranslated char position in it,
4120 TRANSLATED is the translated char position in BUF,
4121 and ARGN is the number of the next arg we will come to. */
4122 for (list
= props
; CONSP (list
); list
= XCDR (list
))
4129 /* First adjust the property start position. */
4130 pos
= XINT (XCAR (item
));
4132 /* Advance BYTEPOS, POSITION, TRANSLATED and ARGN
4133 up to this position. */
4134 for (; position
< pos
; bytepos
++)
4136 if (! discarded
[bytepos
])
4137 position
++, translated
++;
4138 else if (discarded
[bytepos
] == 1)
4141 if (translated
== info
[argn
].start
)
4143 translated
+= info
[argn
].end
- info
[argn
].start
;
4149 XSETCAR (item
, make_number (translated
));
4151 /* Likewise adjust the property end position. */
4152 pos
= XINT (XCAR (XCDR (item
)));
4154 for (; position
< pos
; bytepos
++)
4156 if (! discarded
[bytepos
])
4157 position
++, translated
++;
4158 else if (discarded
[bytepos
] == 1)
4161 if (translated
== info
[argn
].start
)
4163 translated
+= info
[argn
].end
- info
[argn
].start
;
4169 XSETCAR (XCDR (item
), make_number (translated
));
4172 add_text_properties_from_list (val
, props
, make_number (0));
4175 /* Add text properties from arguments. */
4177 for (n
= 1; n
< nargs
; ++n
)
4178 if (info
[n
].intervals
)
4180 len
= make_number (SCHARS (args
[n
]));
4181 new_len
= make_number (info
[n
].end
- info
[n
].start
);
4182 props
= text_property_list (args
[n
], make_number (0), len
, Qnil
);
4183 props
= extend_property_ranges (props
, new_len
);
4184 /* If successive arguments have properties, be sure that
4185 the value of `composition' property be the copy. */
4186 if (n
> 1 && info
[n
- 1].end
)
4187 make_composition_value_copy (props
);
4188 add_text_properties_from_list (val
, props
,
4189 make_number (info
[n
].start
));
4199 format2 (string1
, arg0
, arg1
)
4201 Lisp_Object arg0
, arg1
;
4203 Lisp_Object args
[3];
4204 args
[0] = build_string (string1
);
4207 return Fformat (3, args
);
4210 DEFUN ("char-equal", Fchar_equal
, Schar_equal
, 2, 2, 0,
4211 doc
: /* Return t if two characters match, optionally ignoring case.
4212 Both arguments must be characters (i.e. integers).
4213 Case is ignored if `case-fold-search' is non-nil in the current buffer. */)
4215 register Lisp_Object c1
, c2
;
4218 /* Check they're chars, not just integers, otherwise we could get array
4219 bounds violations in DOWNCASE. */
4220 CHECK_CHARACTER (c1
);
4221 CHECK_CHARACTER (c2
);
4223 if (XINT (c1
) == XINT (c2
))
4225 if (NILP (current_buffer
->case_fold_search
))
4228 /* Do these in separate statements,
4229 then compare the variables.
4230 because of the way DOWNCASE uses temp variables. */
4232 if (NILP (current_buffer
->enable_multibyte_characters
)
4233 && ! ASCII_CHAR_P (i1
))
4235 MAKE_CHAR_MULTIBYTE (i1
);
4238 if (NILP (current_buffer
->enable_multibyte_characters
)
4239 && ! ASCII_CHAR_P (i2
))
4241 MAKE_CHAR_MULTIBYTE (i2
);
4245 return (i1
== i2
? Qt
: Qnil
);
4248 /* Transpose the markers in two regions of the current buffer, and
4249 adjust the ones between them if necessary (i.e.: if the regions
4252 START1, END1 are the character positions of the first region.
4253 START1_BYTE, END1_BYTE are the byte positions.
4254 START2, END2 are the character positions of the second region.
4255 START2_BYTE, END2_BYTE are the byte positions.
4257 Traverses the entire marker list of the buffer to do so, adding an
4258 appropriate amount to some, subtracting from some, and leaving the
4259 rest untouched. Most of this is copied from adjust_markers in insdel.c.
4261 It's the caller's job to ensure that START1 <= END1 <= START2 <= END2. */
4264 transpose_markers (start1
, end1
, start2
, end2
,
4265 start1_byte
, end1_byte
, start2_byte
, end2_byte
)
4266 register int start1
, end1
, start2
, end2
;
4267 register int start1_byte
, end1_byte
, start2_byte
, end2_byte
;
4269 register int amt1
, amt1_byte
, amt2
, amt2_byte
, diff
, diff_byte
, mpos
;
4270 register struct Lisp_Marker
*marker
;
4272 /* Update point as if it were a marker. */
4276 TEMP_SET_PT_BOTH (PT
+ (end2
- end1
),
4277 PT_BYTE
+ (end2_byte
- end1_byte
));
4278 else if (PT
< start2
)
4279 TEMP_SET_PT_BOTH (PT
+ (end2
- start2
) - (end1
- start1
),
4280 (PT_BYTE
+ (end2_byte
- start2_byte
)
4281 - (end1_byte
- start1_byte
)));
4283 TEMP_SET_PT_BOTH (PT
- (start2
- start1
),
4284 PT_BYTE
- (start2_byte
- start1_byte
));
4286 /* We used to adjust the endpoints here to account for the gap, but that
4287 isn't good enough. Even if we assume the caller has tried to move the
4288 gap out of our way, it might still be at start1 exactly, for example;
4289 and that places it `inside' the interval, for our purposes. The amount
4290 of adjustment is nontrivial if there's a `denormalized' marker whose
4291 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
4292 the dirty work to Fmarker_position, below. */
4294 /* The difference between the region's lengths */
4295 diff
= (end2
- start2
) - (end1
- start1
);
4296 diff_byte
= (end2_byte
- start2_byte
) - (end1_byte
- start1_byte
);
4298 /* For shifting each marker in a region by the length of the other
4299 region plus the distance between the regions. */
4300 amt1
= (end2
- start2
) + (start2
- end1
);
4301 amt2
= (end1
- start1
) + (start2
- end1
);
4302 amt1_byte
= (end2_byte
- start2_byte
) + (start2_byte
- end1_byte
);
4303 amt2_byte
= (end1_byte
- start1_byte
) + (start2_byte
- end1_byte
);
4305 for (marker
= BUF_MARKERS (current_buffer
); marker
; marker
= marker
->next
)
4307 mpos
= marker
->bytepos
;
4308 if (mpos
>= start1_byte
&& mpos
< end2_byte
)
4310 if (mpos
< end1_byte
)
4312 else if (mpos
< start2_byte
)
4316 marker
->bytepos
= mpos
;
4318 mpos
= marker
->charpos
;
4319 if (mpos
>= start1
&& mpos
< end2
)
4323 else if (mpos
< start2
)
4328 marker
->charpos
= mpos
;
4332 DEFUN ("transpose-regions", Ftranspose_regions
, Stranspose_regions
, 4, 5, 0,
4333 doc
: /* Transpose region STARTR1 to ENDR1 with STARTR2 to ENDR2.
4334 The regions should not be overlapping, because the size of the buffer is
4335 never changed in a transposition.
4337 Optional fifth arg LEAVE-MARKERS, if non-nil, means don't update
4338 any markers that happen to be located in the regions.
4340 Transposing beyond buffer boundaries is an error. */)
4341 (startr1
, endr1
, startr2
, endr2
, leave_markers
)
4342 Lisp_Object startr1
, endr1
, startr2
, endr2
, leave_markers
;
4344 register EMACS_INT start1
, end1
, start2
, end2
;
4345 EMACS_INT start1_byte
, start2_byte
, len1_byte
, len2_byte
;
4346 EMACS_INT gap
, len1
, len_mid
, len2
;
4347 unsigned char *start1_addr
, *start2_addr
, *temp
;
4349 INTERVAL cur_intv
, tmp_interval1
, tmp_interval_mid
, tmp_interval2
, tmp_interval3
;
4352 XSETBUFFER (buf
, current_buffer
);
4353 cur_intv
= BUF_INTERVALS (current_buffer
);
4355 validate_region (&startr1
, &endr1
);
4356 validate_region (&startr2
, &endr2
);
4358 start1
= XFASTINT (startr1
);
4359 end1
= XFASTINT (endr1
);
4360 start2
= XFASTINT (startr2
);
4361 end2
= XFASTINT (endr2
);
4364 /* Swap the regions if they're reversed. */
4367 register int glumph
= start1
;
4375 len1
= end1
- start1
;
4376 len2
= end2
- start2
;
4379 error ("Transposed regions overlap");
4380 else if (start1
== end1
|| start2
== end2
)
4381 error ("Transposed region has length 0");
4383 /* The possibilities are:
4384 1. Adjacent (contiguous) regions, or separate but equal regions
4385 (no, really equal, in this case!), or
4386 2. Separate regions of unequal size.
4388 The worst case is usually No. 2. It means that (aside from
4389 potential need for getting the gap out of the way), there also
4390 needs to be a shifting of the text between the two regions. So
4391 if they are spread far apart, we are that much slower... sigh. */
4393 /* It must be pointed out that the really studly thing to do would
4394 be not to move the gap at all, but to leave it in place and work
4395 around it if necessary. This would be extremely efficient,
4396 especially considering that people are likely to do
4397 transpositions near where they are working interactively, which
4398 is exactly where the gap would be found. However, such code
4399 would be much harder to write and to read. So, if you are
4400 reading this comment and are feeling squirrely, by all means have
4401 a go! I just didn't feel like doing it, so I will simply move
4402 the gap the minimum distance to get it out of the way, and then
4403 deal with an unbroken array. */
4405 /* Make sure the gap won't interfere, by moving it out of the text
4406 we will operate on. */
4407 if (start1
< gap
&& gap
< end2
)
4409 if (gap
- start1
< end2
- gap
)
4415 start1_byte
= CHAR_TO_BYTE (start1
);
4416 start2_byte
= CHAR_TO_BYTE (start2
);
4417 len1_byte
= CHAR_TO_BYTE (end1
) - start1_byte
;
4418 len2_byte
= CHAR_TO_BYTE (end2
) - start2_byte
;
4420 #ifdef BYTE_COMBINING_DEBUG
4423 if (count_combining_before (BYTE_POS_ADDR (start2_byte
),
4424 len2_byte
, start1
, start1_byte
)
4425 || count_combining_before (BYTE_POS_ADDR (start1_byte
),
4426 len1_byte
, end2
, start2_byte
+ len2_byte
)
4427 || count_combining_after (BYTE_POS_ADDR (start1_byte
),
4428 len1_byte
, end2
, start2_byte
+ len2_byte
))
4433 if (count_combining_before (BYTE_POS_ADDR (start2_byte
),
4434 len2_byte
, start1
, start1_byte
)
4435 || count_combining_before (BYTE_POS_ADDR (start1_byte
),
4436 len1_byte
, start2
, start2_byte
)
4437 || count_combining_after (BYTE_POS_ADDR (start2_byte
),
4438 len2_byte
, end1
, start1_byte
+ len1_byte
)
4439 || count_combining_after (BYTE_POS_ADDR (start1_byte
),
4440 len1_byte
, end2
, start2_byte
+ len2_byte
))
4445 /* Hmmm... how about checking to see if the gap is large
4446 enough to use as the temporary storage? That would avoid an
4447 allocation... interesting. Later, don't fool with it now. */
4449 /* Working without memmove, for portability (sigh), so must be
4450 careful of overlapping subsections of the array... */
4452 if (end1
== start2
) /* adjacent regions */
4454 modify_region (current_buffer
, start1
, end2
, 0);
4455 record_change (start1
, len1
+ len2
);
4457 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4458 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4459 /* Don't use Fset_text_properties: that can cause GC, which can
4460 clobber objects stored in the tmp_intervals. */
4461 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4462 if (!NULL_INTERVAL_P (tmp_interval3
))
4463 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4465 /* First region smaller than second. */
4466 if (len1_byte
< len2_byte
)
4470 SAFE_ALLOCA (temp
, unsigned char *, len2_byte
);
4472 /* Don't precompute these addresses. We have to compute them
4473 at the last minute, because the relocating allocator might
4474 have moved the buffer around during the xmalloc. */
4475 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4476 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4478 bcopy (start2_addr
, temp
, len2_byte
);
4479 bcopy (start1_addr
, start1_addr
+ len2_byte
, len1_byte
);
4480 bcopy (temp
, start1_addr
, len2_byte
);
4484 /* First region not smaller than second. */
4488 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4489 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4490 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4491 bcopy (start1_addr
, temp
, len1_byte
);
4492 bcopy (start2_addr
, start1_addr
, len2_byte
);
4493 bcopy (temp
, start1_addr
+ len2_byte
, len1_byte
);
4496 graft_intervals_into_buffer (tmp_interval1
, start1
+ len2
,
4497 len1
, current_buffer
, 0);
4498 graft_intervals_into_buffer (tmp_interval2
, start1
,
4499 len2
, current_buffer
, 0);
4500 update_compositions (start1
, start1
+ len2
, CHECK_BORDER
);
4501 update_compositions (start1
+ len2
, end2
, CHECK_TAIL
);
4503 /* Non-adjacent regions, because end1 != start2, bleagh... */
4506 len_mid
= start2_byte
- (start1_byte
+ len1_byte
);
4508 if (len1_byte
== len2_byte
)
4509 /* Regions are same size, though, how nice. */
4513 modify_region (current_buffer
, start1
, end1
, 0);
4514 modify_region (current_buffer
, start2
, end2
, 0);
4515 record_change (start1
, len1
);
4516 record_change (start2
, len2
);
4517 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4518 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4520 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr1
, 0);
4521 if (!NULL_INTERVAL_P (tmp_interval3
))
4522 set_text_properties_1 (startr1
, endr1
, Qnil
, buf
, tmp_interval3
);
4524 tmp_interval3
= validate_interval_range (buf
, &startr2
, &endr2
, 0);
4525 if (!NULL_INTERVAL_P (tmp_interval3
))
4526 set_text_properties_1 (startr2
, endr2
, Qnil
, buf
, tmp_interval3
);
4528 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4529 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4530 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4531 bcopy (start1_addr
, temp
, len1_byte
);
4532 bcopy (start2_addr
, start1_addr
, len2_byte
);
4533 bcopy (temp
, start2_addr
, len1_byte
);
4536 graft_intervals_into_buffer (tmp_interval1
, start2
,
4537 len1
, current_buffer
, 0);
4538 graft_intervals_into_buffer (tmp_interval2
, start1
,
4539 len2
, current_buffer
, 0);
4542 else if (len1_byte
< len2_byte
) /* Second region larger than first */
4543 /* Non-adjacent & unequal size, area between must also be shifted. */
4547 modify_region (current_buffer
, start1
, end2
, 0);
4548 record_change (start1
, (end2
- start1
));
4549 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4550 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
4551 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4553 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4554 if (!NULL_INTERVAL_P (tmp_interval3
))
4555 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4557 /* holds region 2 */
4558 SAFE_ALLOCA (temp
, unsigned char *, len2_byte
);
4559 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4560 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4561 bcopy (start2_addr
, temp
, len2_byte
);
4562 bcopy (start1_addr
, start1_addr
+ len_mid
+ len2_byte
, len1_byte
);
4563 safe_bcopy (start1_addr
+ len1_byte
, start1_addr
+ len2_byte
, len_mid
);
4564 bcopy (temp
, start1_addr
, len2_byte
);
4567 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
4568 len1
, current_buffer
, 0);
4569 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
4570 len_mid
, current_buffer
, 0);
4571 graft_intervals_into_buffer (tmp_interval2
, start1
,
4572 len2
, current_buffer
, 0);
4575 /* Second region smaller than first. */
4579 record_change (start1
, (end2
- start1
));
4580 modify_region (current_buffer
, start1
, end2
, 0);
4582 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4583 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
4584 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4586 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4587 if (!NULL_INTERVAL_P (tmp_interval3
))
4588 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4590 /* holds region 1 */
4591 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4592 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4593 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4594 bcopy (start1_addr
, temp
, len1_byte
);
4595 bcopy (start2_addr
, start1_addr
, len2_byte
);
4596 bcopy (start1_addr
+ len1_byte
, start1_addr
+ len2_byte
, len_mid
);
4597 bcopy (temp
, start1_addr
+ len2_byte
+ len_mid
, len1_byte
);
4600 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
4601 len1
, current_buffer
, 0);
4602 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
4603 len_mid
, current_buffer
, 0);
4604 graft_intervals_into_buffer (tmp_interval2
, start1
,
4605 len2
, current_buffer
, 0);
4608 update_compositions (start1
, start1
+ len2
, CHECK_BORDER
);
4609 update_compositions (end2
- len1
, end2
, CHECK_BORDER
);
4612 /* When doing multiple transpositions, it might be nice
4613 to optimize this. Perhaps the markers in any one buffer
4614 should be organized in some sorted data tree. */
4615 if (NILP (leave_markers
))
4617 transpose_markers (start1
, end1
, start2
, end2
,
4618 start1_byte
, start1_byte
+ len1_byte
,
4619 start2_byte
, start2_byte
+ len2_byte
);
4620 fix_start_end_in_overlays (start1
, end2
);
4623 signal_after_change (start1
, end2
- start1
, end2
- start1
);
4634 Qbuffer_access_fontify_functions
4635 = intern_c_string ("buffer-access-fontify-functions");
4636 staticpro (&Qbuffer_access_fontify_functions
);
4638 DEFVAR_LISP ("inhibit-field-text-motion", &Vinhibit_field_text_motion
,
4639 doc
: /* Non-nil means text motion commands don't notice fields. */);
4640 Vinhibit_field_text_motion
= Qnil
;
4642 DEFVAR_LISP ("buffer-access-fontify-functions",
4643 &Vbuffer_access_fontify_functions
,
4644 doc
: /* List of functions called by `buffer-substring' to fontify if necessary.
4645 Each function is called with two arguments which specify the range
4646 of the buffer being accessed. */);
4647 Vbuffer_access_fontify_functions
= Qnil
;
4651 extern Lisp_Object Vprin1_to_string_buffer
;
4652 obuf
= Fcurrent_buffer ();
4653 /* Do this here, because init_buffer_once is too early--it won't work. */
4654 Fset_buffer (Vprin1_to_string_buffer
);
4655 /* Make sure buffer-access-fontify-functions is nil in this buffer. */
4656 Fset (Fmake_local_variable (intern_c_string ("buffer-access-fontify-functions")),
4661 DEFVAR_LISP ("buffer-access-fontified-property",
4662 &Vbuffer_access_fontified_property
,
4663 doc
: /* Property which (if non-nil) indicates text has been fontified.
4664 `buffer-substring' need not call the `buffer-access-fontify-functions'
4665 functions if all the text being accessed has this property. */);
4666 Vbuffer_access_fontified_property
= Qnil
;
4668 DEFVAR_LISP ("system-name", &Vsystem_name
,
4669 doc
: /* The host name of the machine Emacs is running on. */);
4671 DEFVAR_LISP ("user-full-name", &Vuser_full_name
,
4672 doc
: /* The full name of the user logged in. */);
4674 DEFVAR_LISP ("user-login-name", &Vuser_login_name
,
4675 doc
: /* The user's name, taken from environment variables if possible. */);
4677 DEFVAR_LISP ("user-real-login-name", &Vuser_real_login_name
,
4678 doc
: /* The user's name, based upon the real uid only. */);
4680 DEFVAR_LISP ("operating-system-release", &Voperating_system_release
,
4681 doc
: /* The release of the operating system Emacs is running on. */);
4683 defsubr (&Spropertize
);
4684 defsubr (&Schar_equal
);
4685 defsubr (&Sgoto_char
);
4686 defsubr (&Sstring_to_char
);
4687 defsubr (&Schar_to_string
);
4688 defsubr (&Sbuffer_substring
);
4689 defsubr (&Sbuffer_substring_no_properties
);
4690 defsubr (&Sbuffer_string
);
4692 defsubr (&Spoint_marker
);
4693 defsubr (&Smark_marker
);
4695 defsubr (&Sregion_beginning
);
4696 defsubr (&Sregion_end
);
4698 staticpro (&Qfield
);
4699 Qfield
= intern_c_string ("field");
4700 staticpro (&Qboundary
);
4701 Qboundary
= intern_c_string ("boundary");
4702 defsubr (&Sfield_beginning
);
4703 defsubr (&Sfield_end
);
4704 defsubr (&Sfield_string
);
4705 defsubr (&Sfield_string_no_properties
);
4706 defsubr (&Sdelete_field
);
4707 defsubr (&Sconstrain_to_field
);
4709 defsubr (&Sline_beginning_position
);
4710 defsubr (&Sline_end_position
);
4712 /* defsubr (&Smark); */
4713 /* defsubr (&Sset_mark); */
4714 defsubr (&Ssave_excursion
);
4715 defsubr (&Ssave_current_buffer
);
4717 defsubr (&Sbufsize
);
4718 defsubr (&Spoint_max
);
4719 defsubr (&Spoint_min
);
4720 defsubr (&Spoint_min_marker
);
4721 defsubr (&Spoint_max_marker
);
4722 defsubr (&Sgap_position
);
4723 defsubr (&Sgap_size
);
4724 defsubr (&Sposition_bytes
);
4725 defsubr (&Sbyte_to_position
);
4731 defsubr (&Sfollowing_char
);
4732 defsubr (&Sprevious_char
);
4733 defsubr (&Schar_after
);
4734 defsubr (&Schar_before
);
4736 defsubr (&Sinsert_before_markers
);
4737 defsubr (&Sinsert_and_inherit
);
4738 defsubr (&Sinsert_and_inherit_before_markers
);
4739 defsubr (&Sinsert_char
);
4740 defsubr (&Sinsert_byte
);
4742 defsubr (&Suser_login_name
);
4743 defsubr (&Suser_real_login_name
);
4744 defsubr (&Suser_uid
);
4745 defsubr (&Suser_real_uid
);
4746 defsubr (&Suser_full_name
);
4747 defsubr (&Semacs_pid
);
4748 defsubr (&Scurrent_time
);
4749 defsubr (&Sget_internal_run_time
);
4750 defsubr (&Sformat_time_string
);
4751 defsubr (&Sfloat_time
);
4752 defsubr (&Sdecode_time
);
4753 defsubr (&Sencode_time
);
4754 defsubr (&Scurrent_time_string
);
4755 defsubr (&Scurrent_time_zone
);
4756 defsubr (&Sset_time_zone_rule
);
4757 defsubr (&Ssystem_name
);
4758 defsubr (&Smessage
);
4759 defsubr (&Smessage_box
);
4760 defsubr (&Smessage_or_box
);
4761 defsubr (&Scurrent_message
);
4764 defsubr (&Sinsert_buffer_substring
);
4765 defsubr (&Scompare_buffer_substrings
);
4766 defsubr (&Ssubst_char_in_region
);
4767 defsubr (&Stranslate_region_internal
);
4768 defsubr (&Sdelete_region
);
4769 defsubr (&Sdelete_and_extract_region
);
4771 defsubr (&Snarrow_to_region
);
4772 defsubr (&Ssave_restriction
);
4773 defsubr (&Stranspose_regions
);
4776 /* arch-tag: fc3827d8-6f60-4067-b11e-c3218031b018
4777 (do not change this comment) */