1 /* Lisp functions pertaining to editing.
3 Copyright (C) 1985-1987, 1989, 1993-2011 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
22 #include <sys/types.h>
32 #ifdef HAVE_SYS_UTSNAME_H
33 #include <sys/utsname.h>
38 /* systime.h includes <sys/time.h> which, on some systems, is required
39 for <sys/resource.h>; thus systime.h must be included before
43 #if defined HAVE_SYS_RESOURCE_H
44 #include <sys/resource.h>
50 #include "intervals.h"
52 #include "character.h"
56 #include "blockinput.h"
60 #define MAX_10_EXP DBL_MAX_10_EXP
62 #define MAX_10_EXP 310
69 #ifndef USER_FULL_NAME
70 #define USER_FULL_NAME pw->pw_gecos
74 extern char **environ
;
77 #define TM_YEAR_BASE 1900
79 /* Nonzero if TM_YEAR is a struct tm's tm_year value that causes
80 asctime to have well-defined behavior. */
81 #ifndef TM_YEAR_IN_ASCTIME_RANGE
82 # define TM_YEAR_IN_ASCTIME_RANGE(tm_year) \
83 (1000 - TM_YEAR_BASE <= (tm_year) && (tm_year) <= 9999 - TM_YEAR_BASE)
87 extern Lisp_Object
w32_get_internal_run_time (void);
90 static int tm_diff (struct tm
*, struct tm
*);
91 static void find_field (Lisp_Object
, Lisp_Object
, Lisp_Object
,
92 EMACS_INT
*, Lisp_Object
, EMACS_INT
*);
93 static void update_buffer_properties (EMACS_INT
, EMACS_INT
);
94 static Lisp_Object
region_limit (int);
95 static size_t emacs_memftimeu (char *, size_t, const char *,
96 size_t, const struct tm
*, int);
97 static void general_insert_function (void (*) (const unsigned char *, EMACS_INT
),
98 void (*) (Lisp_Object
, EMACS_INT
,
101 int, int, Lisp_Object
*);
102 static Lisp_Object
subst_char_in_region_unwind (Lisp_Object
);
103 static Lisp_Object
subst_char_in_region_unwind_1 (Lisp_Object
);
104 static void transpose_markers (EMACS_INT
, EMACS_INT
, EMACS_INT
, EMACS_INT
,
105 EMACS_INT
, EMACS_INT
, EMACS_INT
, EMACS_INT
);
107 Lisp_Object Qbuffer_access_fontify_functions
;
108 Lisp_Object
Fuser_full_name (Lisp_Object
);
110 /* Symbol for the text property used to mark fields. */
114 /* A special value for Qfield properties. */
116 Lisp_Object Qboundary
;
123 register unsigned char *p
;
124 struct passwd
*pw
; /* password entry for the current user */
127 /* Set up system_name even when dumping. */
131 /* Don't bother with this on initial start when just dumping out */
134 #endif /* not CANNOT_DUMP */
136 pw
= (struct passwd
*) getpwuid (getuid ());
138 /* We let the real user name default to "root" because that's quite
139 accurate on MSDOG and because it lets Emacs find the init file.
140 (The DVX libraries override the Djgpp libraries here.) */
141 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "root");
143 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "unknown");
146 /* Get the effective user name, by consulting environment variables,
147 or the effective uid if those are unset. */
148 user_name
= (char *) getenv ("LOGNAME");
151 user_name
= (char *) getenv ("USERNAME"); /* it's USERNAME on NT */
152 #else /* WINDOWSNT */
153 user_name
= (char *) getenv ("USER");
154 #endif /* WINDOWSNT */
157 pw
= (struct passwd
*) getpwuid (geteuid ());
158 user_name
= (char *) (pw
? pw
->pw_name
: "unknown");
160 Vuser_login_name
= build_string (user_name
);
162 /* If the user name claimed in the environment vars differs from
163 the real uid, use the claimed name to find the full name. */
164 tem
= Fstring_equal (Vuser_login_name
, Vuser_real_login_name
);
165 Vuser_full_name
= Fuser_full_name (NILP (tem
)? make_number (geteuid())
168 p
= (unsigned char *) getenv ("NAME");
170 Vuser_full_name
= build_string (p
);
171 else if (NILP (Vuser_full_name
))
172 Vuser_full_name
= build_string ("unknown");
174 #ifdef HAVE_SYS_UTSNAME_H
178 Voperating_system_release
= build_string (uts
.release
);
181 Voperating_system_release
= Qnil
;
185 DEFUN ("char-to-string", Fchar_to_string
, Schar_to_string
, 1, 1, 0,
186 doc
: /* Convert arg CHAR to a string containing that character.
187 usage: (char-to-string CHAR) */)
188 (Lisp_Object character
)
191 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
193 CHECK_CHARACTER (character
);
195 len
= CHAR_STRING (XFASTINT (character
), str
);
196 return make_string_from_bytes (str
, 1, len
);
199 DEFUN ("byte-to-string", Fbyte_to_string
, Sbyte_to_string
, 1, 1, 0,
200 doc
: /* Convert arg BYTE to a unibyte string containing that byte. */)
205 if (XINT (byte
) < 0 || XINT (byte
) > 255)
206 error ("Invalid byte");
208 return make_string_from_bytes (&b
, 1, 1);
211 DEFUN ("string-to-char", Fstring_to_char
, Sstring_to_char
, 1, 1, 0,
212 doc
: /* Convert arg STRING to a character, the first character of that string.
213 A multibyte character is handled correctly. */)
214 (register Lisp_Object string
)
216 register Lisp_Object val
;
217 CHECK_STRING (string
);
220 if (STRING_MULTIBYTE (string
))
221 XSETFASTINT (val
, STRING_CHAR (SDATA (string
)));
223 XSETFASTINT (val
, SREF (string
, 0));
226 XSETFASTINT (val
, 0);
231 buildmark (EMACS_INT charpos
, EMACS_INT bytepos
)
233 register Lisp_Object mark
;
234 mark
= Fmake_marker ();
235 set_marker_both (mark
, Qnil
, charpos
, bytepos
);
239 DEFUN ("point", Fpoint
, Spoint
, 0, 0, 0,
240 doc
: /* Return value of point, as an integer.
241 Beginning of buffer is position (point-min). */)
245 XSETFASTINT (temp
, PT
);
249 DEFUN ("point-marker", Fpoint_marker
, Spoint_marker
, 0, 0, 0,
250 doc
: /* Return value of point, as a marker object. */)
253 return buildmark (PT
, PT_BYTE
);
257 clip_to_bounds (EMACS_INT lower
, EMACS_INT num
, EMACS_INT upper
)
261 else if (num
> upper
)
267 DEFUN ("goto-char", Fgoto_char
, Sgoto_char
, 1, 1, "NGoto char: ",
268 doc
: /* Set point to POSITION, a number or marker.
269 Beginning of buffer is position (point-min), end is (point-max).
271 The return value is POSITION. */)
272 (register Lisp_Object position
)
276 if (MARKERP (position
)
277 && current_buffer
== XMARKER (position
)->buffer
)
279 pos
= marker_position (position
);
281 SET_PT_BOTH (BEGV
, BEGV_BYTE
);
283 SET_PT_BOTH (ZV
, ZV_BYTE
);
285 SET_PT_BOTH (pos
, marker_byte_position (position
));
290 CHECK_NUMBER_COERCE_MARKER (position
);
292 pos
= clip_to_bounds (BEGV
, XINT (position
), ZV
);
298 /* Return the start or end position of the region.
299 BEGINNINGP non-zero means return the start.
300 If there is no region active, signal an error. */
303 region_limit (int beginningp
)
307 if (!NILP (Vtransient_mark_mode
)
308 && NILP (Vmark_even_if_inactive
)
309 && NILP (current_buffer
->mark_active
))
310 xsignal0 (Qmark_inactive
);
312 m
= Fmarker_position (current_buffer
->mark
);
314 error ("The mark is not set now, so there is no region");
316 if ((PT
< XFASTINT (m
)) == (beginningp
!= 0))
317 m
= make_number (PT
);
321 DEFUN ("region-beginning", Fregion_beginning
, Sregion_beginning
, 0, 0, 0,
322 doc
: /* Return the integer value of point or mark, whichever is smaller. */)
325 return region_limit (1);
328 DEFUN ("region-end", Fregion_end
, Sregion_end
, 0, 0, 0,
329 doc
: /* Return the integer value of point or mark, whichever is larger. */)
332 return region_limit (0);
335 DEFUN ("mark-marker", Fmark_marker
, Smark_marker
, 0, 0, 0,
336 doc
: /* Return this buffer's mark, as a marker object.
337 Watch out! Moving this marker changes the mark position.
338 If you set the marker not to point anywhere, the buffer will have no mark. */)
341 return current_buffer
->mark
;
345 /* Find all the overlays in the current buffer that touch position POS.
346 Return the number found, and store them in a vector in VEC
350 overlays_around (EMACS_INT pos
, Lisp_Object
*vec
, int len
)
352 Lisp_Object overlay
, start
, end
;
353 struct Lisp_Overlay
*tail
;
354 EMACS_INT startpos
, endpos
;
357 for (tail
= current_buffer
->overlays_before
; tail
; tail
= tail
->next
)
359 XSETMISC (overlay
, tail
);
361 end
= OVERLAY_END (overlay
);
362 endpos
= OVERLAY_POSITION (end
);
365 start
= OVERLAY_START (overlay
);
366 startpos
= OVERLAY_POSITION (start
);
371 /* Keep counting overlays even if we can't return them all. */
376 for (tail
= current_buffer
->overlays_after
; tail
; tail
= tail
->next
)
378 XSETMISC (overlay
, tail
);
380 start
= OVERLAY_START (overlay
);
381 startpos
= OVERLAY_POSITION (start
);
384 end
= OVERLAY_END (overlay
);
385 endpos
= OVERLAY_POSITION (end
);
397 /* Return the value of property PROP, in OBJECT at POSITION.
398 It's the value of PROP that a char inserted at POSITION would get.
399 OBJECT is optional and defaults to the current buffer.
400 If OBJECT is a buffer, then overlay properties are considered as well as
402 If OBJECT is a window, then that window's buffer is used, but
403 window-specific overlays are considered only if they are associated
406 get_pos_property (Lisp_Object position
, register Lisp_Object prop
, Lisp_Object object
)
408 CHECK_NUMBER_COERCE_MARKER (position
);
411 XSETBUFFER (object
, current_buffer
);
412 else if (WINDOWP (object
))
413 object
= XWINDOW (object
)->buffer
;
415 if (!BUFFERP (object
))
416 /* pos-property only makes sense in buffers right now, since strings
417 have no overlays and no notion of insertion for which stickiness
419 return Fget_text_property (position
, prop
, object
);
422 EMACS_INT posn
= XINT (position
);
424 Lisp_Object
*overlay_vec
, tem
;
425 struct buffer
*obuf
= current_buffer
;
427 set_buffer_temp (XBUFFER (object
));
429 /* First try with room for 40 overlays. */
431 overlay_vec
= (Lisp_Object
*) alloca (noverlays
* sizeof (Lisp_Object
));
432 noverlays
= overlays_around (posn
, overlay_vec
, noverlays
);
434 /* If there are more than 40,
435 make enough space for all, and try again. */
438 overlay_vec
= (Lisp_Object
*) alloca (noverlays
* sizeof (Lisp_Object
));
439 noverlays
= overlays_around (posn
, overlay_vec
, noverlays
);
441 noverlays
= sort_overlays (overlay_vec
, noverlays
, NULL
);
443 set_buffer_temp (obuf
);
445 /* Now check the overlays in order of decreasing priority. */
446 while (--noverlays
>= 0)
448 Lisp_Object ol
= overlay_vec
[noverlays
];
449 tem
= Foverlay_get (ol
, prop
);
452 /* Check the overlay is indeed active at point. */
453 Lisp_Object start
= OVERLAY_START (ol
), finish
= OVERLAY_END (ol
);
454 if ((OVERLAY_POSITION (start
) == posn
455 && XMARKER (start
)->insertion_type
== 1)
456 || (OVERLAY_POSITION (finish
) == posn
457 && XMARKER (finish
)->insertion_type
== 0))
458 ; /* The overlay will not cover a char inserted at point. */
466 { /* Now check the text properties. */
467 int stickiness
= text_property_stickiness (prop
, position
, object
);
469 return Fget_text_property (position
, prop
, object
);
470 else if (stickiness
< 0
471 && XINT (position
) > BUF_BEGV (XBUFFER (object
)))
472 return Fget_text_property (make_number (XINT (position
) - 1),
480 /* Find the field surrounding POS in *BEG and *END. If POS is nil,
481 the value of point is used instead. If BEG or END is null,
482 means don't store the beginning or end of the field.
484 BEG_LIMIT and END_LIMIT serve to limit the ranged of the returned
485 results; they do not effect boundary behavior.
487 If MERGE_AT_BOUNDARY is nonzero, then if POS is at the very first
488 position of a field, then the beginning of the previous field is
489 returned instead of the beginning of POS's field (since the end of a
490 field is actually also the beginning of the next input field, this
491 behavior is sometimes useful). Additionally in the MERGE_AT_BOUNDARY
492 true case, if two fields are separated by a field with the special
493 value `boundary', and POS lies within it, then the two separated
494 fields are considered to be adjacent, and POS between them, when
495 finding the beginning and ending of the "merged" field.
497 Either BEG or END may be 0, in which case the corresponding value
501 find_field (Lisp_Object pos
, Lisp_Object merge_at_boundary
,
502 Lisp_Object beg_limit
,
503 EMACS_INT
*beg
, Lisp_Object end_limit
, EMACS_INT
*end
)
505 /* Fields right before and after the point. */
506 Lisp_Object before_field
, after_field
;
507 /* 1 if POS counts as the start of a field. */
508 int at_field_start
= 0;
509 /* 1 if POS counts as the end of a field. */
510 int at_field_end
= 0;
513 XSETFASTINT (pos
, PT
);
515 CHECK_NUMBER_COERCE_MARKER (pos
);
518 = get_char_property_and_overlay (pos
, Qfield
, Qnil
, NULL
);
520 = (XFASTINT (pos
) > BEGV
521 ? get_char_property_and_overlay (make_number (XINT (pos
) - 1),
523 /* Using nil here would be a more obvious choice, but it would
524 fail when the buffer starts with a non-sticky field. */
527 /* See if we need to handle the case where MERGE_AT_BOUNDARY is nil
528 and POS is at beginning of a field, which can also be interpreted
529 as the end of the previous field. Note that the case where if
530 MERGE_AT_BOUNDARY is non-nil (see function comment) is actually the
531 more natural one; then we avoid treating the beginning of a field
533 if (NILP (merge_at_boundary
))
535 Lisp_Object field
= get_pos_property (pos
, Qfield
, Qnil
);
536 if (!EQ (field
, after_field
))
538 if (!EQ (field
, before_field
))
540 if (NILP (field
) && at_field_start
&& at_field_end
)
541 /* If an inserted char would have a nil field while the surrounding
542 text is non-nil, we're probably not looking at a
543 zero-length field, but instead at a non-nil field that's
544 not intended for editing (such as comint's prompts). */
545 at_field_end
= at_field_start
= 0;
548 /* Note about special `boundary' fields:
550 Consider the case where the point (`.') is between the fields `x' and `y':
554 In this situation, if merge_at_boundary is true, we consider the
555 `x' and `y' fields as forming one big merged field, and so the end
556 of the field is the end of `y'.
558 However, if `x' and `y' are separated by a special `boundary' field
559 (a field with a `field' char-property of 'boundary), then we ignore
560 this special field when merging adjacent fields. Here's the same
561 situation, but with a `boundary' field between the `x' and `y' fields:
565 Here, if point is at the end of `x', the beginning of `y', or
566 anywhere in-between (within the `boundary' field), we merge all
567 three fields and consider the beginning as being the beginning of
568 the `x' field, and the end as being the end of the `y' field. */
573 /* POS is at the edge of a field, and we should consider it as
574 the beginning of the following field. */
575 *beg
= XFASTINT (pos
);
577 /* Find the previous field boundary. */
580 if (!NILP (merge_at_boundary
) && EQ (before_field
, Qboundary
))
581 /* Skip a `boundary' field. */
582 p
= Fprevious_single_char_property_change (p
, Qfield
, Qnil
,
585 p
= Fprevious_single_char_property_change (p
, Qfield
, Qnil
,
587 *beg
= NILP (p
) ? BEGV
: XFASTINT (p
);
594 /* POS is at the edge of a field, and we should consider it as
595 the end of the previous field. */
596 *end
= XFASTINT (pos
);
598 /* Find the next field boundary. */
600 if (!NILP (merge_at_boundary
) && EQ (after_field
, Qboundary
))
601 /* Skip a `boundary' field. */
602 pos
= Fnext_single_char_property_change (pos
, Qfield
, Qnil
,
605 pos
= Fnext_single_char_property_change (pos
, Qfield
, Qnil
,
607 *end
= NILP (pos
) ? ZV
: XFASTINT (pos
);
613 DEFUN ("delete-field", Fdelete_field
, Sdelete_field
, 0, 1, 0,
614 doc
: /* Delete the field surrounding POS.
615 A field is a region of text with the same `field' property.
616 If POS is nil, the value of point is used for POS. */)
620 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
622 del_range (beg
, end
);
626 DEFUN ("field-string", Ffield_string
, Sfield_string
, 0, 1, 0,
627 doc
: /* Return the contents of the field surrounding POS as a string.
628 A field is a region of text with the same `field' property.
629 If POS is nil, the value of point is used for POS. */)
633 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
634 return make_buffer_string (beg
, end
, 1);
637 DEFUN ("field-string-no-properties", Ffield_string_no_properties
, Sfield_string_no_properties
, 0, 1, 0,
638 doc
: /* Return the contents of the field around POS, without text properties.
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. */)
644 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
645 return make_buffer_string (beg
, end
, 0);
648 DEFUN ("field-beginning", Ffield_beginning
, Sfield_beginning
, 0, 3, 0,
649 doc
: /* Return the beginning of the field surrounding POS.
650 A field is a region of text with the same `field' property.
651 If POS is nil, the value of point is used for POS.
652 If ESCAPE-FROM-EDGE is non-nil and POS is at the beginning of its
653 field, then the beginning of the *previous* field is returned.
654 If LIMIT is non-nil, it is a buffer position; if the beginning of the field
655 is before LIMIT, then LIMIT will be returned instead. */)
656 (Lisp_Object pos
, Lisp_Object escape_from_edge
, Lisp_Object limit
)
659 find_field (pos
, escape_from_edge
, limit
, &beg
, Qnil
, 0);
660 return make_number (beg
);
663 DEFUN ("field-end", Ffield_end
, Sfield_end
, 0, 3, 0,
664 doc
: /* Return the end of the field surrounding POS.
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.
667 If ESCAPE-FROM-EDGE is non-nil and POS is at the end of its field,
668 then the end of the *following* field is returned.
669 If LIMIT is non-nil, it is a buffer position; if the end of the field
670 is after LIMIT, then LIMIT will be returned instead. */)
671 (Lisp_Object pos
, Lisp_Object escape_from_edge
, Lisp_Object limit
)
674 find_field (pos
, escape_from_edge
, Qnil
, 0, limit
, &end
);
675 return make_number (end
);
678 DEFUN ("constrain-to-field", Fconstrain_to_field
, Sconstrain_to_field
, 2, 5, 0,
679 doc
: /* Return the position closest to NEW-POS that is in the same field as OLD-POS.
681 A field is a region of text with the same `field' property.
682 If NEW-POS is nil, then the current point is used instead, and set to the
683 constrained position if that is different.
685 If OLD-POS is at the boundary of two fields, then the allowable
686 positions for NEW-POS depends on the value of the optional argument
687 ESCAPE-FROM-EDGE: If ESCAPE-FROM-EDGE is nil, then NEW-POS is
688 constrained to the field that has the same `field' char-property
689 as any new characters inserted at OLD-POS, whereas if ESCAPE-FROM-EDGE
690 is non-nil, NEW-POS is constrained to the union of the two adjacent
691 fields. Additionally, if two fields are separated by another field with
692 the special value `boundary', then any point within this special field is
693 also considered to be `on the boundary'.
695 If the optional argument ONLY-IN-LINE is non-nil and constraining
696 NEW-POS would move it to a different line, NEW-POS is returned
697 unconstrained. This useful for commands that move by line, like
698 \\[next-line] or \\[beginning-of-line], which should generally respect field boundaries
699 only in the case where they can still move to the right line.
701 If the optional argument INHIBIT-CAPTURE-PROPERTY is non-nil, and OLD-POS has
702 a non-nil property of that name, then any field boundaries are ignored.
704 Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil. */)
705 (Lisp_Object new_pos
, Lisp_Object old_pos
, Lisp_Object escape_from_edge
, Lisp_Object only_in_line
, Lisp_Object inhibit_capture_property
)
707 /* If non-zero, then the original point, before re-positioning. */
708 EMACS_INT orig_point
= 0;
710 Lisp_Object prev_old
, prev_new
;
713 /* Use the current point, and afterwards, set it. */
716 XSETFASTINT (new_pos
, PT
);
719 CHECK_NUMBER_COERCE_MARKER (new_pos
);
720 CHECK_NUMBER_COERCE_MARKER (old_pos
);
722 fwd
= (XFASTINT (new_pos
) > XFASTINT (old_pos
));
724 prev_old
= make_number (XFASTINT (old_pos
) - 1);
725 prev_new
= make_number (XFASTINT (new_pos
) - 1);
727 if (NILP (Vinhibit_field_text_motion
)
728 && !EQ (new_pos
, old_pos
)
729 && (!NILP (Fget_char_property (new_pos
, Qfield
, Qnil
))
730 || !NILP (Fget_char_property (old_pos
, Qfield
, Qnil
))
731 /* To recognize field boundaries, we must also look at the
732 previous positions; we could use `get_pos_property'
733 instead, but in itself that would fail inside non-sticky
734 fields (like comint prompts). */
735 || (XFASTINT (new_pos
) > BEGV
736 && !NILP (Fget_char_property (prev_new
, Qfield
, Qnil
)))
737 || (XFASTINT (old_pos
) > BEGV
738 && !NILP (Fget_char_property (prev_old
, Qfield
, Qnil
))))
739 && (NILP (inhibit_capture_property
)
740 /* Field boundaries are again a problem; but now we must
741 decide the case exactly, so we need to call
742 `get_pos_property' as well. */
743 || (NILP (get_pos_property (old_pos
, inhibit_capture_property
, Qnil
))
744 && (XFASTINT (old_pos
) <= BEGV
745 || NILP (Fget_char_property (old_pos
, inhibit_capture_property
, Qnil
))
746 || NILP (Fget_char_property (prev_old
, inhibit_capture_property
, Qnil
))))))
747 /* It is possible that NEW_POS is not within the same field as
748 OLD_POS; try to move NEW_POS so that it is. */
751 Lisp_Object field_bound
;
754 field_bound
= Ffield_end (old_pos
, escape_from_edge
, new_pos
);
756 field_bound
= Ffield_beginning (old_pos
, escape_from_edge
, new_pos
);
758 if (/* See if ESCAPE_FROM_EDGE caused FIELD_BOUND to jump to the
759 other side of NEW_POS, which would mean that NEW_POS is
760 already acceptable, and it's not necessary to constrain it
762 ((XFASTINT (field_bound
) < XFASTINT (new_pos
)) ? fwd
: !fwd
)
763 /* NEW_POS should be constrained, but only if either
764 ONLY_IN_LINE is nil (in which case any constraint is OK),
765 or NEW_POS and FIELD_BOUND are on the same line (in which
766 case the constraint is OK even if ONLY_IN_LINE is non-nil). */
767 && (NILP (only_in_line
)
768 /* This is the ONLY_IN_LINE case, check that NEW_POS and
769 FIELD_BOUND are on the same line by seeing whether
770 there's an intervening newline or not. */
771 || (scan_buffer ('\n',
772 XFASTINT (new_pos
), XFASTINT (field_bound
),
773 fwd
? -1 : 1, &shortage
, 1),
775 /* Constrain NEW_POS to FIELD_BOUND. */
776 new_pos
= field_bound
;
778 if (orig_point
&& XFASTINT (new_pos
) != orig_point
)
779 /* The NEW_POS argument was originally nil, so automatically set PT. */
780 SET_PT (XFASTINT (new_pos
));
787 DEFUN ("line-beginning-position",
788 Fline_beginning_position
, Sline_beginning_position
, 0, 1, 0,
789 doc
: /* Return the character position of the first character on the current line.
790 With argument N not nil or 1, move forward N - 1 lines first.
791 If scan reaches end of buffer, return that position.
793 The returned position is of the first character in the logical order,
794 i.e. the one that has the smallest character position.
796 This function constrains the returned position to the current field
797 unless that would be on a different line than the original,
798 unconstrained result. If N is nil or 1, and a front-sticky field
799 starts at point, the scan stops as soon as it starts. To ignore field
800 boundaries bind `inhibit-field-text-motion' to t.
802 This function does not move point. */)
805 EMACS_INT orig
, orig_byte
, end
;
806 int count
= SPECPDL_INDEX ();
807 specbind (Qinhibit_point_motion_hooks
, Qt
);
816 Fforward_line (make_number (XINT (n
) - 1));
819 SET_PT_BOTH (orig
, orig_byte
);
821 unbind_to (count
, Qnil
);
823 /* Return END constrained to the current input field. */
824 return Fconstrain_to_field (make_number (end
), make_number (orig
),
825 XINT (n
) != 1 ? Qt
: Qnil
,
829 DEFUN ("line-end-position", Fline_end_position
, Sline_end_position
, 0, 1, 0,
830 doc
: /* Return the character position of the last character on the current line.
831 With argument N not nil or 1, move forward N - 1 lines first.
832 If scan reaches end of buffer, return that position.
834 The returned position is of the last character in the logical order,
835 i.e. the character whose buffer position is the largest one.
837 This function constrains the returned position to the current field
838 unless that would be on a different line than the original,
839 unconstrained result. If N is nil or 1, and a rear-sticky field ends
840 at point, the scan stops as soon as it starts. To ignore field
841 boundaries bind `inhibit-field-text-motion' to t.
843 This function does not move point. */)
854 end_pos
= find_before_next_newline (orig
, 0, XINT (n
) - (XINT (n
) <= 0));
856 /* Return END_POS constrained to the current input field. */
857 return Fconstrain_to_field (make_number (end_pos
), make_number (orig
),
863 save_excursion_save (void)
865 int visible
= (XBUFFER (XWINDOW (selected_window
)->buffer
)
868 return Fcons (Fpoint_marker (),
869 Fcons (Fcopy_marker (current_buffer
->mark
, Qnil
),
870 Fcons (visible
? Qt
: Qnil
,
871 Fcons (current_buffer
->mark_active
,
876 save_excursion_restore (Lisp_Object info
)
878 Lisp_Object tem
, tem1
, omark
, nmark
;
879 struct gcpro gcpro1
, gcpro2
, gcpro3
;
882 tem
= Fmarker_buffer (XCAR (info
));
883 /* If buffer being returned to is now deleted, avoid error */
884 /* Otherwise could get error here while unwinding to top level
886 /* In that case, Fmarker_buffer returns nil now. */
890 omark
= nmark
= Qnil
;
891 GCPRO3 (info
, omark
, nmark
);
898 unchain_marker (XMARKER (tem
));
903 omark
= Fmarker_position (current_buffer
->mark
);
904 Fset_marker (current_buffer
->mark
, tem
, Fcurrent_buffer ());
905 nmark
= Fmarker_position (tem
);
906 unchain_marker (XMARKER (tem
));
910 visible_p
= !NILP (XCAR (info
));
912 #if 0 /* We used to make the current buffer visible in the selected window
913 if that was true previously. That avoids some anomalies.
914 But it creates others, and it wasn't documented, and it is simpler
915 and cleaner never to alter the window/buffer connections. */
918 && current_buffer
!= XBUFFER (XWINDOW (selected_window
)->buffer
))
919 Fswitch_to_buffer (Fcurrent_buffer (), Qnil
);
925 tem1
= current_buffer
->mark_active
;
926 current_buffer
->mark_active
= tem
;
928 if (!NILP (Vrun_hooks
))
930 /* If mark is active now, and either was not active
931 or was at a different place, run the activate hook. */
932 if (! NILP (current_buffer
->mark_active
))
934 if (! EQ (omark
, nmark
))
935 call1 (Vrun_hooks
, intern ("activate-mark-hook"));
937 /* If mark has ceased to be active, run deactivate hook. */
938 else if (! NILP (tem1
))
939 call1 (Vrun_hooks
, intern ("deactivate-mark-hook"));
942 /* If buffer was visible in a window, and a different window was
943 selected, and the old selected window is still showing this
944 buffer, restore point in that window. */
947 && !EQ (tem
, selected_window
)
948 && (tem1
= XWINDOW (tem
)->buffer
,
949 (/* Window is live... */
951 /* ...and it shows the current buffer. */
952 && XBUFFER (tem1
) == current_buffer
)))
953 Fset_window_point (tem
, make_number (PT
));
959 DEFUN ("save-excursion", Fsave_excursion
, Ssave_excursion
, 0, UNEVALLED
, 0,
960 doc
: /* Save point, mark, and current buffer; execute BODY; restore those things.
961 Executes BODY just like `progn'.
962 The values of point, mark and the current buffer are restored
963 even in case of abnormal exit (throw or error).
964 The state of activation of the mark is also restored.
966 This construct does not save `deactivate-mark', and therefore
967 functions that change the buffer will still cause deactivation
968 of the mark at the end of the command. To prevent that, bind
969 `deactivate-mark' with `let'.
971 If you only want to save the current buffer but not point nor mark,
972 then just use `save-current-buffer', or even `with-current-buffer'.
974 usage: (save-excursion &rest BODY) */)
977 register Lisp_Object val
;
978 int count
= SPECPDL_INDEX ();
980 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
983 return unbind_to (count
, val
);
986 DEFUN ("save-current-buffer", Fsave_current_buffer
, Ssave_current_buffer
, 0, UNEVALLED
, 0,
987 doc
: /* Save the current buffer; execute BODY; restore the current buffer.
988 Executes BODY just like `progn'.
989 usage: (save-current-buffer &rest BODY) */)
993 int count
= SPECPDL_INDEX ();
995 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
998 return unbind_to (count
, val
);
1001 DEFUN ("buffer-size", Fbufsize
, Sbufsize
, 0, 1, 0,
1002 doc
: /* Return the number of characters in the current buffer.
1003 If BUFFER, return the number of characters in that buffer instead. */)
1004 (Lisp_Object buffer
)
1007 return make_number (Z
- BEG
);
1010 CHECK_BUFFER (buffer
);
1011 return make_number (BUF_Z (XBUFFER (buffer
))
1012 - BUF_BEG (XBUFFER (buffer
)));
1016 DEFUN ("point-min", Fpoint_min
, Spoint_min
, 0, 0, 0,
1017 doc
: /* Return the minimum permissible value of point in the current buffer.
1018 This is 1, unless narrowing (a buffer restriction) is in effect. */)
1022 XSETFASTINT (temp
, BEGV
);
1026 DEFUN ("point-min-marker", Fpoint_min_marker
, Spoint_min_marker
, 0, 0, 0,
1027 doc
: /* Return a marker to the minimum permissible value of point in this buffer.
1028 This is the beginning, unless narrowing (a buffer restriction) is in effect. */)
1031 return buildmark (BEGV
, BEGV_BYTE
);
1034 DEFUN ("point-max", Fpoint_max
, Spoint_max
, 0, 0, 0,
1035 doc
: /* Return the maximum permissible value of point in the current buffer.
1036 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
1037 is in effect, in which case it is less. */)
1041 XSETFASTINT (temp
, ZV
);
1045 DEFUN ("point-max-marker", Fpoint_max_marker
, Spoint_max_marker
, 0, 0, 0,
1046 doc
: /* Return a marker to the maximum permissible value of point in this buffer.
1047 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
1048 is in effect, in which case it is less. */)
1051 return buildmark (ZV
, ZV_BYTE
);
1054 DEFUN ("gap-position", Fgap_position
, Sgap_position
, 0, 0, 0,
1055 doc
: /* Return the position of the gap, in the current buffer.
1056 See also `gap-size'. */)
1060 XSETFASTINT (temp
, GPT
);
1064 DEFUN ("gap-size", Fgap_size
, Sgap_size
, 0, 0, 0,
1065 doc
: /* Return the size of the current buffer's gap.
1066 See also `gap-position'. */)
1070 XSETFASTINT (temp
, GAP_SIZE
);
1074 DEFUN ("position-bytes", Fposition_bytes
, Sposition_bytes
, 1, 1, 0,
1075 doc
: /* Return the byte position for character position POSITION.
1076 If POSITION is out of range, the value is nil. */)
1077 (Lisp_Object position
)
1079 CHECK_NUMBER_COERCE_MARKER (position
);
1080 if (XINT (position
) < BEG
|| XINT (position
) > Z
)
1082 return make_number (CHAR_TO_BYTE (XINT (position
)));
1085 DEFUN ("byte-to-position", Fbyte_to_position
, Sbyte_to_position
, 1, 1, 0,
1086 doc
: /* Return the character position for byte position BYTEPOS.
1087 If BYTEPOS is out of range, the value is nil. */)
1088 (Lisp_Object bytepos
)
1090 CHECK_NUMBER (bytepos
);
1091 if (XINT (bytepos
) < BEG_BYTE
|| XINT (bytepos
) > Z_BYTE
)
1093 return make_number (BYTE_TO_CHAR (XINT (bytepos
)));
1096 DEFUN ("following-char", Ffollowing_char
, Sfollowing_char
, 0, 0, 0,
1097 doc
: /* Return the character following point, as a number.
1098 At the end of the buffer or accessible region, return 0. */)
1103 XSETFASTINT (temp
, 0);
1105 XSETFASTINT (temp
, FETCH_CHAR (PT_BYTE
));
1109 DEFUN ("preceding-char", Fprevious_char
, Sprevious_char
, 0, 0, 0,
1110 doc
: /* Return the character preceding point, as a number.
1111 At the beginning of the buffer or accessible region, return 0. */)
1116 XSETFASTINT (temp
, 0);
1117 else if (!NILP (current_buffer
->enable_multibyte_characters
))
1119 EMACS_INT pos
= PT_BYTE
;
1121 XSETFASTINT (temp
, FETCH_CHAR (pos
));
1124 XSETFASTINT (temp
, FETCH_BYTE (PT_BYTE
- 1));
1128 DEFUN ("bobp", Fbobp
, Sbobp
, 0, 0, 0,
1129 doc
: /* Return t if point is at the beginning of the buffer.
1130 If the buffer is narrowed, this means the beginning of the narrowed part. */)
1138 DEFUN ("eobp", Feobp
, Seobp
, 0, 0, 0,
1139 doc
: /* Return t if point is at the end of the buffer.
1140 If the buffer is narrowed, this means the end of the narrowed part. */)
1148 DEFUN ("bolp", Fbolp
, Sbolp
, 0, 0, 0,
1149 doc
: /* Return t if point is at the beginning of a line. */)
1152 if (PT
== BEGV
|| FETCH_BYTE (PT_BYTE
- 1) == '\n')
1157 DEFUN ("eolp", Feolp
, Seolp
, 0, 0, 0,
1158 doc
: /* Return t if point is at the end of a line.
1159 `End of a line' includes point being at the end of the buffer. */)
1162 if (PT
== ZV
|| FETCH_BYTE (PT_BYTE
) == '\n')
1167 DEFUN ("char-after", Fchar_after
, Schar_after
, 0, 1, 0,
1168 doc
: /* Return character in current buffer at position POS.
1169 POS is an integer or a marker and defaults to point.
1170 If POS is out of range, the value is nil. */)
1173 register EMACS_INT pos_byte
;
1178 XSETFASTINT (pos
, PT
);
1183 pos_byte
= marker_byte_position (pos
);
1184 if (pos_byte
< BEGV_BYTE
|| pos_byte
>= ZV_BYTE
)
1189 CHECK_NUMBER_COERCE_MARKER (pos
);
1190 if (XINT (pos
) < BEGV
|| XINT (pos
) >= ZV
)
1193 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
1196 return make_number (FETCH_CHAR (pos_byte
));
1199 DEFUN ("char-before", Fchar_before
, Schar_before
, 0, 1, 0,
1200 doc
: /* Return character in current buffer preceding position POS.
1201 POS is an integer or a marker and defaults to point.
1202 If POS is out of range, the value is nil. */)
1205 register Lisp_Object val
;
1206 register EMACS_INT pos_byte
;
1211 XSETFASTINT (pos
, PT
);
1216 pos_byte
= marker_byte_position (pos
);
1218 if (pos_byte
<= BEGV_BYTE
|| pos_byte
> ZV_BYTE
)
1223 CHECK_NUMBER_COERCE_MARKER (pos
);
1225 if (XINT (pos
) <= BEGV
|| XINT (pos
) > ZV
)
1228 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
1231 if (!NILP (current_buffer
->enable_multibyte_characters
))
1234 XSETFASTINT (val
, FETCH_CHAR (pos_byte
));
1239 XSETFASTINT (val
, FETCH_BYTE (pos_byte
));
1244 DEFUN ("user-login-name", Fuser_login_name
, Suser_login_name
, 0, 1, 0,
1245 doc
: /* Return the name under which the user logged in, as a string.
1246 This is based on the effective uid, not the real uid.
1247 Also, if the environment variables LOGNAME or USER are set,
1248 that determines the value of this function.
1250 If optional argument UID is an integer or a float, return the login name
1251 of the user with that uid, or nil if there is no such user. */)
1257 /* Set up the user name info if we didn't do it before.
1258 (That can happen if Emacs is dumpable
1259 but you decide to run `temacs -l loadup' and not dump. */
1260 if (INTEGERP (Vuser_login_name
))
1264 return Vuser_login_name
;
1266 id
= (uid_t
)XFLOATINT (uid
);
1268 pw
= (struct passwd
*) getpwuid (id
);
1270 return (pw
? build_string (pw
->pw_name
) : Qnil
);
1273 DEFUN ("user-real-login-name", Fuser_real_login_name
, Suser_real_login_name
,
1275 doc
: /* Return the name of the user's real uid, as a string.
1276 This ignores the environment variables LOGNAME and USER, so it differs from
1277 `user-login-name' when running under `su'. */)
1280 /* Set up the user name info if we didn't do it before.
1281 (That can happen if Emacs is dumpable
1282 but you decide to run `temacs -l loadup' and not dump. */
1283 if (INTEGERP (Vuser_login_name
))
1285 return Vuser_real_login_name
;
1288 DEFUN ("user-uid", Fuser_uid
, Suser_uid
, 0, 0, 0,
1289 doc
: /* Return the effective uid of Emacs.
1290 Value is an integer or a float, depending on the value. */)
1293 /* Assignment to EMACS_INT stops GCC whining about limited range of
1295 EMACS_INT euid
= geteuid ();
1297 /* Make sure we don't produce a negative UID due to signed integer
1300 return make_float ((double)geteuid ());
1301 return make_fixnum_or_float (euid
);
1304 DEFUN ("user-real-uid", Fuser_real_uid
, Suser_real_uid
, 0, 0, 0,
1305 doc
: /* Return the real uid of Emacs.
1306 Value is an integer or a float, depending on the value. */)
1309 /* Assignment to EMACS_INT stops GCC whining about limited range of
1311 EMACS_INT uid
= getuid ();
1313 /* Make sure we don't produce a negative UID due to signed integer
1316 return make_float ((double)getuid ());
1317 return make_fixnum_or_float (uid
);
1320 DEFUN ("user-full-name", Fuser_full_name
, Suser_full_name
, 0, 1, 0,
1321 doc
: /* Return the full name of the user logged in, as a string.
1322 If the full name corresponding to Emacs's userid is not known,
1325 If optional argument UID is an integer or float, return the full name
1326 of the user with that uid, or nil if there is no such user.
1327 If UID is a string, return the full name of the user with that login
1328 name, or nil if there is no such user. */)
1332 register unsigned char *p
, *q
;
1336 return Vuser_full_name
;
1337 else if (NUMBERP (uid
))
1340 pw
= (struct passwd
*) getpwuid ((uid_t
) XFLOATINT (uid
));
1343 else if (STRINGP (uid
))
1346 pw
= (struct passwd
*) getpwnam (SSDATA (uid
));
1350 error ("Invalid UID specification");
1355 p
= (unsigned char *) USER_FULL_NAME
;
1356 /* Chop off everything after the first comma. */
1357 q
= (unsigned char *) strchr (p
, ',');
1358 full
= make_string (p
, q
? q
- p
: strlen (p
));
1360 #ifdef AMPERSAND_FULL_NAME
1362 q
= (unsigned char *) strchr (p
, '&');
1363 /* Substitute the login name for the &, upcasing the first character. */
1366 register unsigned char *r
;
1369 login
= Fuser_login_name (make_number (pw
->pw_uid
));
1370 r
= (unsigned char *) alloca (strlen (p
) + SCHARS (login
) + 1);
1371 memcpy (r
, p
, q
- p
);
1373 strcat (r
, SSDATA (login
));
1374 r
[q
- p
] = UPCASE (r
[q
- p
]);
1376 full
= build_string (r
);
1378 #endif /* AMPERSAND_FULL_NAME */
1383 DEFUN ("system-name", Fsystem_name
, Ssystem_name
, 0, 0, 0,
1384 doc
: /* Return the host name of the machine you are running on, as a string. */)
1387 return Vsystem_name
;
1390 /* For the benefit of callers who don't want to include lisp.h */
1393 get_system_name (void)
1395 if (STRINGP (Vsystem_name
))
1396 return SSDATA (Vsystem_name
);
1402 get_operating_system_release (void)
1404 if (STRINGP (Voperating_system_release
))
1405 return SSDATA (Voperating_system_release
);
1410 DEFUN ("emacs-pid", Femacs_pid
, Semacs_pid
, 0, 0, 0,
1411 doc
: /* Return the process ID of Emacs, as an integer. */)
1414 return make_number (getpid ());
1417 DEFUN ("current-time", Fcurrent_time
, Scurrent_time
, 0, 0, 0,
1418 doc
: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00.
1419 The time is returned as a list of three integers. The first has the
1420 most significant 16 bits of the seconds, while the second has the
1421 least significant 16 bits. The third integer gives the microsecond
1424 The microsecond count is zero on systems that do not provide
1425 resolution finer than a second. */)
1431 return list3 (make_number ((EMACS_SECS (t
) >> 16) & 0xffff),
1432 make_number ((EMACS_SECS (t
) >> 0) & 0xffff),
1433 make_number (EMACS_USECS (t
)));
1436 DEFUN ("get-internal-run-time", Fget_internal_run_time
, Sget_internal_run_time
,
1438 doc
: /* Return the current run time used by Emacs.
1439 The time is returned as a list of three integers. The first has the
1440 most significant 16 bits of the seconds, while the second has the
1441 least significant 16 bits. The third integer gives the microsecond
1444 On systems that can't determine the run time, `get-internal-run-time'
1445 does the same thing as `current-time'. The microsecond count is zero
1446 on systems that do not provide resolution finer than a second. */)
1449 #ifdef HAVE_GETRUSAGE
1450 struct rusage usage
;
1453 if (getrusage (RUSAGE_SELF
, &usage
) < 0)
1454 /* This shouldn't happen. What action is appropriate? */
1457 /* Sum up user time and system time. */
1458 secs
= usage
.ru_utime
.tv_sec
+ usage
.ru_stime
.tv_sec
;
1459 usecs
= usage
.ru_utime
.tv_usec
+ usage
.ru_stime
.tv_usec
;
1460 if (usecs
>= 1000000)
1466 return list3 (make_number ((secs
>> 16) & 0xffff),
1467 make_number ((secs
>> 0) & 0xffff),
1468 make_number (usecs
));
1469 #else /* ! HAVE_GETRUSAGE */
1471 return w32_get_internal_run_time ();
1472 #else /* ! WINDOWSNT */
1473 return Fcurrent_time ();
1474 #endif /* WINDOWSNT */
1475 #endif /* HAVE_GETRUSAGE */
1480 lisp_time_argument (Lisp_Object specified_time
, time_t *result
, int *usec
)
1482 if (NILP (specified_time
))
1489 *usec
= EMACS_USECS (t
);
1490 *result
= EMACS_SECS (t
);
1494 return time (result
) != -1;
1498 Lisp_Object high
, low
;
1499 high
= Fcar (specified_time
);
1500 CHECK_NUMBER (high
);
1501 low
= Fcdr (specified_time
);
1506 Lisp_Object usec_l
= Fcdr (low
);
1508 usec_l
= Fcar (usec_l
);
1513 CHECK_NUMBER (usec_l
);
1514 *usec
= XINT (usec_l
);
1522 *result
= (XINT (high
) << 16) + (XINT (low
) & 0xffff);
1523 return *result
>> 16 == XINT (high
);
1527 DEFUN ("float-time", Ffloat_time
, Sfloat_time
, 0, 1, 0,
1528 doc
: /* Return the current time, as a float number of seconds since the epoch.
1529 If SPECIFIED-TIME is given, it is the time to convert to float
1530 instead of the current time. The argument should have the form
1531 (HIGH LOW) or (HIGH LOW USEC). Thus, you can use times obtained from
1532 `current-time' and from `file-attributes'. SPECIFIED-TIME can also
1533 have the form (HIGH . LOW), but this is considered obsolete.
1535 WARNING: Since the result is floating point, it may not be exact.
1536 If precise time stamps are required, use either `current-time',
1537 or (if you need time as a string) `format-time-string'. */)
1538 (Lisp_Object specified_time
)
1543 if (! lisp_time_argument (specified_time
, &sec
, &usec
))
1544 error ("Invalid time specification");
1546 return make_float ((sec
* 1e6
+ usec
) / 1e6
);
1549 /* Write information into buffer S of size MAXSIZE, according to the
1550 FORMAT of length FORMAT_LEN, using time information taken from *TP.
1551 Default to Universal Time if UT is nonzero, local time otherwise.
1552 Return the number of bytes written, not including the terminating
1553 '\0'. If S is NULL, nothing will be written anywhere; so to
1554 determine how many bytes would be written, use NULL for S and
1555 ((size_t) -1) for MAXSIZE.
1557 This function behaves like nstrftime, except it allows null
1558 bytes in FORMAT and it does not support nanoseconds. */
1560 emacs_memftimeu (char *s
, size_t maxsize
, const char *format
, size_t format_len
, const struct tm
*tp
, int ut
)
1564 /* Loop through all the null-terminated strings in the format
1565 argument. Normally there's just one null-terminated string, but
1566 there can be arbitrarily many, concatenated together, if the
1567 format contains '\0' bytes. nstrftime stops at the first
1568 '\0' byte so we must invoke it separately for each such string. */
1577 result
= nstrftime (s
, maxsize
, format
, tp
, ut
, 0);
1581 if (result
== 0 && s
[0] != '\0')
1586 maxsize
-= result
+ 1;
1588 len
= strlen (format
);
1589 if (len
== format_len
)
1593 format_len
-= len
+ 1;
1597 DEFUN ("format-time-string", Fformat_time_string
, Sformat_time_string
, 1, 3, 0,
1598 doc
: /* Use FORMAT-STRING to format the time TIME, or now if omitted.
1599 TIME is specified as (HIGH LOW . IGNORED), as returned by
1600 `current-time' or `file-attributes'. The obsolete form (HIGH . LOW)
1601 is also still accepted.
1602 The third, optional, argument UNIVERSAL, if non-nil, means describe TIME
1603 as Universal Time; nil means describe TIME in the local time zone.
1604 The value is a copy of FORMAT-STRING, but with certain constructs replaced
1605 by text that describes the specified date and time in TIME:
1607 %Y is the year, %y within the century, %C the century.
1608 %G is the year corresponding to the ISO week, %g within the century.
1609 %m is the numeric month.
1610 %b and %h are the locale's abbreviated month name, %B the full name.
1611 %d is the day of the month, zero-padded, %e is blank-padded.
1612 %u is the numeric day of week from 1 (Monday) to 7, %w from 0 (Sunday) to 6.
1613 %a is the locale's abbreviated name of the day of week, %A the full name.
1614 %U is the week number starting on Sunday, %W starting on Monday,
1615 %V according to ISO 8601.
1616 %j is the day of the year.
1618 %H is the hour on a 24-hour clock, %I is on a 12-hour clock, %k is like %H
1619 only blank-padded, %l is like %I blank-padded.
1620 %p is the locale's equivalent of either AM or PM.
1623 %Z is the time zone name, %z is the numeric form.
1624 %s is the number of seconds since 1970-01-01 00:00:00 +0000.
1626 %c is the locale's date and time format.
1627 %x is the locale's "preferred" date format.
1628 %D is like "%m/%d/%y".
1630 %R is like "%H:%M", %T is like "%H:%M:%S", %r is like "%I:%M:%S %p".
1631 %X is the locale's "preferred" time format.
1633 Finally, %n is a newline, %t is a tab, %% is a literal %.
1635 Certain flags and modifiers are available with some format controls.
1636 The flags are `_', `-', `^' and `#'. For certain characters X,
1637 %_X is like %X, but padded with blanks; %-X is like %X,
1638 but without padding. %^X is like %X, but with all textual
1639 characters up-cased; %#X is like %X, but with letter-case of
1640 all textual characters reversed.
1641 %NX (where N stands for an integer) is like %X,
1642 but takes up at least N (a number) positions.
1643 The modifiers are `E' and `O'. For certain characters X,
1644 %EX is a locale's alternative version of %X;
1645 %OX is like %X, but uses the locale's number symbols.
1647 For example, to produce full ISO 8601 format, use "%Y-%m-%dT%T%z". */)
1648 (Lisp_Object format_string
, Lisp_Object time
, Lisp_Object universal
)
1653 int ut
= ! NILP (universal
);
1655 CHECK_STRING (format_string
);
1657 if (! lisp_time_argument (time
, &value
, NULL
))
1658 error ("Invalid time specification");
1660 format_string
= code_convert_string_norecord (format_string
,
1661 Vlocale_coding_system
, 1);
1663 /* This is probably enough. */
1664 size
= SBYTES (format_string
) * 6 + 50;
1667 tm
= ut
? gmtime (&value
) : localtime (&value
);
1670 error ("Specified time is not representable");
1672 synchronize_system_time_locale ();
1676 char *buf
= (char *) alloca (size
+ 1);
1681 result
= emacs_memftimeu (buf
, size
, SSDATA (format_string
),
1682 SBYTES (format_string
),
1685 if ((result
> 0 && result
< size
) || (result
== 0 && buf
[0] == '\0'))
1686 return code_convert_string_norecord (make_unibyte_string (buf
, result
),
1687 Vlocale_coding_system
, 0);
1689 /* If buffer was too small, make it bigger and try again. */
1691 result
= emacs_memftimeu (NULL
, (size_t) -1,
1692 SSDATA (format_string
),
1693 SBYTES (format_string
),
1700 DEFUN ("decode-time", Fdecode_time
, Sdecode_time
, 0, 1, 0,
1701 doc
: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).
1702 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED),
1703 as from `current-time' and `file-attributes', or nil to use the
1704 current time. The obsolete form (HIGH . LOW) is also still accepted.
1705 The list has the following nine members: SEC is an integer between 0
1706 and 60; SEC is 60 for a leap second, which only some operating systems
1707 support. MINUTE is an integer between 0 and 59. HOUR is an integer
1708 between 0 and 23. DAY is an integer between 1 and 31. MONTH is an
1709 integer between 1 and 12. YEAR is an integer indicating the
1710 four-digit year. DOW is the day of week, an integer between 0 and 6,
1711 where 0 is Sunday. DST is t if daylight saving time is in effect,
1712 otherwise nil. ZONE is an integer indicating the number of seconds
1713 east of Greenwich. (Note that Common Lisp has different meanings for
1715 (Lisp_Object specified_time
)
1719 struct tm
*decoded_time
;
1720 Lisp_Object list_args
[9];
1722 if (! lisp_time_argument (specified_time
, &time_spec
, NULL
))
1723 error ("Invalid time specification");
1726 decoded_time
= localtime (&time_spec
);
1729 error ("Specified time is not representable");
1730 XSETFASTINT (list_args
[0], decoded_time
->tm_sec
);
1731 XSETFASTINT (list_args
[1], decoded_time
->tm_min
);
1732 XSETFASTINT (list_args
[2], decoded_time
->tm_hour
);
1733 XSETFASTINT (list_args
[3], decoded_time
->tm_mday
);
1734 XSETFASTINT (list_args
[4], decoded_time
->tm_mon
+ 1);
1735 /* On 64-bit machines an int is narrower than EMACS_INT, thus the
1736 cast below avoids overflow in int arithmetics. */
1737 XSETINT (list_args
[5], TM_YEAR_BASE
+ (EMACS_INT
) decoded_time
->tm_year
);
1738 XSETFASTINT (list_args
[6], decoded_time
->tm_wday
);
1739 list_args
[7] = (decoded_time
->tm_isdst
)? Qt
: Qnil
;
1741 /* Make a copy, in case gmtime modifies the struct. */
1742 save_tm
= *decoded_time
;
1744 decoded_time
= gmtime (&time_spec
);
1746 if (decoded_time
== 0)
1747 list_args
[8] = Qnil
;
1749 XSETINT (list_args
[8], tm_diff (&save_tm
, decoded_time
));
1750 return Flist (9, list_args
);
1753 DEFUN ("encode-time", Fencode_time
, Sencode_time
, 6, MANY
, 0,
1754 doc
: /* Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
1755 This is the reverse operation of `decode-time', which see.
1756 ZONE defaults to the current time zone rule. This can
1757 be a string or t (as from `set-time-zone-rule'), or it can be a list
1758 \(as from `current-time-zone') or an integer (as from `decode-time')
1759 applied without consideration for daylight saving time.
1761 You can pass more than 7 arguments; then the first six arguments
1762 are used as SECOND through YEAR, and the *last* argument is used as ZONE.
1763 The intervening arguments are ignored.
1764 This feature lets (apply 'encode-time (decode-time ...)) work.
1766 Out-of-range values for SECOND, MINUTE, HOUR, DAY, or MONTH are allowed;
1767 for example, a DAY of 0 means the day preceding the given month.
1768 Year numbers less than 100 are treated just like other year numbers.
1769 If you want them to stand for years in this century, you must do that yourself.
1771 Years before 1970 are not guaranteed to work. On some systems,
1772 year values as low as 1901 do work.
1774 usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */)
1775 (int nargs
, register Lisp_Object
*args
)
1779 Lisp_Object zone
= (nargs
> 6 ? args
[nargs
- 1] : Qnil
);
1781 CHECK_NUMBER (args
[0]); /* second */
1782 CHECK_NUMBER (args
[1]); /* minute */
1783 CHECK_NUMBER (args
[2]); /* hour */
1784 CHECK_NUMBER (args
[3]); /* day */
1785 CHECK_NUMBER (args
[4]); /* month */
1786 CHECK_NUMBER (args
[5]); /* year */
1788 tm
.tm_sec
= XINT (args
[0]);
1789 tm
.tm_min
= XINT (args
[1]);
1790 tm
.tm_hour
= XINT (args
[2]);
1791 tm
.tm_mday
= XINT (args
[3]);
1792 tm
.tm_mon
= XINT (args
[4]) - 1;
1793 tm
.tm_year
= XINT (args
[5]) - TM_YEAR_BASE
;
1801 time
= mktime (&tm
);
1807 const char *tzstring
;
1808 char **oldenv
= environ
, **newenv
;
1812 else if (STRINGP (zone
))
1813 tzstring
= SSDATA (zone
);
1814 else if (INTEGERP (zone
))
1816 int abszone
= eabs (XINT (zone
));
1817 sprintf (tzbuf
, "XXX%s%d:%02d:%02d", "-" + (XINT (zone
) < 0),
1818 abszone
/ (60*60), (abszone
/60) % 60, abszone
% 60);
1822 error ("Invalid time zone specification");
1824 /* Set TZ before calling mktime; merely adjusting mktime's returned
1825 value doesn't suffice, since that would mishandle leap seconds. */
1826 set_time_zone_rule (tzstring
);
1829 time
= mktime (&tm
);
1832 /* Restore TZ to previous value. */
1836 #ifdef LOCALTIME_CACHE
1841 if (time
== (time_t) -1)
1842 error ("Specified time is not representable");
1844 return make_time (time
);
1847 DEFUN ("current-time-string", Fcurrent_time_string
, Scurrent_time_string
, 0, 1, 0,
1848 doc
: /* Return the current local time, as a human-readable string.
1849 Programs can use this function to decode a time,
1850 since the number of columns in each field is fixed
1851 if the year is in the range 1000-9999.
1852 The format is `Sun Sep 16 01:03:52 1973'.
1853 However, see also the functions `decode-time' and `format-time-string'
1854 which provide a much more powerful and general facility.
1856 If SPECIFIED-TIME is given, it is a time to format instead of the
1857 current time. The argument should have the form (HIGH LOW . IGNORED).
1858 Thus, you can use times obtained from `current-time' and from
1859 `file-attributes'. SPECIFIED-TIME can also have the form (HIGH . LOW),
1860 but this is considered obsolete. */)
1861 (Lisp_Object specified_time
)
1867 if (! lisp_time_argument (specified_time
, &value
, NULL
))
1868 error ("Invalid time specification");
1870 /* Convert to a string, checking for out-of-range time stamps.
1871 Don't use 'ctime', as that might dump core if VALUE is out of
1874 tm
= localtime (&value
);
1876 if (! (tm
&& TM_YEAR_IN_ASCTIME_RANGE (tm
->tm_year
) && (tem
= asctime (tm
))))
1877 error ("Specified time is not representable");
1879 /* Remove the trailing newline. */
1880 tem
[strlen (tem
) - 1] = '\0';
1882 return build_string (tem
);
1885 /* Yield A - B, measured in seconds.
1886 This function is copied from the GNU C Library. */
1888 tm_diff (struct tm
*a
, struct tm
*b
)
1890 /* Compute intervening leap days correctly even if year is negative.
1891 Take care to avoid int overflow in leap day calculations,
1892 but it's OK to assume that A and B are close to each other. */
1893 int a4
= (a
->tm_year
>> 2) + (TM_YEAR_BASE
>> 2) - ! (a
->tm_year
& 3);
1894 int b4
= (b
->tm_year
>> 2) + (TM_YEAR_BASE
>> 2) - ! (b
->tm_year
& 3);
1895 int a100
= a4
/ 25 - (a4
% 25 < 0);
1896 int b100
= b4
/ 25 - (b4
% 25 < 0);
1897 int a400
= a100
>> 2;
1898 int b400
= b100
>> 2;
1899 int intervening_leap_days
= (a4
- b4
) - (a100
- b100
) + (a400
- b400
);
1900 int years
= a
->tm_year
- b
->tm_year
;
1901 int days
= (365 * years
+ intervening_leap_days
1902 + (a
->tm_yday
- b
->tm_yday
));
1903 return (60 * (60 * (24 * days
+ (a
->tm_hour
- b
->tm_hour
))
1904 + (a
->tm_min
- b
->tm_min
))
1905 + (a
->tm_sec
- b
->tm_sec
));
1908 DEFUN ("current-time-zone", Fcurrent_time_zone
, Scurrent_time_zone
, 0, 1, 0,
1909 doc
: /* Return the offset and name for the local time zone.
1910 This returns a list of the form (OFFSET NAME).
1911 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
1912 A negative value means west of Greenwich.
1913 NAME is a string giving the name of the time zone.
1914 If SPECIFIED-TIME is given, the time zone offset is determined from it
1915 instead of using the current time. The argument should have the form
1916 (HIGH LOW . IGNORED). Thus, you can use times obtained from
1917 `current-time' and from `file-attributes'. SPECIFIED-TIME can also
1918 have the form (HIGH . LOW), but this is considered obsolete.
1920 Some operating systems cannot provide all this information to Emacs;
1921 in this case, `current-time-zone' returns a list containing nil for
1922 the data it can't find. */)
1923 (Lisp_Object specified_time
)
1929 if (!lisp_time_argument (specified_time
, &value
, NULL
))
1934 t
= gmtime (&value
);
1938 t
= localtime (&value
);
1945 int offset
= tm_diff (t
, &gmt
);
1951 s
= (char *)t
->tm_zone
;
1952 #else /* not HAVE_TM_ZONE */
1954 if (t
->tm_isdst
== 0 || t
->tm_isdst
== 1)
1955 s
= tzname
[t
->tm_isdst
];
1957 #endif /* not HAVE_TM_ZONE */
1961 /* No local time zone name is available; use "+-NNNN" instead. */
1962 int am
= (offset
< 0 ? -offset
: offset
) / 60;
1963 sprintf (buf
, "%c%02d%02d", (offset
< 0 ? '-' : '+'), am
/60, am
%60);
1967 return Fcons (make_number (offset
), Fcons (build_string (s
), Qnil
));
1970 return Fmake_list (make_number (2), Qnil
);
1973 /* This holds the value of `environ' produced by the previous
1974 call to Fset_time_zone_rule, or 0 if Fset_time_zone_rule
1975 has never been called. */
1976 static char **environbuf
;
1978 /* This holds the startup value of the TZ environment variable so it
1979 can be restored if the user calls set-time-zone-rule with a nil
1981 static char *initial_tz
;
1983 DEFUN ("set-time-zone-rule", Fset_time_zone_rule
, Sset_time_zone_rule
, 1, 1, 0,
1984 doc
: /* Set the local time zone using TZ, a string specifying a time zone rule.
1985 If TZ is nil, use implementation-defined default time zone information.
1986 If TZ is t, use Universal Time. */)
1989 const char *tzstring
;
1991 /* When called for the first time, save the original TZ. */
1993 initial_tz
= (char *) getenv ("TZ");
1996 tzstring
= initial_tz
;
1997 else if (EQ (tz
, Qt
))
2002 tzstring
= SSDATA (tz
);
2005 set_time_zone_rule (tzstring
);
2007 environbuf
= environ
;
2012 #ifdef LOCALTIME_CACHE
2014 /* These two values are known to load tz files in buggy implementations,
2015 i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2.
2016 Their values shouldn't matter in non-buggy implementations.
2017 We don't use string literals for these strings,
2018 since if a string in the environment is in readonly
2019 storage, it runs afoul of bugs in SVR4 and Solaris 2.3.
2020 See Sun bugs 1113095 and 1114114, ``Timezone routines
2021 improperly modify environment''. */
2023 static char set_time_zone_rule_tz1
[] = "TZ=GMT+0";
2024 static char set_time_zone_rule_tz2
[] = "TZ=GMT+1";
2028 /* Set the local time zone rule to TZSTRING.
2029 This allocates memory into `environ', which it is the caller's
2030 responsibility to free. */
2033 set_time_zone_rule (const char *tzstring
)
2036 char **from
, **to
, **newenv
;
2038 /* Make the ENVIRON vector longer with room for TZSTRING. */
2039 for (from
= environ
; *from
; from
++)
2041 envptrs
= from
- environ
+ 2;
2042 newenv
= to
= (char **) xmalloc (envptrs
* sizeof (char *)
2043 + (tzstring
? strlen (tzstring
) + 4 : 0));
2045 /* Add TZSTRING to the end of environ, as a value for TZ. */
2048 char *t
= (char *) (to
+ envptrs
);
2050 strcat (t
, tzstring
);
2054 /* Copy the old environ vector elements into NEWENV,
2055 but don't copy the TZ variable.
2056 So we have only one definition of TZ, which came from TZSTRING. */
2057 for (from
= environ
; *from
; from
++)
2058 if (strncmp (*from
, "TZ=", 3) != 0)
2064 /* If we do have a TZSTRING, NEWENV points to the vector slot where
2065 the TZ variable is stored. If we do not have a TZSTRING,
2066 TO points to the vector slot which has the terminating null. */
2068 #ifdef LOCALTIME_CACHE
2070 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like
2071 "US/Pacific" that loads a tz file, then changes to a value like
2072 "XXX0" that does not load a tz file, and then changes back to
2073 its original value, the last change is (incorrectly) ignored.
2074 Also, if TZ changes twice in succession to values that do
2075 not load a tz file, tzset can dump core (see Sun bug#1225179).
2076 The following code works around these bugs. */
2080 /* Temporarily set TZ to a value that loads a tz file
2081 and that differs from tzstring. */
2083 *newenv
= (strcmp (tzstring
, set_time_zone_rule_tz1
+ 3) == 0
2084 ? set_time_zone_rule_tz2
: set_time_zone_rule_tz1
);
2090 /* The implied tzstring is unknown, so temporarily set TZ to
2091 two different values that each load a tz file. */
2092 *to
= set_time_zone_rule_tz1
;
2095 *to
= set_time_zone_rule_tz2
;
2100 /* Now TZ has the desired value, and tzset can be invoked safely. */
2107 /* Insert NARGS Lisp objects in the array ARGS by calling INSERT_FUNC
2108 (if a type of object is Lisp_Int) or INSERT_FROM_STRING_FUNC (if a
2109 type of object is Lisp_String). INHERIT is passed to
2110 INSERT_FROM_STRING_FUNC as the last argument. */
2113 general_insert_function (void (*insert_func
)
2114 (const unsigned char *, EMACS_INT
),
2115 void (*insert_from_string_func
)
2116 (Lisp_Object
, EMACS_INT
, EMACS_INT
,
2117 EMACS_INT
, EMACS_INT
, int),
2118 int inherit
, int nargs
, Lisp_Object
*args
)
2120 register int argnum
;
2121 register Lisp_Object val
;
2123 for (argnum
= 0; argnum
< nargs
; argnum
++)
2126 if (CHARACTERP (val
))
2128 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
2131 if (!NILP (current_buffer
->enable_multibyte_characters
))
2132 len
= CHAR_STRING (XFASTINT (val
), str
);
2135 str
[0] = (ASCII_CHAR_P (XINT (val
))
2137 : multibyte_char_to_unibyte (XINT (val
), Qnil
));
2140 (*insert_func
) (str
, len
);
2142 else if (STRINGP (val
))
2144 (*insert_from_string_func
) (val
, 0, 0,
2150 wrong_type_argument (Qchar_or_string_p
, val
);
2155 insert1 (Lisp_Object arg
)
2161 /* Callers passing one argument to Finsert need not gcpro the
2162 argument "array", since the only element of the array will
2163 not be used after calling insert or insert_from_string, so
2164 we don't care if it gets trashed. */
2166 DEFUN ("insert", Finsert
, Sinsert
, 0, MANY
, 0,
2167 doc
: /* Insert the arguments, either strings or characters, at point.
2168 Point and before-insertion markers move forward to end up
2169 after the inserted text.
2170 Any other markers at the point of insertion remain before the text.
2172 If the current buffer is multibyte, unibyte strings are converted
2173 to multibyte for insertion (see `string-make-multibyte').
2174 If the current buffer is unibyte, multibyte strings are converted
2175 to unibyte for insertion (see `string-make-unibyte').
2177 When operating on binary data, it may be necessary to preserve the
2178 original bytes of a unibyte string when inserting it into a multibyte
2179 buffer; to accomplish this, apply `string-as-multibyte' to the string
2180 and insert the result.
2182 usage: (insert &rest ARGS) */)
2183 (int nargs
, register Lisp_Object
*args
)
2185 general_insert_function (insert
, insert_from_string
, 0, nargs
, args
);
2189 DEFUN ("insert-and-inherit", Finsert_and_inherit
, Sinsert_and_inherit
,
2191 doc
: /* Insert the arguments at point, inheriting properties from adjoining text.
2192 Point and before-insertion markers move forward to end up
2193 after the inserted text.
2194 Any other markers at the point of insertion remain before the text.
2196 If the current buffer is multibyte, unibyte strings are converted
2197 to multibyte for insertion (see `unibyte-char-to-multibyte').
2198 If the current buffer is unibyte, multibyte strings are converted
2199 to unibyte for insertion.
2201 usage: (insert-and-inherit &rest ARGS) */)
2202 (int nargs
, register Lisp_Object
*args
)
2204 general_insert_function (insert_and_inherit
, insert_from_string
, 1,
2209 DEFUN ("insert-before-markers", Finsert_before_markers
, Sinsert_before_markers
, 0, MANY
, 0,
2210 doc
: /* Insert strings or characters at point, relocating markers after the text.
2211 Point and markers move forward to end up after the inserted text.
2213 If the current buffer is multibyte, unibyte strings are converted
2214 to multibyte for insertion (see `unibyte-char-to-multibyte').
2215 If the current buffer is unibyte, multibyte strings are converted
2216 to unibyte for insertion.
2218 usage: (insert-before-markers &rest ARGS) */)
2219 (int nargs
, register Lisp_Object
*args
)
2221 general_insert_function (insert_before_markers
,
2222 insert_from_string_before_markers
, 0,
2227 DEFUN ("insert-before-markers-and-inherit", Finsert_and_inherit_before_markers
,
2228 Sinsert_and_inherit_before_markers
, 0, MANY
, 0,
2229 doc
: /* Insert text at point, relocating markers and inheriting properties.
2230 Point and markers move forward to end up after the inserted text.
2232 If the current buffer is multibyte, unibyte strings are converted
2233 to multibyte for insertion (see `unibyte-char-to-multibyte').
2234 If the current buffer is unibyte, multibyte strings are converted
2235 to unibyte for insertion.
2237 usage: (insert-before-markers-and-inherit &rest ARGS) */)
2238 (int nargs
, register Lisp_Object
*args
)
2240 general_insert_function (insert_before_markers_and_inherit
,
2241 insert_from_string_before_markers
, 1,
2246 DEFUN ("insert-char", Finsert_char
, Sinsert_char
, 2, 3, 0,
2247 doc
: /* Insert COUNT copies of CHARACTER.
2248 Point, and before-insertion markers, are relocated as in the function `insert'.
2249 The optional third arg INHERIT, if non-nil, says to inherit text properties
2250 from adjoining text, if those properties are sticky. */)
2251 (Lisp_Object character
, Lisp_Object count
, Lisp_Object inherit
)
2253 register unsigned char *string
;
2254 register EMACS_INT strlen
;
2256 register EMACS_INT n
;
2258 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
2260 CHECK_NUMBER (character
);
2261 CHECK_NUMBER (count
);
2263 if (!NILP (current_buffer
->enable_multibyte_characters
))
2264 len
= CHAR_STRING (XFASTINT (character
), str
);
2266 str
[0] = XFASTINT (character
), len
= 1;
2267 if (MOST_POSITIVE_FIXNUM
/ len
< XINT (count
))
2268 error ("Maximum buffer size would be exceeded");
2269 n
= XINT (count
) * len
;
2272 strlen
= min (n
, 256 * len
);
2273 string
= (unsigned char *) alloca (strlen
);
2274 for (i
= 0; i
< strlen
; i
++)
2275 string
[i
] = str
[i
% len
];
2279 if (!NILP (inherit
))
2280 insert_and_inherit (string
, strlen
);
2282 insert (string
, strlen
);
2287 if (!NILP (inherit
))
2288 insert_and_inherit (string
, n
);
2295 DEFUN ("insert-byte", Finsert_byte
, Sinsert_byte
, 2, 3, 0,
2296 doc
: /* Insert COUNT (second arg) copies of BYTE (first arg).
2297 Both arguments are required.
2298 BYTE is a number of the range 0..255.
2300 If BYTE is 128..255 and the current buffer is multibyte, the
2301 corresponding eight-bit character is inserted.
2303 Point, and before-insertion markers, are relocated as in the function `insert'.
2304 The optional third arg INHERIT, if non-nil, says to inherit text properties
2305 from adjoining text, if those properties are sticky. */)
2306 (Lisp_Object byte
, Lisp_Object count
, Lisp_Object inherit
)
2308 CHECK_NUMBER (byte
);
2309 if (XINT (byte
) < 0 || XINT (byte
) > 255)
2310 args_out_of_range_3 (byte
, make_number (0), make_number (255));
2311 if (XINT (byte
) >= 128
2312 && ! NILP (current_buffer
->enable_multibyte_characters
))
2313 XSETFASTINT (byte
, BYTE8_TO_CHAR (XINT (byte
)));
2314 return Finsert_char (byte
, count
, inherit
);
2318 /* Making strings from buffer contents. */
2320 /* Return a Lisp_String containing the text of the current buffer from
2321 START to END. If text properties are in use and the current buffer
2322 has properties in the range specified, the resulting string will also
2323 have them, if PROPS is nonzero.
2325 We don't want to use plain old make_string here, because it calls
2326 make_uninit_string, which can cause the buffer arena to be
2327 compacted. make_string has no way of knowing that the data has
2328 been moved, and thus copies the wrong data into the string. This
2329 doesn't effect most of the other users of make_string, so it should
2330 be left as is. But we should use this function when conjuring
2331 buffer substrings. */
2334 make_buffer_string (EMACS_INT start
, EMACS_INT end
, int props
)
2336 EMACS_INT start_byte
= CHAR_TO_BYTE (start
);
2337 EMACS_INT end_byte
= CHAR_TO_BYTE (end
);
2339 return make_buffer_string_both (start
, start_byte
, end
, end_byte
, props
);
2342 /* Return a Lisp_String containing the text of the current buffer from
2343 START / START_BYTE to END / END_BYTE.
2345 If text properties are in use and the current buffer
2346 has properties in the range specified, the resulting string will also
2347 have them, if PROPS is nonzero.
2349 We don't want to use plain old make_string here, because it calls
2350 make_uninit_string, which can cause the buffer arena to be
2351 compacted. make_string has no way of knowing that the data has
2352 been moved, and thus copies the wrong data into the string. This
2353 doesn't effect most of the other users of make_string, so it should
2354 be left as is. But we should use this function when conjuring
2355 buffer substrings. */
2358 make_buffer_string_both (EMACS_INT start
, EMACS_INT start_byte
,
2359 EMACS_INT end
, EMACS_INT end_byte
, int props
)
2361 Lisp_Object result
, tem
, tem1
;
2363 if (start
< GPT
&& GPT
< end
)
2366 if (! NILP (current_buffer
->enable_multibyte_characters
))
2367 result
= make_uninit_multibyte_string (end
- start
, end_byte
- start_byte
);
2369 result
= make_uninit_string (end
- start
);
2370 memcpy (SDATA (result
), BYTE_POS_ADDR (start_byte
), end_byte
- start_byte
);
2372 /* If desired, update and copy the text properties. */
2375 update_buffer_properties (start
, end
);
2377 tem
= Fnext_property_change (make_number (start
), Qnil
, make_number (end
));
2378 tem1
= Ftext_properties_at (make_number (start
), Qnil
);
2380 if (XINT (tem
) != end
|| !NILP (tem1
))
2381 copy_intervals_to_string (result
, current_buffer
, start
,
2388 /* Call Vbuffer_access_fontify_functions for the range START ... END
2389 in the current buffer, if necessary. */
2392 update_buffer_properties (EMACS_INT start
, EMACS_INT end
)
2394 /* If this buffer has some access functions,
2395 call them, specifying the range of the buffer being accessed. */
2396 if (!NILP (Vbuffer_access_fontify_functions
))
2398 Lisp_Object args
[3];
2401 args
[0] = Qbuffer_access_fontify_functions
;
2402 XSETINT (args
[1], start
);
2403 XSETINT (args
[2], end
);
2405 /* But don't call them if we can tell that the work
2406 has already been done. */
2407 if (!NILP (Vbuffer_access_fontified_property
))
2409 tem
= Ftext_property_any (args
[1], args
[2],
2410 Vbuffer_access_fontified_property
,
2413 Frun_hook_with_args (3, args
);
2416 Frun_hook_with_args (3, args
);
2420 DEFUN ("buffer-substring", Fbuffer_substring
, Sbuffer_substring
, 2, 2, 0,
2421 doc
: /* Return the contents of part of the current buffer as a string.
2422 The two arguments START and END are character positions;
2423 they can be in either order.
2424 The string returned is multibyte if the buffer is multibyte.
2426 This function copies the text properties of that part of the buffer
2427 into the result string; if you don't want the text properties,
2428 use `buffer-substring-no-properties' instead. */)
2429 (Lisp_Object start
, Lisp_Object end
)
2431 register EMACS_INT b
, e
;
2433 validate_region (&start
, &end
);
2437 return make_buffer_string (b
, e
, 1);
2440 DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties
,
2441 Sbuffer_substring_no_properties
, 2, 2, 0,
2442 doc
: /* Return the characters of part of the buffer, without the text properties.
2443 The two arguments START and END are character positions;
2444 they can be in either order. */)
2445 (Lisp_Object start
, Lisp_Object end
)
2447 register EMACS_INT b
, e
;
2449 validate_region (&start
, &end
);
2453 return make_buffer_string (b
, e
, 0);
2456 DEFUN ("buffer-string", Fbuffer_string
, Sbuffer_string
, 0, 0, 0,
2457 doc
: /* Return the contents of the current buffer as a string.
2458 If narrowing is in effect, this function returns only the visible part
2462 return make_buffer_string (BEGV
, ZV
, 1);
2465 DEFUN ("insert-buffer-substring", Finsert_buffer_substring
, Sinsert_buffer_substring
,
2467 doc
: /* Insert before point a substring of the contents of BUFFER.
2468 BUFFER may be a buffer or a buffer name.
2469 Arguments START and END are character positions specifying the substring.
2470 They default to the values of (point-min) and (point-max) in BUFFER. */)
2471 (Lisp_Object buffer
, Lisp_Object start
, Lisp_Object end
)
2473 register EMACS_INT b
, e
, temp
;
2474 register struct buffer
*bp
, *obuf
;
2477 buf
= Fget_buffer (buffer
);
2481 if (NILP (bp
->name
))
2482 error ("Selecting deleted buffer");
2488 CHECK_NUMBER_COERCE_MARKER (start
);
2495 CHECK_NUMBER_COERCE_MARKER (end
);
2500 temp
= b
, b
= e
, e
= temp
;
2502 if (!(BUF_BEGV (bp
) <= b
&& e
<= BUF_ZV (bp
)))
2503 args_out_of_range (start
, end
);
2505 obuf
= current_buffer
;
2506 set_buffer_internal_1 (bp
);
2507 update_buffer_properties (b
, e
);
2508 set_buffer_internal_1 (obuf
);
2510 insert_from_buffer (bp
, b
, e
- b
, 0);
2514 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings
, Scompare_buffer_substrings
,
2516 doc
: /* Compare two substrings of two buffers; return result as number.
2517 the value is -N if first string is less after N-1 chars,
2518 +N if first string is greater after N-1 chars, or 0 if strings match.
2519 Each substring is represented as three arguments: BUFFER, START and END.
2520 That makes six args in all, three for each substring.
2522 The value of `case-fold-search' in the current buffer
2523 determines whether case is significant or ignored. */)
2524 (Lisp_Object buffer1
, Lisp_Object start1
, Lisp_Object end1
, Lisp_Object buffer2
, Lisp_Object start2
, Lisp_Object end2
)
2526 register EMACS_INT begp1
, endp1
, begp2
, endp2
, temp
;
2527 register struct buffer
*bp1
, *bp2
;
2528 register Lisp_Object trt
2529 = (!NILP (current_buffer
->case_fold_search
)
2530 ? current_buffer
->case_canon_table
: Qnil
);
2531 EMACS_INT chars
= 0;
2532 EMACS_INT i1
, i2
, i1_byte
, i2_byte
;
2534 /* Find the first buffer and its substring. */
2537 bp1
= current_buffer
;
2541 buf1
= Fget_buffer (buffer1
);
2544 bp1
= XBUFFER (buf1
);
2545 if (NILP (bp1
->name
))
2546 error ("Selecting deleted buffer");
2550 begp1
= BUF_BEGV (bp1
);
2553 CHECK_NUMBER_COERCE_MARKER (start1
);
2554 begp1
= XINT (start1
);
2557 endp1
= BUF_ZV (bp1
);
2560 CHECK_NUMBER_COERCE_MARKER (end1
);
2561 endp1
= XINT (end1
);
2565 temp
= begp1
, begp1
= endp1
, endp1
= temp
;
2567 if (!(BUF_BEGV (bp1
) <= begp1
2569 && endp1
<= BUF_ZV (bp1
)))
2570 args_out_of_range (start1
, end1
);
2572 /* Likewise for second substring. */
2575 bp2
= current_buffer
;
2579 buf2
= Fget_buffer (buffer2
);
2582 bp2
= XBUFFER (buf2
);
2583 if (NILP (bp2
->name
))
2584 error ("Selecting deleted buffer");
2588 begp2
= BUF_BEGV (bp2
);
2591 CHECK_NUMBER_COERCE_MARKER (start2
);
2592 begp2
= XINT (start2
);
2595 endp2
= BUF_ZV (bp2
);
2598 CHECK_NUMBER_COERCE_MARKER (end2
);
2599 endp2
= XINT (end2
);
2603 temp
= begp2
, begp2
= endp2
, endp2
= temp
;
2605 if (!(BUF_BEGV (bp2
) <= begp2
2607 && endp2
<= BUF_ZV (bp2
)))
2608 args_out_of_range (start2
, end2
);
2612 i1_byte
= buf_charpos_to_bytepos (bp1
, i1
);
2613 i2_byte
= buf_charpos_to_bytepos (bp2
, i2
);
2615 while (i1
< endp1
&& i2
< endp2
)
2617 /* When we find a mismatch, we must compare the
2618 characters, not just the bytes. */
2623 if (! NILP (bp1
->enable_multibyte_characters
))
2625 c1
= BUF_FETCH_MULTIBYTE_CHAR (bp1
, i1_byte
);
2626 BUF_INC_POS (bp1
, i1_byte
);
2631 c1
= BUF_FETCH_BYTE (bp1
, i1
);
2632 MAKE_CHAR_MULTIBYTE (c1
);
2636 if (! NILP (bp2
->enable_multibyte_characters
))
2638 c2
= BUF_FETCH_MULTIBYTE_CHAR (bp2
, i2_byte
);
2639 BUF_INC_POS (bp2
, i2_byte
);
2644 c2
= BUF_FETCH_BYTE (bp2
, i2
);
2645 MAKE_CHAR_MULTIBYTE (c2
);
2651 c1
= CHAR_TABLE_TRANSLATE (trt
, c1
);
2652 c2
= CHAR_TABLE_TRANSLATE (trt
, c2
);
2655 return make_number (- 1 - chars
);
2657 return make_number (chars
+ 1);
2662 /* The strings match as far as they go.
2663 If one is shorter, that one is less. */
2664 if (chars
< endp1
- begp1
)
2665 return make_number (chars
+ 1);
2666 else if (chars
< endp2
- begp2
)
2667 return make_number (- chars
- 1);
2669 /* Same length too => they are equal. */
2670 return make_number (0);
2674 subst_char_in_region_unwind (Lisp_Object arg
)
2676 return current_buffer
->undo_list
= arg
;
2680 subst_char_in_region_unwind_1 (Lisp_Object arg
)
2682 return current_buffer
->filename
= arg
;
2685 DEFUN ("subst-char-in-region", Fsubst_char_in_region
,
2686 Ssubst_char_in_region
, 4, 5, 0,
2687 doc
: /* From START to END, replace FROMCHAR with TOCHAR each time it occurs.
2688 If optional arg NOUNDO is non-nil, don't record this change for undo
2689 and don't mark the buffer as really changed.
2690 Both characters must have the same length of multi-byte form. */)
2691 (Lisp_Object start
, Lisp_Object end
, Lisp_Object fromchar
, Lisp_Object tochar
, Lisp_Object noundo
)
2693 register EMACS_INT pos
, pos_byte
, stop
, i
, len
, end_byte
;
2694 /* Keep track of the first change in the buffer:
2695 if 0 we haven't found it yet.
2696 if < 0 we've found it and we've run the before-change-function.
2697 if > 0 we've actually performed it and the value is its position. */
2698 EMACS_INT changed
= 0;
2699 unsigned char fromstr
[MAX_MULTIBYTE_LENGTH
], tostr
[MAX_MULTIBYTE_LENGTH
];
2701 int count
= SPECPDL_INDEX ();
2702 #define COMBINING_NO 0
2703 #define COMBINING_BEFORE 1
2704 #define COMBINING_AFTER 2
2705 #define COMBINING_BOTH (COMBINING_BEFORE | COMBINING_AFTER)
2706 int maybe_byte_combining
= COMBINING_NO
;
2707 EMACS_INT last_changed
= 0;
2708 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
2712 validate_region (&start
, &end
);
2713 CHECK_NUMBER (fromchar
);
2714 CHECK_NUMBER (tochar
);
2718 len
= CHAR_STRING (XFASTINT (fromchar
), fromstr
);
2719 if (CHAR_STRING (XFASTINT (tochar
), tostr
) != len
)
2720 error ("Characters in `subst-char-in-region' have different byte-lengths");
2721 if (!ASCII_BYTE_P (*tostr
))
2723 /* If *TOSTR is in the range 0x80..0x9F and TOCHAR is not a
2724 complete multibyte character, it may be combined with the
2725 after bytes. If it is in the range 0xA0..0xFF, it may be
2726 combined with the before and after bytes. */
2727 if (!CHAR_HEAD_P (*tostr
))
2728 maybe_byte_combining
= COMBINING_BOTH
;
2729 else if (BYTES_BY_CHAR_HEAD (*tostr
) > len
)
2730 maybe_byte_combining
= COMBINING_AFTER
;
2736 fromstr
[0] = XFASTINT (fromchar
);
2737 tostr
[0] = XFASTINT (tochar
);
2741 pos_byte
= CHAR_TO_BYTE (pos
);
2742 stop
= CHAR_TO_BYTE (XINT (end
));
2745 /* If we don't want undo, turn off putting stuff on the list.
2746 That's faster than getting rid of things,
2747 and it prevents even the entry for a first change.
2748 Also inhibit locking the file. */
2749 if (!changed
&& !NILP (noundo
))
2751 record_unwind_protect (subst_char_in_region_unwind
,
2752 current_buffer
->undo_list
);
2753 current_buffer
->undo_list
= Qt
;
2754 /* Don't do file-locking. */
2755 record_unwind_protect (subst_char_in_region_unwind_1
,
2756 current_buffer
->filename
);
2757 current_buffer
->filename
= Qnil
;
2760 if (pos_byte
< GPT_BYTE
)
2761 stop
= min (stop
, GPT_BYTE
);
2764 EMACS_INT pos_byte_next
= pos_byte
;
2766 if (pos_byte
>= stop
)
2768 if (pos_byte
>= end_byte
) break;
2771 p
= BYTE_POS_ADDR (pos_byte
);
2773 INC_POS (pos_byte_next
);
2776 if (pos_byte_next
- pos_byte
== len
2777 && p
[0] == fromstr
[0]
2779 || (p
[1] == fromstr
[1]
2780 && (len
== 2 || (p
[2] == fromstr
[2]
2781 && (len
== 3 || p
[3] == fromstr
[3]))))))
2784 /* We've already seen this and run the before-change-function;
2785 this time we only need to record the actual position. */
2790 modify_region (current_buffer
, pos
, XINT (end
), 0);
2792 if (! NILP (noundo
))
2794 if (MODIFF
- 1 == SAVE_MODIFF
)
2796 if (MODIFF
- 1 == BUF_AUTOSAVE_MODIFF (current_buffer
))
2797 BUF_AUTOSAVE_MODIFF (current_buffer
)++;
2800 /* The before-change-function may have moved the gap
2801 or even modified the buffer so we should start over. */
2805 /* Take care of the case where the new character
2806 combines with neighboring bytes. */
2807 if (maybe_byte_combining
2808 && (maybe_byte_combining
== COMBINING_AFTER
2809 ? (pos_byte_next
< Z_BYTE
2810 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next
)))
2811 : ((pos_byte_next
< Z_BYTE
2812 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next
)))
2813 || (pos_byte
> BEG_BYTE
2814 && ! ASCII_BYTE_P (FETCH_BYTE (pos_byte
- 1))))))
2816 Lisp_Object tem
, string
;
2818 struct gcpro gcpro1
;
2820 tem
= current_buffer
->undo_list
;
2823 /* Make a multibyte string containing this single character. */
2824 string
= make_multibyte_string (tostr
, 1, len
);
2825 /* replace_range is less efficient, because it moves the gap,
2826 but it handles combining correctly. */
2827 replace_range (pos
, pos
+ 1, string
,
2829 pos_byte_next
= CHAR_TO_BYTE (pos
);
2830 if (pos_byte_next
> pos_byte
)
2831 /* Before combining happened. We should not increment
2832 POS. So, to cancel the later increment of POS,
2836 INC_POS (pos_byte_next
);
2838 if (! NILP (noundo
))
2839 current_buffer
->undo_list
= tem
;
2846 record_change (pos
, 1);
2847 for (i
= 0; i
< len
; i
++) *p
++ = tostr
[i
];
2849 last_changed
= pos
+ 1;
2851 pos_byte
= pos_byte_next
;
2857 signal_after_change (changed
,
2858 last_changed
- changed
, last_changed
- changed
);
2859 update_compositions (changed
, last_changed
, CHECK_ALL
);
2862 unbind_to (count
, Qnil
);
2867 static Lisp_Object
check_translation (EMACS_INT
, EMACS_INT
, EMACS_INT
,
2870 /* Helper function for Ftranslate_region_internal.
2872 Check if a character sequence at POS (POS_BYTE) matches an element
2873 of VAL. VAL is a list (([FROM-CHAR ...] . TO) ...). If a matching
2874 element is found, return it. Otherwise return Qnil. */
2877 check_translation (EMACS_INT pos
, EMACS_INT pos_byte
, EMACS_INT end
,
2880 int buf_size
= 16, buf_used
= 0;
2881 int *buf
= alloca (sizeof (int) * buf_size
);
2883 for (; CONSP (val
); val
= XCDR (val
))
2892 if (! VECTORP (elt
))
2895 if (len
<= end
- pos
)
2897 for (i
= 0; i
< len
; i
++)
2901 unsigned char *p
= BYTE_POS_ADDR (pos_byte
);
2904 if (buf_used
== buf_size
)
2909 newbuf
= alloca (sizeof (int) * buf_size
);
2910 memcpy (newbuf
, buf
, sizeof (int) * buf_used
);
2913 buf
[buf_used
++] = STRING_CHAR_AND_LENGTH (p
, len1
);
2916 if (XINT (AREF (elt
, i
)) != buf
[i
])
2927 DEFUN ("translate-region-internal", Ftranslate_region_internal
,
2928 Stranslate_region_internal
, 3, 3, 0,
2929 doc
: /* Internal use only.
2930 From START to END, translate characters according to TABLE.
2931 TABLE is a string or a char-table; the Nth character in it is the
2932 mapping for the character with code N.
2933 It returns the number of characters changed. */)
2934 (Lisp_Object start
, Lisp_Object end
, register Lisp_Object table
)
2936 register unsigned char *tt
; /* Trans table. */
2937 register int nc
; /* New character. */
2938 int cnt
; /* Number of changes made. */
2939 EMACS_INT size
; /* Size of translate table. */
2940 EMACS_INT pos
, pos_byte
, end_pos
;
2941 int multibyte
= !NILP (current_buffer
->enable_multibyte_characters
);
2942 int string_multibyte
;
2945 validate_region (&start
, &end
);
2946 if (CHAR_TABLE_P (table
))
2948 if (! EQ (XCHAR_TABLE (table
)->purpose
, Qtranslation_table
))
2949 error ("Not a translation table");
2955 CHECK_STRING (table
);
2957 if (! multibyte
&& (SCHARS (table
) < SBYTES (table
)))
2958 table
= string_make_unibyte (table
);
2959 string_multibyte
= SCHARS (table
) < SBYTES (table
);
2960 size
= SBYTES (table
);
2965 pos_byte
= CHAR_TO_BYTE (pos
);
2966 end_pos
= XINT (end
);
2967 modify_region (current_buffer
, pos
, end_pos
, 0);
2970 for (; pos
< end_pos
; )
2972 register unsigned char *p
= BYTE_POS_ADDR (pos_byte
);
2973 unsigned char *str
, buf
[MAX_MULTIBYTE_LENGTH
];
2979 oc
= STRING_CHAR_AND_LENGTH (p
, len
);
2986 /* Reload as signal_after_change in last iteration may GC. */
2988 if (string_multibyte
)
2990 str
= tt
+ string_char_to_byte (table
, oc
);
2991 nc
= STRING_CHAR_AND_LENGTH (str
, str_len
);
2996 if (! ASCII_BYTE_P (nc
) && multibyte
)
2998 str_len
= BYTE8_STRING (nc
, buf
);
3013 val
= CHAR_TABLE_REF (table
, oc
);
3014 if (CHARACTERP (val
)
3015 && (c
= XINT (val
), CHAR_VALID_P (c
, 0)))
3018 str_len
= CHAR_STRING (nc
, buf
);
3021 else if (VECTORP (val
) || (CONSP (val
)))
3023 /* VAL is [TO_CHAR ...] or (([FROM-CHAR ...] . TO) ...)
3024 where TO is TO-CHAR or [TO-CHAR ...]. */
3029 if (nc
!= oc
&& nc
>= 0)
3031 /* Simple one char to one char translation. */
3036 /* This is less efficient, because it moves the gap,
3037 but it should handle multibyte characters correctly. */
3038 string
= make_multibyte_string (str
, 1, str_len
);
3039 replace_range (pos
, pos
+ 1, string
, 1, 0, 1);
3044 record_change (pos
, 1);
3045 while (str_len
-- > 0)
3047 signal_after_change (pos
, 1, 1);
3048 update_compositions (pos
, pos
+ 1, CHECK_BORDER
);
3058 val
= check_translation (pos
, pos_byte
, end_pos
, val
);
3065 /* VAL is ([FROM-CHAR ...] . TO). */
3066 len
= ASIZE (XCAR (val
));
3074 string
= Fconcat (1, &val
);
3078 string
= Fmake_string (make_number (1), val
);
3080 replace_range (pos
, pos
+ len
, string
, 1, 0, 1);
3081 pos_byte
+= SBYTES (string
);
3082 pos
+= SCHARS (string
);
3083 cnt
+= SCHARS (string
);
3084 end_pos
+= SCHARS (string
) - len
;
3092 return make_number (cnt
);
3095 DEFUN ("delete-region", Fdelete_region
, Sdelete_region
, 2, 2, "r",
3096 doc
: /* Delete the text between point and mark.
3098 When called from a program, expects two arguments,
3099 positions (integers or markers) specifying the stretch to be deleted. */)
3100 (Lisp_Object start
, Lisp_Object end
)
3102 validate_region (&start
, &end
);
3103 del_range (XINT (start
), XINT (end
));
3107 DEFUN ("delete-and-extract-region", Fdelete_and_extract_region
,
3108 Sdelete_and_extract_region
, 2, 2, 0,
3109 doc
: /* Delete the text between START and END and return it. */)
3110 (Lisp_Object start
, Lisp_Object end
)
3112 validate_region (&start
, &end
);
3113 if (XINT (start
) == XINT (end
))
3114 return empty_unibyte_string
;
3115 return del_range_1 (XINT (start
), XINT (end
), 1, 1);
3118 DEFUN ("widen", Fwiden
, Swiden
, 0, 0, "",
3119 doc
: /* Remove restrictions (narrowing) from current buffer.
3120 This allows the buffer's full text to be seen and edited. */)
3123 if (BEG
!= BEGV
|| Z
!= ZV
)
3124 current_buffer
->clip_changed
= 1;
3126 BEGV_BYTE
= BEG_BYTE
;
3127 SET_BUF_ZV_BOTH (current_buffer
, Z
, Z_BYTE
);
3128 /* Changing the buffer bounds invalidates any recorded current column. */
3129 invalidate_current_column ();
3133 DEFUN ("narrow-to-region", Fnarrow_to_region
, Snarrow_to_region
, 2, 2, "r",
3134 doc
: /* Restrict editing in this buffer to the current region.
3135 The rest of the text becomes temporarily invisible and untouchable
3136 but is not deleted; if you save the buffer in a file, the invisible
3137 text is included in the file. \\[widen] makes all visible again.
3138 See also `save-restriction'.
3140 When calling from a program, pass two arguments; positions (integers
3141 or markers) bounding the text that should remain visible. */)
3142 (register Lisp_Object start
, Lisp_Object end
)
3144 CHECK_NUMBER_COERCE_MARKER (start
);
3145 CHECK_NUMBER_COERCE_MARKER (end
);
3147 if (XINT (start
) > XINT (end
))
3150 tem
= start
; start
= end
; end
= tem
;
3153 if (!(BEG
<= XINT (start
) && XINT (start
) <= XINT (end
) && XINT (end
) <= Z
))
3154 args_out_of_range (start
, end
);
3156 if (BEGV
!= XFASTINT (start
) || ZV
!= XFASTINT (end
))
3157 current_buffer
->clip_changed
= 1;
3159 SET_BUF_BEGV (current_buffer
, XFASTINT (start
));
3160 SET_BUF_ZV (current_buffer
, XFASTINT (end
));
3161 if (PT
< XFASTINT (start
))
3162 SET_PT (XFASTINT (start
));
3163 if (PT
> XFASTINT (end
))
3164 SET_PT (XFASTINT (end
));
3165 /* Changing the buffer bounds invalidates any recorded current column. */
3166 invalidate_current_column ();
3171 save_restriction_save (void)
3173 if (BEGV
== BEG
&& ZV
== Z
)
3174 /* The common case that the buffer isn't narrowed.
3175 We return just the buffer object, which save_restriction_restore
3176 recognizes as meaning `no restriction'. */
3177 return Fcurrent_buffer ();
3179 /* We have to save a restriction, so return a pair of markers, one
3180 for the beginning and one for the end. */
3182 Lisp_Object beg
, end
;
3184 beg
= buildmark (BEGV
, BEGV_BYTE
);
3185 end
= buildmark (ZV
, ZV_BYTE
);
3187 /* END must move forward if text is inserted at its exact location. */
3188 XMARKER(end
)->insertion_type
= 1;
3190 return Fcons (beg
, end
);
3195 save_restriction_restore (Lisp_Object data
)
3197 struct buffer
*cur
= NULL
;
3198 struct buffer
*buf
= (CONSP (data
)
3199 ? XMARKER (XCAR (data
))->buffer
3202 if (buf
&& buf
!= current_buffer
&& !NILP (buf
->pt_marker
))
3203 { /* If `buf' uses markers to keep track of PT, BEGV, and ZV (as
3204 is the case if it is or has an indirect buffer), then make
3205 sure it is current before we update BEGV, so
3206 set_buffer_internal takes care of managing those markers. */
3207 cur
= current_buffer
;
3208 set_buffer_internal (buf
);
3212 /* A pair of marks bounding a saved restriction. */
3214 struct Lisp_Marker
*beg
= XMARKER (XCAR (data
));
3215 struct Lisp_Marker
*end
= XMARKER (XCDR (data
));
3216 eassert (buf
== end
->buffer
);
3218 if (buf
/* Verify marker still points to a buffer. */
3219 && (beg
->charpos
!= BUF_BEGV (buf
) || end
->charpos
!= BUF_ZV (buf
)))
3220 /* The restriction has changed from the saved one, so restore
3221 the saved restriction. */
3223 EMACS_INT pt
= BUF_PT (buf
);
3225 SET_BUF_BEGV_BOTH (buf
, beg
->charpos
, beg
->bytepos
);
3226 SET_BUF_ZV_BOTH (buf
, end
->charpos
, end
->bytepos
);
3228 if (pt
< beg
->charpos
|| pt
> end
->charpos
)
3229 /* The point is outside the new visible range, move it inside. */
3230 SET_BUF_PT_BOTH (buf
,
3231 clip_to_bounds (beg
->charpos
, pt
, end
->charpos
),
3232 clip_to_bounds (beg
->bytepos
, BUF_PT_BYTE (buf
),
3235 buf
->clip_changed
= 1; /* Remember that the narrowing changed. */
3239 /* A buffer, which means that there was no old restriction. */
3241 if (buf
/* Verify marker still points to a buffer. */
3242 && (BUF_BEGV (buf
) != BUF_BEG (buf
) || BUF_ZV (buf
) != BUF_Z (buf
)))
3243 /* The buffer has been narrowed, get rid of the narrowing. */
3245 SET_BUF_BEGV_BOTH (buf
, BUF_BEG (buf
), BUF_BEG_BYTE (buf
));
3246 SET_BUF_ZV_BOTH (buf
, BUF_Z (buf
), BUF_Z_BYTE (buf
));
3248 buf
->clip_changed
= 1; /* Remember that the narrowing changed. */
3253 set_buffer_internal (cur
);
3258 DEFUN ("save-restriction", Fsave_restriction
, Ssave_restriction
, 0, UNEVALLED
, 0,
3259 doc
: /* Execute BODY, saving and restoring current buffer's restrictions.
3260 The buffer's restrictions make parts of the beginning and end invisible.
3261 \(They are set up with `narrow-to-region' and eliminated with `widen'.)
3262 This special form, `save-restriction', saves the current buffer's restrictions
3263 when it is entered, and restores them when it is exited.
3264 So any `narrow-to-region' within BODY lasts only until the end of the form.
3265 The old restrictions settings are restored
3266 even in case of abnormal exit (throw or error).
3268 The value returned is the value of the last form in BODY.
3270 Note: if you are using both `save-excursion' and `save-restriction',
3271 use `save-excursion' outermost:
3272 (save-excursion (save-restriction ...))
3274 usage: (save-restriction &rest BODY) */)
3277 register Lisp_Object val
;
3278 int count
= SPECPDL_INDEX ();
3280 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
3281 val
= Fprogn (body
);
3282 return unbind_to (count
, val
);
3285 /* Buffer for the most recent text displayed by Fmessage_box. */
3286 static char *message_text
;
3288 /* Allocated length of that buffer. */
3289 static int message_length
;
3291 DEFUN ("message", Fmessage
, Smessage
, 1, MANY
, 0,
3292 doc
: /* Display a message at the bottom of the screen.
3293 The message also goes into the `*Messages*' buffer.
3294 \(In keyboard macros, that's all it does.)
3297 The first argument is a format control string, and the rest are data
3298 to be formatted under control of the string. See `format' for details.
3300 Note: Use (message "%s" VALUE) to print the value of expressions and
3301 variables to avoid accidentally interpreting `%' as format specifiers.
3303 If the first argument is nil or the empty string, the function clears
3304 any existing message; this lets the minibuffer contents show. See
3305 also `current-message'.
3307 usage: (message FORMAT-STRING &rest ARGS) */)
3308 (int nargs
, Lisp_Object
*args
)
3311 || (STRINGP (args
[0])
3312 && SBYTES (args
[0]) == 0))
3319 register Lisp_Object val
;
3320 val
= Fformat (nargs
, args
);
3321 message3 (val
, SBYTES (val
), STRING_MULTIBYTE (val
));
3326 DEFUN ("message-box", Fmessage_box
, Smessage_box
, 1, MANY
, 0,
3327 doc
: /* Display a message, in a dialog box if possible.
3328 If a dialog box is not available, use the echo area.
3329 The first argument is a format control string, and the rest are data
3330 to be formatted under control of the string. See `format' for details.
3332 If the first argument is nil or the empty string, clear any existing
3333 message; let the minibuffer contents show.
3335 usage: (message-box FORMAT-STRING &rest ARGS) */)
3336 (int nargs
, Lisp_Object
*args
)
3345 register Lisp_Object val
;
3346 val
= Fformat (nargs
, args
);
3348 /* The MS-DOS frames support popup menus even though they are
3349 not FRAME_WINDOW_P. */
3350 if (FRAME_WINDOW_P (XFRAME (selected_frame
))
3351 || FRAME_MSDOS_P (XFRAME (selected_frame
)))
3353 Lisp_Object pane
, menu
, obj
;
3354 struct gcpro gcpro1
;
3355 pane
= Fcons (Fcons (build_string ("OK"), Qt
), Qnil
);
3357 menu
= Fcons (val
, pane
);
3358 obj
= Fx_popup_dialog (Qt
, menu
, Qt
);
3362 #endif /* HAVE_MENUS */
3363 /* Copy the data so that it won't move when we GC. */
3366 message_text
= (char *)xmalloc (80);
3367 message_length
= 80;
3369 if (SBYTES (val
) > message_length
)
3371 message_length
= SBYTES (val
);
3372 message_text
= (char *)xrealloc (message_text
, message_length
);
3374 memcpy (message_text
, SDATA (val
), SBYTES (val
));
3375 message2 (message_text
, SBYTES (val
),
3376 STRING_MULTIBYTE (val
));
3381 DEFUN ("message-or-box", Fmessage_or_box
, Smessage_or_box
, 1, MANY
, 0,
3382 doc
: /* Display a message in a dialog box or in the echo area.
3383 If this command was invoked with the mouse, use a dialog box if
3384 `use-dialog-box' is non-nil.
3385 Otherwise, use the echo area.
3386 The first argument is a format control string, and the rest are data
3387 to be formatted under control of the string. See `format' for details.
3389 If the first argument is nil or the empty string, clear any existing
3390 message; let the minibuffer contents show.
3392 usage: (message-or-box FORMAT-STRING &rest ARGS) */)
3393 (int nargs
, Lisp_Object
*args
)
3396 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
3398 return Fmessage_box (nargs
, args
);
3400 return Fmessage (nargs
, args
);
3403 DEFUN ("current-message", Fcurrent_message
, Scurrent_message
, 0, 0, 0,
3404 doc
: /* Return the string currently displayed in the echo area, or nil if none. */)
3407 return current_message ();
3411 DEFUN ("propertize", Fpropertize
, Spropertize
, 1, MANY
, 0,
3412 doc
: /* Return a copy of STRING with text properties added.
3413 First argument is the string to copy.
3414 Remaining arguments form a sequence of PROPERTY VALUE pairs for text
3415 properties to add to the result.
3416 usage: (propertize STRING &rest PROPERTIES) */)
3417 (int nargs
, Lisp_Object
*args
)
3419 Lisp_Object properties
, string
;
3420 struct gcpro gcpro1
, gcpro2
;
3423 /* Number of args must be odd. */
3424 if ((nargs
& 1) == 0 || nargs
< 1)
3425 error ("Wrong number of arguments");
3427 properties
= string
= Qnil
;
3428 GCPRO2 (properties
, string
);
3430 /* First argument must be a string. */
3431 CHECK_STRING (args
[0]);
3432 string
= Fcopy_sequence (args
[0]);
3434 for (i
= 1; i
< nargs
; i
+= 2)
3435 properties
= Fcons (args
[i
], Fcons (args
[i
+ 1], properties
));
3437 Fadd_text_properties (make_number (0),
3438 make_number (SCHARS (string
)),
3439 properties
, string
);
3440 RETURN_UNGCPRO (string
);
3444 /* Number of bytes that STRING will occupy when put into the result.
3445 MULTIBYTE is nonzero if the result should be multibyte. */
3447 #define CONVERTED_BYTE_SIZE(MULTIBYTE, STRING) \
3448 (((MULTIBYTE) && ! STRING_MULTIBYTE (STRING)) \
3449 ? count_size_as_multibyte (SDATA (STRING), SBYTES (STRING)) \
3452 DEFUN ("format", Fformat
, Sformat
, 1, MANY
, 0,
3453 doc
: /* Format a string out of a format-string and arguments.
3454 The first argument is a format control string.
3455 The other arguments are substituted into it to make the result, a string.
3457 The format control string may contain %-sequences meaning to substitute
3458 the next available argument:
3460 %s means print a string argument. Actually, prints any object, with `princ'.
3461 %d means print as number in decimal (%o octal, %x hex).
3462 %X is like %x, but uses upper case.
3463 %e means print a number in exponential notation.
3464 %f means print a number in decimal-point notation.
3465 %g means print a number in exponential notation
3466 or decimal-point notation, whichever uses fewer characters.
3467 %c means print a number as a single character.
3468 %S means print any object as an s-expression (using `prin1').
3470 The argument used for %d, %o, %x, %e, %f, %g or %c must be a number.
3471 Use %% to put a single % into the output.
3473 A %-sequence may contain optional flag, width, and precision
3474 specifiers, as follows:
3476 %<flags><width><precision>character
3478 where flags is [+ #-0]+, width is [0-9]+, and precision is .[0-9]+
3480 The + flag character inserts a + before any positive number, while a
3481 space inserts a space before any positive number; these flags only
3482 affect %d, %e, %f, and %g sequences, and the + flag takes precedence.
3483 The # flag means to use an alternate display form for %o, %x, %X, %e,
3484 %f, and %g sequences. The - and 0 flags affect the width specifier,
3487 The width specifier supplies a lower limit for the length of the
3488 printed representation. The padding, if any, normally goes on the
3489 left, but it goes on the right if the - flag is present. The padding
3490 character is normally a space, but it is 0 if the 0 flag is present.
3491 The - flag takes precedence over the 0 flag.
3493 For %e, %f, and %g sequences, the number after the "." in the
3494 precision specifier says how many decimal places to show; if zero, the
3495 decimal point itself is omitted. For %s and %S, the precision
3496 specifier truncates the string to the given width.
3498 usage: (format STRING &rest OBJECTS) */)
3499 (int nargs
, register Lisp_Object
*args
)
3501 register int n
; /* The number of the next arg to substitute */
3502 register EMACS_INT total
; /* An estimate of the final length */
3504 register unsigned char *format
, *end
, *format_start
;
3506 /* Nonzero if the output should be a multibyte string,
3507 which is true if any of the inputs is one. */
3509 /* When we make a multibyte string, we must pay attention to the
3510 byte combining problem, i.e., a byte may be combined with a
3511 multibyte character of the previous string. This flag tells if we
3512 must consider such a situation or not. */
3513 int maybe_combine_byte
;
3514 unsigned char *this_format
;
3515 /* Precision for each spec, or -1, a flag value meaning no precision
3516 was given in that spec. Element 0, corresonding to the format
3517 string itself, will not be used. Element NARGS, corresponding to
3518 no argument, *will* be assigned to in the case that a `%' and `.'
3519 occur after the final format specifier. */
3520 int *precision
= (int *) (alloca ((nargs
+ 1) * sizeof (int)));
3523 int arg_intervals
= 0;
3526 /* discarded[I] is 1 if byte I of the format
3527 string was not copied into the output.
3528 It is 2 if byte I was not the first byte of its character. */
3529 char *discarded
= 0;
3531 /* Each element records, for one argument,
3532 the start and end bytepos in the output string,
3533 and whether the argument is a string with intervals.
3534 info[0] is unused. Unused elements have -1 for start. */
3537 int start
, end
, intervals
;
3540 /* It should not be necessary to GCPRO ARGS, because
3541 the caller in the interpreter should take care of that. */
3543 /* Try to determine whether the result should be multibyte.
3544 This is not always right; sometimes the result needs to be multibyte
3545 because of an object that we will pass through prin1,
3546 and in that case, we won't know it here. */
3547 for (n
= 0; n
< nargs
; n
++)
3549 if (STRINGP (args
[n
]) && STRING_MULTIBYTE (args
[n
]))
3551 /* Piggyback on this loop to initialize precision[N]. */
3554 precision
[nargs
] = -1;
3556 CHECK_STRING (args
[0]);
3557 /* We may have to change "%S" to "%s". */
3558 args
[0] = Fcopy_sequence (args
[0]);
3560 /* GC should never happen here, so abort if it does. */
3563 /* If we start out planning a unibyte result,
3564 then discover it has to be multibyte, we jump back to retry.
3565 That can only happen from the first large while loop below. */
3568 format
= SDATA (args
[0]);
3569 format_start
= format
;
3570 end
= format
+ SBYTES (args
[0]);
3573 /* Make room in result for all the non-%-codes in the control string. */
3574 total
= 5 + CONVERTED_BYTE_SIZE (multibyte
, args
[0]) + 1;
3576 /* Allocate the info and discarded tables. */
3578 int nbytes
= (nargs
+1) * sizeof *info
;
3581 info
= (struct info
*) alloca (nbytes
);
3582 memset (info
, 0, nbytes
);
3583 for (i
= 0; i
<= nargs
; i
++)
3586 SAFE_ALLOCA (discarded
, char *, SBYTES (args
[0]));
3587 memset (discarded
, 0, SBYTES (args
[0]));
3590 /* Add to TOTAL enough space to hold the converted arguments. */
3593 while (format
!= end
)
3594 if (*format
++ == '%')
3596 EMACS_INT thissize
= 0;
3597 EMACS_INT actual_width
= 0;
3598 unsigned char *this_format_start
= format
- 1;
3599 int field_width
= 0;
3601 /* General format specifications look like
3603 '%' [flags] [field-width] [precision] format
3608 field-width ::= [0-9]+
3609 precision ::= '.' [0-9]*
3611 If a field-width is specified, it specifies to which width
3612 the output should be padded with blanks, if the output
3613 string is shorter than field-width.
3615 If precision is specified, it specifies the number of
3616 digits to print after the '.' for floats, or the max.
3617 number of chars to print from a string. */
3619 while (format
!= end
3620 && (*format
== '-' || *format
== '0' || *format
== '#'
3621 || * format
== ' ' || *format
== '+'))
3624 if (*format
>= '0' && *format
<= '9')
3626 for (field_width
= 0; *format
>= '0' && *format
<= '9'; ++format
)
3627 field_width
= 10 * field_width
+ *format
- '0';
3630 /* N is not incremented for another few lines below, so refer to
3631 element N+1 (which might be precision[NARGS]). */
3635 for (precision
[n
+1] = 0; *format
>= '0' && *format
<= '9'; ++format
)
3636 precision
[n
+1] = 10 * precision
[n
+1] + *format
- '0';
3639 /* Extra +1 for 'l' that we may need to insert into the
3641 if (format
- this_format_start
+ 2 > longest_format
)
3642 longest_format
= format
- this_format_start
+ 2;
3645 error ("Format string ends in middle of format specifier");
3648 else if (++n
>= nargs
)
3649 error ("Not enough arguments for format string");
3650 else if (*format
== 'S')
3652 /* For `S', prin1 the argument and then treat like a string. */
3653 register Lisp_Object tem
;
3654 tem
= Fprin1_to_string (args
[n
], Qnil
);
3655 if (STRING_MULTIBYTE (tem
) && ! multibyte
)
3661 /* If we restart the loop, we should not come here again
3662 because args[n] is now a string and calling
3663 Fprin1_to_string on it produces superflous double
3664 quotes. So, change "%S" to "%s" now. */
3668 else if (SYMBOLP (args
[n
]))
3670 args
[n
] = SYMBOL_NAME (args
[n
]);
3671 if (STRING_MULTIBYTE (args
[n
]) && ! multibyte
)
3678 else if (STRINGP (args
[n
]))
3681 if (*format
!= 's' && *format
!= 'S')
3682 error ("Format specifier doesn't match argument type");
3683 /* In the case (PRECISION[N] > 0), THISSIZE may not need
3684 to be as large as is calculated here. Easy check for
3685 the case PRECISION = 0. */
3686 thissize
= precision
[n
] ? CONVERTED_BYTE_SIZE (multibyte
, args
[n
]) : 0;
3687 /* The precision also constrains how much of the argument
3688 string will finally appear (Bug#5710). */
3689 actual_width
= lisp_string_width (args
[n
], -1, NULL
, NULL
);
3690 if (precision
[n
] != -1)
3691 actual_width
= min (actual_width
, precision
[n
]);
3693 /* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */
3694 else if (INTEGERP (args
[n
]) && *format
!= 's')
3696 /* The following loop assumes the Lisp type indicates
3697 the proper way to pass the argument.
3698 So make sure we have a flonum if the argument should
3700 if (*format
== 'e' || *format
== 'f' || *format
== 'g')
3701 args
[n
] = Ffloat (args
[n
]);
3703 if (*format
!= 'd' && *format
!= 'o' && *format
!= 'x'
3704 && *format
!= 'i' && *format
!= 'X' && *format
!= 'c')
3705 error ("Invalid format operation %%%c", *format
);
3707 thissize
= 30 + (precision
[n
] > 0 ? precision
[n
] : 0);
3710 if (! ASCII_CHAR_P (XINT (args
[n
]))
3711 /* Note: No one can remeber why we have to treat
3712 the character 0 as a multibyte character here.
3713 But, until it causes a real problem, let's
3715 || XINT (args
[n
]) == 0)
3722 args
[n
] = Fchar_to_string (args
[n
]);
3723 thissize
= SBYTES (args
[n
]);
3725 else if (! ASCII_BYTE_P (XINT (args
[n
])) && multibyte
)
3728 = Fchar_to_string (Funibyte_char_to_multibyte (args
[n
]));
3729 thissize
= SBYTES (args
[n
]);
3733 else if (FLOATP (args
[n
]) && *format
!= 's')
3735 if (! (*format
== 'e' || *format
== 'f' || *format
== 'g'))
3737 if (*format
!= 'd' && *format
!= 'o' && *format
!= 'x'
3738 && *format
!= 'i' && *format
!= 'X' && *format
!= 'c')
3739 error ("Invalid format operation %%%c", *format
);
3740 /* This fails unnecessarily if args[n] is bigger than
3741 most-positive-fixnum but smaller than MAXINT.
3742 These cases are important because we sometimes use floats
3743 to represent such integer values (typically such values
3744 come from UIDs or PIDs). */
3745 /* args[n] = Ftruncate (args[n], Qnil); */
3748 /* Note that we're using sprintf to print floats,
3749 so we have to take into account what that function
3751 /* Filter out flag value of -1. */
3752 thissize
= (MAX_10_EXP
+ 100
3753 + (precision
[n
] > 0 ? precision
[n
] : 0));
3757 /* Anything but a string, convert to a string using princ. */
3758 register Lisp_Object tem
;
3759 tem
= Fprin1_to_string (args
[n
], Qt
);
3760 if (STRING_MULTIBYTE (tem
) && ! multibyte
)
3769 thissize
+= max (0, field_width
- actual_width
);
3770 total
+= thissize
+ 4;
3775 /* Now we can no longer jump to retry.
3776 TOTAL and LONGEST_FORMAT are known for certain. */
3778 this_format
= (unsigned char *) alloca (longest_format
+ 1);
3780 /* Allocate the space for the result.
3781 Note that TOTAL is an overestimate. */
3782 SAFE_ALLOCA (buf
, char *, total
);
3788 /* Scan the format and store result in BUF. */
3789 format
= SDATA (args
[0]);
3790 format_start
= format
;
3791 end
= format
+ SBYTES (args
[0]);
3792 maybe_combine_byte
= 0;
3793 while (format
!= end
)
3799 unsigned char *this_format_start
= format
;
3801 discarded
[format
- format_start
] = 1;
3804 while (strchr ("-+0# ", *format
))
3810 discarded
[format
- format_start
] = 1;
3814 minlen
= atoi (format
);
3816 while ((*format
>= '0' && *format
<= '9') || *format
== '.')
3818 discarded
[format
- format_start
] = 1;
3822 if (*format
++ == '%')
3831 discarded
[format
- format_start
- 1] = 1;
3832 info
[n
].start
= nchars
;
3834 if (STRINGP (args
[n
]))
3836 /* handle case (precision[n] >= 0) */
3839 EMACS_INT nbytes
, start
, end
;
3840 EMACS_INT nchars_string
;
3842 /* lisp_string_width ignores a precision of 0, but GNU
3843 libc functions print 0 characters when the precision
3844 is 0. Imitate libc behavior here. Changing
3845 lisp_string_width is the right thing, and will be
3846 done, but meanwhile we work with it. */
3848 if (precision
[n
] == 0)
3849 width
= nchars_string
= nbytes
= 0;
3850 else if (precision
[n
] > 0)
3851 width
= lisp_string_width (args
[n
], precision
[n
],
3852 &nchars_string
, &nbytes
);
3854 { /* no precision spec given for this argument */
3855 width
= lisp_string_width (args
[n
], -1, NULL
, NULL
);
3856 nbytes
= SBYTES (args
[n
]);
3857 nchars_string
= SCHARS (args
[n
]);
3860 /* If spec requires it, pad on right with spaces. */
3861 padding
= minlen
- width
;
3863 while (padding
-- > 0)
3869 info
[n
].start
= start
= nchars
;
3870 nchars
+= nchars_string
;
3875 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
3876 && STRING_MULTIBYTE (args
[n
])
3877 && !CHAR_HEAD_P (SREF (args
[n
], 0)))
3878 maybe_combine_byte
= 1;
3880 p
+= copy_text (SDATA (args
[n
]), p
,
3882 STRING_MULTIBYTE (args
[n
]), multibyte
);
3884 info
[n
].end
= nchars
;
3887 while (padding
-- > 0)
3893 /* If this argument has text properties, record where
3894 in the result string it appears. */
3895 if (STRING_INTERVALS (args
[n
]))
3896 info
[n
].intervals
= arg_intervals
= 1;
3898 else if (INTEGERP (args
[n
]) || FLOATP (args
[n
]))
3902 memcpy (this_format
, this_format_start
,
3903 format
- this_format_start
);
3904 this_format
[format
- this_format_start
] = 0;
3906 if (format
[-1] == 'e' || format
[-1] == 'f' || format
[-1] == 'g')
3907 sprintf (p
, this_format
, XFLOAT_DATA (args
[n
]));
3910 if (sizeof (EMACS_INT
) > sizeof (int)
3911 && format
[-1] != 'c')
3913 /* Insert 'l' before format spec. */
3914 this_format
[format
- this_format_start
]
3915 = this_format
[format
- this_format_start
- 1];
3916 this_format
[format
- this_format_start
- 1] = 'l';
3917 this_format
[format
- this_format_start
+ 1] = 0;
3920 if (INTEGERP (args
[n
]))
3922 if (format
[-1] == 'c')
3923 sprintf (p
, this_format
, (int) XINT (args
[n
]));
3924 else if (format
[-1] == 'd')
3925 sprintf (p
, this_format
, XINT (args
[n
]));
3926 /* Don't sign-extend for octal or hex printing. */
3928 sprintf (p
, this_format
, XUINT (args
[n
]));
3930 else if (format
[-1] == 'c')
3931 sprintf (p
, this_format
, (int) XFLOAT_DATA (args
[n
]));
3932 else if (format
[-1] == 'd')
3933 /* Maybe we should use "%1.0f" instead so it also works
3934 for values larger than MAXINT. */
3935 sprintf (p
, this_format
, (EMACS_INT
) XFLOAT_DATA (args
[n
]));
3937 /* Don't sign-extend for octal or hex printing. */
3938 sprintf (p
, this_format
, (EMACS_UINT
) XFLOAT_DATA (args
[n
]));
3943 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
3944 && !CHAR_HEAD_P (*((unsigned char *) p
)))
3945 maybe_combine_byte
= 1;
3946 this_nchars
= strlen (p
);
3948 p
+= str_to_multibyte (p
, buf
+ total
- 1 - p
, this_nchars
);
3951 nchars
+= this_nchars
;
3952 info
[n
].end
= nchars
;
3956 else if (STRING_MULTIBYTE (args
[0]))
3958 /* Copy a whole multibyte character. */
3961 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
3962 && !CHAR_HEAD_P (*format
))
3963 maybe_combine_byte
= 1;
3965 while (! CHAR_HEAD_P (*format
))
3967 discarded
[format
- format_start
] = 2;
3974 /* Convert a single-byte character to multibyte. */
3975 int len
= copy_text (format
, p
, 1, 0, 1);
3982 *p
++ = *format
++, nchars
++;
3985 if (p
> buf
+ total
)
3988 if (maybe_combine_byte
)
3989 nchars
= multibyte_chars_in_text (buf
, p
- buf
);
3990 val
= make_specified_string (buf
, nchars
, p
- buf
, multibyte
);
3992 /* If we allocated BUF with malloc, free it too. */
3995 /* If the format string has text properties, or any of the string
3996 arguments has text properties, set up text properties of the
3999 if (STRING_INTERVALS (args
[0]) || arg_intervals
)
4001 Lisp_Object len
, new_len
, props
;
4002 struct gcpro gcpro1
;
4004 /* Add text properties from the format string. */
4005 len
= make_number (SCHARS (args
[0]));
4006 props
= text_property_list (args
[0], make_number (0), len
, Qnil
);
4011 EMACS_INT bytepos
= 0, position
= 0, translated
= 0;
4015 /* Adjust the bounds of each text property
4016 to the proper start and end in the output string. */
4018 /* Put the positions in PROPS in increasing order, so that
4019 we can do (effectively) one scan through the position
4020 space of the format string. */
4021 props
= Fnreverse (props
);
4023 /* BYTEPOS is the byte position in the format string,
4024 POSITION is the untranslated char position in it,
4025 TRANSLATED is the translated char position in BUF,
4026 and ARGN is the number of the next arg we will come to. */
4027 for (list
= props
; CONSP (list
); list
= XCDR (list
))
4034 /* First adjust the property start position. */
4035 pos
= XINT (XCAR (item
));
4037 /* Advance BYTEPOS, POSITION, TRANSLATED and ARGN
4038 up to this position. */
4039 for (; position
< pos
; bytepos
++)
4041 if (! discarded
[bytepos
])
4042 position
++, translated
++;
4043 else if (discarded
[bytepos
] == 1)
4046 if (translated
== info
[argn
].start
)
4048 translated
+= info
[argn
].end
- info
[argn
].start
;
4054 XSETCAR (item
, make_number (translated
));
4056 /* Likewise adjust the property end position. */
4057 pos
= XINT (XCAR (XCDR (item
)));
4059 for (; position
< pos
; bytepos
++)
4061 if (! discarded
[bytepos
])
4062 position
++, translated
++;
4063 else if (discarded
[bytepos
] == 1)
4066 if (translated
== info
[argn
].start
)
4068 translated
+= info
[argn
].end
- info
[argn
].start
;
4074 XSETCAR (XCDR (item
), make_number (translated
));
4077 add_text_properties_from_list (val
, props
, make_number (0));
4080 /* Add text properties from arguments. */
4082 for (n
= 1; n
< nargs
; ++n
)
4083 if (info
[n
].intervals
)
4085 len
= make_number (SCHARS (args
[n
]));
4086 new_len
= make_number (info
[n
].end
- info
[n
].start
);
4087 props
= text_property_list (args
[n
], make_number (0), len
, Qnil
);
4088 props
= extend_property_ranges (props
, new_len
);
4089 /* If successive arguments have properties, be sure that
4090 the value of `composition' property be the copy. */
4091 if (n
> 1 && info
[n
- 1].end
)
4092 make_composition_value_copy (props
);
4093 add_text_properties_from_list (val
, props
,
4094 make_number (info
[n
].start
));
4104 format2 (const char *string1
, Lisp_Object arg0
, Lisp_Object arg1
)
4106 Lisp_Object args
[3];
4107 args
[0] = build_string (string1
);
4110 return Fformat (3, args
);
4113 DEFUN ("char-equal", Fchar_equal
, Schar_equal
, 2, 2, 0,
4114 doc
: /* Return t if two characters match, optionally ignoring case.
4115 Both arguments must be characters (i.e. integers).
4116 Case is ignored if `case-fold-search' is non-nil in the current buffer. */)
4117 (register Lisp_Object c1
, Lisp_Object c2
)
4120 /* Check they're chars, not just integers, otherwise we could get array
4121 bounds violations in DOWNCASE. */
4122 CHECK_CHARACTER (c1
);
4123 CHECK_CHARACTER (c2
);
4125 if (XINT (c1
) == XINT (c2
))
4127 if (NILP (current_buffer
->case_fold_search
))
4130 /* Do these in separate statements,
4131 then compare the variables.
4132 because of the way DOWNCASE uses temp variables. */
4134 if (NILP (current_buffer
->enable_multibyte_characters
)
4135 && ! ASCII_CHAR_P (i1
))
4137 MAKE_CHAR_MULTIBYTE (i1
);
4140 if (NILP (current_buffer
->enable_multibyte_characters
)
4141 && ! ASCII_CHAR_P (i2
))
4143 MAKE_CHAR_MULTIBYTE (i2
);
4147 return (i1
== i2
? Qt
: Qnil
);
4150 /* Transpose the markers in two regions of the current buffer, and
4151 adjust the ones between them if necessary (i.e.: if the regions
4154 START1, END1 are the character positions of the first region.
4155 START1_BYTE, END1_BYTE are the byte positions.
4156 START2, END2 are the character positions of the second region.
4157 START2_BYTE, END2_BYTE are the byte positions.
4159 Traverses the entire marker list of the buffer to do so, adding an
4160 appropriate amount to some, subtracting from some, and leaving the
4161 rest untouched. Most of this is copied from adjust_markers in insdel.c.
4163 It's the caller's job to ensure that START1 <= END1 <= START2 <= END2. */
4166 transpose_markers (EMACS_INT start1
, EMACS_INT end1
,
4167 EMACS_INT start2
, EMACS_INT end2
,
4168 EMACS_INT start1_byte
, EMACS_INT end1_byte
,
4169 EMACS_INT start2_byte
, EMACS_INT end2_byte
)
4171 register EMACS_INT amt1
, amt1_byte
, amt2
, amt2_byte
, diff
, diff_byte
, mpos
;
4172 register struct Lisp_Marker
*marker
;
4174 /* Update point as if it were a marker. */
4178 TEMP_SET_PT_BOTH (PT
+ (end2
- end1
),
4179 PT_BYTE
+ (end2_byte
- end1_byte
));
4180 else if (PT
< start2
)
4181 TEMP_SET_PT_BOTH (PT
+ (end2
- start2
) - (end1
- start1
),
4182 (PT_BYTE
+ (end2_byte
- start2_byte
)
4183 - (end1_byte
- start1_byte
)));
4185 TEMP_SET_PT_BOTH (PT
- (start2
- start1
),
4186 PT_BYTE
- (start2_byte
- start1_byte
));
4188 /* We used to adjust the endpoints here to account for the gap, but that
4189 isn't good enough. Even if we assume the caller has tried to move the
4190 gap out of our way, it might still be at start1 exactly, for example;
4191 and that places it `inside' the interval, for our purposes. The amount
4192 of adjustment is nontrivial if there's a `denormalized' marker whose
4193 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
4194 the dirty work to Fmarker_position, below. */
4196 /* The difference between the region's lengths */
4197 diff
= (end2
- start2
) - (end1
- start1
);
4198 diff_byte
= (end2_byte
- start2_byte
) - (end1_byte
- start1_byte
);
4200 /* For shifting each marker in a region by the length of the other
4201 region plus the distance between the regions. */
4202 amt1
= (end2
- start2
) + (start2
- end1
);
4203 amt2
= (end1
- start1
) + (start2
- end1
);
4204 amt1_byte
= (end2_byte
- start2_byte
) + (start2_byte
- end1_byte
);
4205 amt2_byte
= (end1_byte
- start1_byte
) + (start2_byte
- end1_byte
);
4207 for (marker
= BUF_MARKERS (current_buffer
); marker
; marker
= marker
->next
)
4209 mpos
= marker
->bytepos
;
4210 if (mpos
>= start1_byte
&& mpos
< end2_byte
)
4212 if (mpos
< end1_byte
)
4214 else if (mpos
< start2_byte
)
4218 marker
->bytepos
= mpos
;
4220 mpos
= marker
->charpos
;
4221 if (mpos
>= start1
&& mpos
< end2
)
4225 else if (mpos
< start2
)
4230 marker
->charpos
= mpos
;
4234 DEFUN ("transpose-regions", Ftranspose_regions
, Stranspose_regions
, 4, 5, 0,
4235 doc
: /* Transpose region STARTR1 to ENDR1 with STARTR2 to ENDR2.
4236 The regions should not be overlapping, because the size of the buffer is
4237 never changed in a transposition.
4239 Optional fifth arg LEAVE-MARKERS, if non-nil, means don't update
4240 any markers that happen to be located in the regions.
4242 Transposing beyond buffer boundaries is an error. */)
4243 (Lisp_Object startr1
, Lisp_Object endr1
, Lisp_Object startr2
, Lisp_Object endr2
, Lisp_Object leave_markers
)
4245 register EMACS_INT start1
, end1
, start2
, end2
;
4246 EMACS_INT start1_byte
, start2_byte
, len1_byte
, len2_byte
;
4247 EMACS_INT gap
, len1
, len_mid
, len2
;
4248 unsigned char *start1_addr
, *start2_addr
, *temp
;
4250 INTERVAL cur_intv
, tmp_interval1
, tmp_interval_mid
, tmp_interval2
, tmp_interval3
;
4253 XSETBUFFER (buf
, current_buffer
);
4254 cur_intv
= BUF_INTERVALS (current_buffer
);
4256 validate_region (&startr1
, &endr1
);
4257 validate_region (&startr2
, &endr2
);
4259 start1
= XFASTINT (startr1
);
4260 end1
= XFASTINT (endr1
);
4261 start2
= XFASTINT (startr2
);
4262 end2
= XFASTINT (endr2
);
4265 /* Swap the regions if they're reversed. */
4268 register EMACS_INT glumph
= start1
;
4276 len1
= end1
- start1
;
4277 len2
= end2
- start2
;
4280 error ("Transposed regions overlap");
4281 else if (start1
== end1
|| start2
== end2
)
4282 error ("Transposed region has length 0");
4284 /* The possibilities are:
4285 1. Adjacent (contiguous) regions, or separate but equal regions
4286 (no, really equal, in this case!), or
4287 2. Separate regions of unequal size.
4289 The worst case is usually No. 2. It means that (aside from
4290 potential need for getting the gap out of the way), there also
4291 needs to be a shifting of the text between the two regions. So
4292 if they are spread far apart, we are that much slower... sigh. */
4294 /* It must be pointed out that the really studly thing to do would
4295 be not to move the gap at all, but to leave it in place and work
4296 around it if necessary. This would be extremely efficient,
4297 especially considering that people are likely to do
4298 transpositions near where they are working interactively, which
4299 is exactly where the gap would be found. However, such code
4300 would be much harder to write and to read. So, if you are
4301 reading this comment and are feeling squirrely, by all means have
4302 a go! I just didn't feel like doing it, so I will simply move
4303 the gap the minimum distance to get it out of the way, and then
4304 deal with an unbroken array. */
4306 /* Make sure the gap won't interfere, by moving it out of the text
4307 we will operate on. */
4308 if (start1
< gap
&& gap
< end2
)
4310 if (gap
- start1
< end2
- gap
)
4316 start1_byte
= CHAR_TO_BYTE (start1
);
4317 start2_byte
= CHAR_TO_BYTE (start2
);
4318 len1_byte
= CHAR_TO_BYTE (end1
) - start1_byte
;
4319 len2_byte
= CHAR_TO_BYTE (end2
) - start2_byte
;
4321 #ifdef BYTE_COMBINING_DEBUG
4324 if (count_combining_before (BYTE_POS_ADDR (start2_byte
),
4325 len2_byte
, start1
, start1_byte
)
4326 || count_combining_before (BYTE_POS_ADDR (start1_byte
),
4327 len1_byte
, end2
, start2_byte
+ len2_byte
)
4328 || count_combining_after (BYTE_POS_ADDR (start1_byte
),
4329 len1_byte
, end2
, start2_byte
+ len2_byte
))
4334 if (count_combining_before (BYTE_POS_ADDR (start2_byte
),
4335 len2_byte
, start1
, start1_byte
)
4336 || count_combining_before (BYTE_POS_ADDR (start1_byte
),
4337 len1_byte
, start2
, start2_byte
)
4338 || count_combining_after (BYTE_POS_ADDR (start2_byte
),
4339 len2_byte
, end1
, start1_byte
+ len1_byte
)
4340 || count_combining_after (BYTE_POS_ADDR (start1_byte
),
4341 len1_byte
, end2
, start2_byte
+ len2_byte
))
4346 /* Hmmm... how about checking to see if the gap is large
4347 enough to use as the temporary storage? That would avoid an
4348 allocation... interesting. Later, don't fool with it now. */
4350 /* Working without memmove, for portability (sigh), so must be
4351 careful of overlapping subsections of the array... */
4353 if (end1
== start2
) /* adjacent regions */
4355 modify_region (current_buffer
, start1
, end2
, 0);
4356 record_change (start1
, len1
+ len2
);
4358 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4359 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4360 /* Don't use Fset_text_properties: that can cause GC, which can
4361 clobber objects stored in the tmp_intervals. */
4362 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4363 if (!NULL_INTERVAL_P (tmp_interval3
))
4364 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4366 /* First region smaller than second. */
4367 if (len1_byte
< len2_byte
)
4371 SAFE_ALLOCA (temp
, unsigned char *, len2_byte
);
4373 /* Don't precompute these addresses. We have to compute them
4374 at the last minute, because the relocating allocator might
4375 have moved the buffer around during the xmalloc. */
4376 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4377 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4379 memcpy (temp
, start2_addr
, len2_byte
);
4380 memcpy (start1_addr
+ len2_byte
, start1_addr
, len1_byte
);
4381 memcpy (start1_addr
, temp
, len2_byte
);
4385 /* First region not smaller than second. */
4389 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4390 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4391 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4392 memcpy (temp
, start1_addr
, len1_byte
);
4393 memcpy (start1_addr
, start2_addr
, len2_byte
);
4394 memcpy (start1_addr
+ len2_byte
, temp
, len1_byte
);
4397 graft_intervals_into_buffer (tmp_interval1
, start1
+ len2
,
4398 len1
, current_buffer
, 0);
4399 graft_intervals_into_buffer (tmp_interval2
, start1
,
4400 len2
, current_buffer
, 0);
4401 update_compositions (start1
, start1
+ len2
, CHECK_BORDER
);
4402 update_compositions (start1
+ len2
, end2
, CHECK_TAIL
);
4404 /* Non-adjacent regions, because end1 != start2, bleagh... */
4407 len_mid
= start2_byte
- (start1_byte
+ len1_byte
);
4409 if (len1_byte
== len2_byte
)
4410 /* Regions are same size, though, how nice. */
4414 modify_region (current_buffer
, start1
, end1
, 0);
4415 modify_region (current_buffer
, start2
, end2
, 0);
4416 record_change (start1
, len1
);
4417 record_change (start2
, len2
);
4418 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4419 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4421 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr1
, 0);
4422 if (!NULL_INTERVAL_P (tmp_interval3
))
4423 set_text_properties_1 (startr1
, endr1
, Qnil
, buf
, tmp_interval3
);
4425 tmp_interval3
= validate_interval_range (buf
, &startr2
, &endr2
, 0);
4426 if (!NULL_INTERVAL_P (tmp_interval3
))
4427 set_text_properties_1 (startr2
, endr2
, Qnil
, buf
, tmp_interval3
);
4429 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4430 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4431 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4432 memcpy (temp
, start1_addr
, len1_byte
);
4433 memcpy (start1_addr
, start2_addr
, len2_byte
);
4434 memcpy (start2_addr
, temp
, len1_byte
);
4437 graft_intervals_into_buffer (tmp_interval1
, start2
,
4438 len1
, current_buffer
, 0);
4439 graft_intervals_into_buffer (tmp_interval2
, start1
,
4440 len2
, current_buffer
, 0);
4443 else if (len1_byte
< len2_byte
) /* Second region larger than first */
4444 /* Non-adjacent & unequal size, area between must also be shifted. */
4448 modify_region (current_buffer
, start1
, end2
, 0);
4449 record_change (start1
, (end2
- start1
));
4450 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4451 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
4452 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4454 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4455 if (!NULL_INTERVAL_P (tmp_interval3
))
4456 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4458 /* holds region 2 */
4459 SAFE_ALLOCA (temp
, unsigned char *, len2_byte
);
4460 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4461 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4462 memcpy (temp
, start2_addr
, len2_byte
);
4463 memcpy (start1_addr
+ len_mid
+ len2_byte
, start1_addr
, len1_byte
);
4464 memmove (start1_addr
+ len2_byte
, start1_addr
+ len1_byte
, len_mid
);
4465 memcpy (start1_addr
, temp
, len2_byte
);
4468 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
4469 len1
, current_buffer
, 0);
4470 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
4471 len_mid
, current_buffer
, 0);
4472 graft_intervals_into_buffer (tmp_interval2
, start1
,
4473 len2
, current_buffer
, 0);
4476 /* Second region smaller than first. */
4480 record_change (start1
, (end2
- start1
));
4481 modify_region (current_buffer
, start1
, end2
, 0);
4483 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4484 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
4485 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4487 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4488 if (!NULL_INTERVAL_P (tmp_interval3
))
4489 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4491 /* holds region 1 */
4492 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4493 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4494 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4495 memcpy (temp
, start1_addr
, len1_byte
);
4496 memcpy (start1_addr
, start2_addr
, len2_byte
);
4497 memcpy (start1_addr
+ len2_byte
, start1_addr
+ len1_byte
, len_mid
);
4498 memcpy (start1_addr
+ len2_byte
+ len_mid
, temp
, len1_byte
);
4501 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
4502 len1
, current_buffer
, 0);
4503 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
4504 len_mid
, current_buffer
, 0);
4505 graft_intervals_into_buffer (tmp_interval2
, start1
,
4506 len2
, current_buffer
, 0);
4509 update_compositions (start1
, start1
+ len2
, CHECK_BORDER
);
4510 update_compositions (end2
- len1
, end2
, CHECK_BORDER
);
4513 /* When doing multiple transpositions, it might be nice
4514 to optimize this. Perhaps the markers in any one buffer
4515 should be organized in some sorted data tree. */
4516 if (NILP (leave_markers
))
4518 transpose_markers (start1
, end1
, start2
, end2
,
4519 start1_byte
, start1_byte
+ len1_byte
,
4520 start2_byte
, start2_byte
+ len2_byte
);
4521 fix_start_end_in_overlays (start1
, end2
);
4524 signal_after_change (start1
, end2
- start1
, end2
- start1
);
4530 syms_of_editfns (void)
4535 Qbuffer_access_fontify_functions
4536 = intern_c_string ("buffer-access-fontify-functions");
4537 staticpro (&Qbuffer_access_fontify_functions
);
4539 DEFVAR_LISP ("inhibit-field-text-motion", Vinhibit_field_text_motion
,
4540 doc
: /* Non-nil means text motion commands don't notice fields. */);
4541 Vinhibit_field_text_motion
= Qnil
;
4543 DEFVAR_LISP ("buffer-access-fontify-functions",
4544 Vbuffer_access_fontify_functions
,
4545 doc
: /* List of functions called by `buffer-substring' to fontify if necessary.
4546 Each function is called with two arguments which specify the range
4547 of the buffer being accessed. */);
4548 Vbuffer_access_fontify_functions
= Qnil
;
4552 obuf
= Fcurrent_buffer ();
4553 /* Do this here, because init_buffer_once is too early--it won't work. */
4554 Fset_buffer (Vprin1_to_string_buffer
);
4555 /* Make sure buffer-access-fontify-functions is nil in this buffer. */
4556 Fset (Fmake_local_variable (intern_c_string ("buffer-access-fontify-functions")),
4561 DEFVAR_LISP ("buffer-access-fontified-property",
4562 Vbuffer_access_fontified_property
,
4563 doc
: /* Property which (if non-nil) indicates text has been fontified.
4564 `buffer-substring' need not call the `buffer-access-fontify-functions'
4565 functions if all the text being accessed has this property. */);
4566 Vbuffer_access_fontified_property
= Qnil
;
4568 DEFVAR_LISP ("system-name", Vsystem_name
,
4569 doc
: /* The host name of the machine Emacs is running on. */);
4571 DEFVAR_LISP ("user-full-name", Vuser_full_name
,
4572 doc
: /* The full name of the user logged in. */);
4574 DEFVAR_LISP ("user-login-name", Vuser_login_name
,
4575 doc
: /* The user's name, taken from environment variables if possible. */);
4577 DEFVAR_LISP ("user-real-login-name", Vuser_real_login_name
,
4578 doc
: /* The user's name, based upon the real uid only. */);
4580 DEFVAR_LISP ("operating-system-release", Voperating_system_release
,
4581 doc
: /* The release of the operating system Emacs is running on. */);
4583 defsubr (&Spropertize
);
4584 defsubr (&Schar_equal
);
4585 defsubr (&Sgoto_char
);
4586 defsubr (&Sstring_to_char
);
4587 defsubr (&Schar_to_string
);
4588 defsubr (&Sbyte_to_string
);
4589 defsubr (&Sbuffer_substring
);
4590 defsubr (&Sbuffer_substring_no_properties
);
4591 defsubr (&Sbuffer_string
);
4593 defsubr (&Spoint_marker
);
4594 defsubr (&Smark_marker
);
4596 defsubr (&Sregion_beginning
);
4597 defsubr (&Sregion_end
);
4599 staticpro (&Qfield
);
4600 Qfield
= intern_c_string ("field");
4601 staticpro (&Qboundary
);
4602 Qboundary
= intern_c_string ("boundary");
4603 defsubr (&Sfield_beginning
);
4604 defsubr (&Sfield_end
);
4605 defsubr (&Sfield_string
);
4606 defsubr (&Sfield_string_no_properties
);
4607 defsubr (&Sdelete_field
);
4608 defsubr (&Sconstrain_to_field
);
4610 defsubr (&Sline_beginning_position
);
4611 defsubr (&Sline_end_position
);
4613 /* defsubr (&Smark); */
4614 /* defsubr (&Sset_mark); */
4615 defsubr (&Ssave_excursion
);
4616 defsubr (&Ssave_current_buffer
);
4618 defsubr (&Sbufsize
);
4619 defsubr (&Spoint_max
);
4620 defsubr (&Spoint_min
);
4621 defsubr (&Spoint_min_marker
);
4622 defsubr (&Spoint_max_marker
);
4623 defsubr (&Sgap_position
);
4624 defsubr (&Sgap_size
);
4625 defsubr (&Sposition_bytes
);
4626 defsubr (&Sbyte_to_position
);
4632 defsubr (&Sfollowing_char
);
4633 defsubr (&Sprevious_char
);
4634 defsubr (&Schar_after
);
4635 defsubr (&Schar_before
);
4637 defsubr (&Sinsert_before_markers
);
4638 defsubr (&Sinsert_and_inherit
);
4639 defsubr (&Sinsert_and_inherit_before_markers
);
4640 defsubr (&Sinsert_char
);
4641 defsubr (&Sinsert_byte
);
4643 defsubr (&Suser_login_name
);
4644 defsubr (&Suser_real_login_name
);
4645 defsubr (&Suser_uid
);
4646 defsubr (&Suser_real_uid
);
4647 defsubr (&Suser_full_name
);
4648 defsubr (&Semacs_pid
);
4649 defsubr (&Scurrent_time
);
4650 defsubr (&Sget_internal_run_time
);
4651 defsubr (&Sformat_time_string
);
4652 defsubr (&Sfloat_time
);
4653 defsubr (&Sdecode_time
);
4654 defsubr (&Sencode_time
);
4655 defsubr (&Scurrent_time_string
);
4656 defsubr (&Scurrent_time_zone
);
4657 defsubr (&Sset_time_zone_rule
);
4658 defsubr (&Ssystem_name
);
4659 defsubr (&Smessage
);
4660 defsubr (&Smessage_box
);
4661 defsubr (&Smessage_or_box
);
4662 defsubr (&Scurrent_message
);
4665 defsubr (&Sinsert_buffer_substring
);
4666 defsubr (&Scompare_buffer_substrings
);
4667 defsubr (&Ssubst_char_in_region
);
4668 defsubr (&Stranslate_region_internal
);
4669 defsubr (&Sdelete_region
);
4670 defsubr (&Sdelete_and_extract_region
);
4672 defsubr (&Snarrow_to_region
);
4673 defsubr (&Ssave_restriction
);
4674 defsubr (&Stranspose_regions
);