1 /* Lisp functions pertaining to editing.
2 Copyright (C) 1985,86,87,89,93,94,95,96,97,98, 1999, 2000, 2001, 2002
3 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 2, or (at your option)
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; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
24 #include <sys/types.h>
39 #include "intervals.h"
50 #define MAX_10_EXP DBL_MAX_10_EXP
52 #define MAX_10_EXP 310
60 extern char **environ
;
63 extern Lisp_Object make_time
P_ ((time_t));
64 extern size_t emacs_strftimeu
P_ ((char *, size_t, const char *,
65 const struct tm
*, int));
66 static int tm_diff
P_ ((struct tm
*, struct tm
*));
67 static void find_field
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
, int *, Lisp_Object
, int *));
68 static void update_buffer_properties
P_ ((int, int));
69 static Lisp_Object region_limit
P_ ((int));
70 static int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
71 static size_t emacs_memftimeu
P_ ((char *, size_t, const char *,
72 size_t, const struct tm
*, int));
73 static void general_insert_function
P_ ((void (*) (unsigned char *, int),
74 void (*) (Lisp_Object
, int, int, int,
76 int, int, Lisp_Object
*));
77 static Lisp_Object subst_char_in_region_unwind
P_ ((Lisp_Object
));
78 static Lisp_Object subst_char_in_region_unwind_1
P_ ((Lisp_Object
));
79 static void transpose_markers
P_ ((int, int, int, int, int, int, int, int));
82 extern char *index
P_ ((const char *, int));
85 Lisp_Object Vbuffer_access_fontify_functions
;
86 Lisp_Object Qbuffer_access_fontify_functions
;
87 Lisp_Object Vbuffer_access_fontified_property
;
89 Lisp_Object Fuser_full_name
P_ ((Lisp_Object
));
91 /* Non-nil means don't stop at field boundary in text motion commands. */
93 Lisp_Object Vinhibit_field_text_motion
;
95 /* Some static data, and a function to initialize it for each run */
97 Lisp_Object Vsystem_name
;
98 Lisp_Object Vuser_real_login_name
; /* login name of current user ID */
99 Lisp_Object Vuser_full_name
; /* full name of current user */
100 Lisp_Object Vuser_login_name
; /* user name from LOGNAME or USER */
102 /* Symbol for the text property used to mark fields. */
106 /* A special value for Qfield properties. */
108 Lisp_Object Qboundary
;
115 register unsigned char *p
;
116 struct passwd
*pw
; /* password entry for the current user */
119 /* Set up system_name even when dumping. */
123 /* Don't bother with this on initial start when just dumping out */
126 #endif /* not CANNOT_DUMP */
128 pw
= (struct passwd
*) getpwuid (getuid ());
130 /* We let the real user name default to "root" because that's quite
131 accurate on MSDOG and because it lets Emacs find the init file.
132 (The DVX libraries override the Djgpp libraries here.) */
133 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "root");
135 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "unknown");
138 /* Get the effective user name, by consulting environment variables,
139 or the effective uid if those are unset. */
140 user_name
= (char *) getenv ("LOGNAME");
143 user_name
= (char *) getenv ("USERNAME"); /* it's USERNAME on NT */
144 #else /* WINDOWSNT */
145 user_name
= (char *) getenv ("USER");
146 #endif /* WINDOWSNT */
149 pw
= (struct passwd
*) getpwuid (geteuid ());
150 user_name
= (char *) (pw
? pw
->pw_name
: "unknown");
152 Vuser_login_name
= build_string (user_name
);
154 /* If the user name claimed in the environment vars differs from
155 the real uid, use the claimed name to find the full name. */
156 tem
= Fstring_equal (Vuser_login_name
, Vuser_real_login_name
);
157 Vuser_full_name
= Fuser_full_name (NILP (tem
)? make_number (geteuid())
160 p
= (unsigned char *) getenv ("NAME");
162 Vuser_full_name
= build_string (p
);
163 else if (NILP (Vuser_full_name
))
164 Vuser_full_name
= build_string ("unknown");
167 DEFUN ("char-to-string", Fchar_to_string
, Schar_to_string
, 1, 1, 0,
168 doc
: /* Convert arg CHAR to a string containing that character.
169 usage: (char-to-string CHAR) */)
171 Lisp_Object character
;
174 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
176 CHECK_NUMBER (character
);
178 len
= (SINGLE_BYTE_CHAR_P (XFASTINT (character
))
179 ? (*str
= (unsigned char)(XFASTINT (character
)), 1)
180 : char_to_string (XFASTINT (character
), str
));
181 return make_string_from_bytes (str
, 1, len
);
184 DEFUN ("string-to-char", Fstring_to_char
, Sstring_to_char
, 1, 1, 0,
185 doc
: /* Convert arg STRING to a character, the first character of that string.
186 A multibyte character is handled correctly. */)
188 register Lisp_Object string
;
190 register Lisp_Object val
;
191 register struct Lisp_String
*p
;
192 CHECK_STRING (string
);
193 p
= XSTRING (string
);
196 if (STRING_MULTIBYTE (string
))
197 XSETFASTINT (val
, STRING_CHAR (p
->data
, STRING_BYTES (p
)));
199 XSETFASTINT (val
, p
->data
[0]);
202 XSETFASTINT (val
, 0);
207 buildmark (charpos
, bytepos
)
208 int charpos
, bytepos
;
210 register Lisp_Object mark
;
211 mark
= Fmake_marker ();
212 set_marker_both (mark
, Qnil
, charpos
, bytepos
);
216 DEFUN ("point", Fpoint
, Spoint
, 0, 0, 0,
217 doc
: /* Return value of point, as an integer.
218 Beginning of buffer is position (point-min). */)
222 XSETFASTINT (temp
, PT
);
226 DEFUN ("point-marker", Fpoint_marker
, Spoint_marker
, 0, 0, 0,
227 doc
: /* Return value of point, as a marker object. */)
230 return buildmark (PT
, PT_BYTE
);
234 clip_to_bounds (lower
, num
, upper
)
235 int lower
, num
, upper
;
239 else if (num
> upper
)
245 DEFUN ("goto-char", Fgoto_char
, Sgoto_char
, 1, 1, "NGoto char: ",
246 doc
: /* Set point to POSITION, a number or marker.
247 Beginning of buffer is position (point-min), end is (point-max).
248 If the position is in the middle of a multibyte form,
249 the actual point is set at the head of the multibyte form
250 except in the case that `enable-multibyte-characters' is nil. */)
252 register Lisp_Object position
;
256 if (MARKERP (position
)
257 && current_buffer
== XMARKER (position
)->buffer
)
259 pos
= marker_position (position
);
261 SET_PT_BOTH (BEGV
, BEGV_BYTE
);
263 SET_PT_BOTH (ZV
, ZV_BYTE
);
265 SET_PT_BOTH (pos
, marker_byte_position (position
));
270 CHECK_NUMBER_COERCE_MARKER (position
);
272 pos
= clip_to_bounds (BEGV
, XINT (position
), ZV
);
278 /* Return the start or end position of the region.
279 BEGINNINGP non-zero means return the start.
280 If there is no region active, signal an error. */
283 region_limit (beginningp
)
286 extern Lisp_Object Vmark_even_if_inactive
; /* Defined in callint.c. */
289 if (!NILP (Vtransient_mark_mode
)
290 && NILP (Vmark_even_if_inactive
)
291 && NILP (current_buffer
->mark_active
))
292 Fsignal (Qmark_inactive
, Qnil
);
294 m
= Fmarker_position (current_buffer
->mark
);
296 error ("The mark is not set now, so there is no region");
298 if ((PT
< XFASTINT (m
)) == beginningp
)
299 m
= make_number (PT
);
303 DEFUN ("region-beginning", Fregion_beginning
, Sregion_beginning
, 0, 0, 0,
304 doc
: /* Return position of beginning of region, as an integer. */)
307 return region_limit (1);
310 DEFUN ("region-end", Fregion_end
, Sregion_end
, 0, 0, 0,
311 doc
: /* Return position of end of region, as an integer. */)
314 return region_limit (0);
317 DEFUN ("mark-marker", Fmark_marker
, Smark_marker
, 0, 0, 0,
318 doc
: /* Return this buffer's mark, as a marker object.
319 Watch out! Moving this marker changes the mark position.
320 If you set the marker not to point anywhere, the buffer will have no mark. */)
323 return current_buffer
->mark
;
327 /* Find the field surrounding POS in *BEG and *END. If POS is nil,
328 the value of point is used instead. If BEG or END null,
329 means don't store the beginning or end of the field.
331 BEG_LIMIT and END_LIMIT serve to limit the ranged of the returned
332 results; they do not effect boundary behavior.
334 If MERGE_AT_BOUNDARY is nonzero, then if POS is at the very first
335 position of a field, then the beginning of the previous field is
336 returned instead of the beginning of POS's field (since the end of a
337 field is actually also the beginning of the next input field, this
338 behavior is sometimes useful). Additionally in the MERGE_AT_BOUNDARY
339 true case, if two fields are separated by a field with the special
340 value `boundary', and POS lies within it, then the two separated
341 fields are considered to be adjacent, and POS between them, when
342 finding the beginning and ending of the "merged" field.
344 Either BEG or END may be 0, in which case the corresponding value
348 find_field (pos
, merge_at_boundary
, beg_limit
, beg
, end_limit
, end
)
350 Lisp_Object merge_at_boundary
;
351 Lisp_Object beg_limit
, end_limit
;
354 /* Fields right before and after the point. */
355 Lisp_Object before_field
, after_field
;
356 /* If the fields came from overlays, the associated overlays.
357 Qnil means they came from text-properties. */
358 Lisp_Object before_overlay
= Qnil
, after_overlay
= Qnil
;
359 /* 1 if POS counts as the start of a field. */
360 int at_field_start
= 0;
361 /* 1 if POS counts as the end of a field. */
362 int at_field_end
= 0;
365 XSETFASTINT (pos
, PT
);
367 CHECK_NUMBER_COERCE_MARKER (pos
);
370 = get_char_property_and_overlay (pos
, Qfield
, Qnil
, &after_overlay
);
372 = (XFASTINT (pos
) > BEGV
373 ? get_char_property_and_overlay (make_number (XINT (pos
) - 1),
378 /* See if we need to handle the case where MERGE_AT_BOUNDARY is nil
379 and POS is at beginning of a field, which can also be interpreted
380 as the end of the previous field. Note that the case where if
381 MERGE_AT_BOUNDARY is non-nil (see function comment) is actually the
382 more natural one; then we avoid treating the beginning of a field
384 if (NILP (merge_at_boundary
) && !EQ (after_field
, before_field
))
385 /* We are at a boundary, see which direction is inclusive. We
386 decide by seeing which field the `field' property sticks to. */
388 /* -1 means insertions go into before_field, 1 means they go
389 into after_field, 0 means neither. */
391 /* Whether the before/after_field come from overlays. */
392 int bop
= !NILP (before_overlay
);
393 int aop
= !NILP (after_overlay
);
395 if (bop
&& XMARKER (OVERLAY_END (before_overlay
))->insertion_type
== 1)
396 /* before_field is from an overlay, which expands upon
397 end-insertions. Note that it's possible for after_overlay to
398 also eat insertions here, but then they will overlap, and
399 there's not much we can do. */
402 && XMARKER (OVERLAY_START (after_overlay
))->insertion_type
== 0)
403 /* after_field is from an overlay, which expand to contain
407 /* Both fields come from overlays, but neither will contain any
411 /* before_field is an overlay that won't eat any insertion, but
412 after_field is from a text-property. Assume that the
413 text-property continues underneath the overlay, and so will
414 be inherited by any insertion, regardless of any stickiness
418 /* Similarly, when after_field is the overlay. */
421 /* Both fields come from text-properties. Look for explicit
422 stickiness properties. */
423 stickiness
= text_property_stickiness (Qfield
, pos
);
427 else if (stickiness
< 0)
430 /* STICKINESS == 0 means that any inserted text will get a
431 `field' char-property of nil, so check to see if that
432 matches either of the adjacent characters (this being a
433 kind of "stickiness by default"). */
435 if (NILP (before_field
))
436 at_field_end
= 1; /* Sticks to the left. */
437 else if (NILP (after_field
))
438 at_field_start
= 1; /* Sticks to the right. */
442 /* Note about special `boundary' fields:
444 Consider the case where the point (`.') is between the fields `x' and `y':
448 In this situation, if merge_at_boundary is true, we consider the
449 `x' and `y' fields as forming one big merged field, and so the end
450 of the field is the end of `y'.
452 However, if `x' and `y' are separated by a special `boundary' field
453 (a field with a `field' char-property of 'boundary), then we ignore
454 this special field when merging adjacent fields. Here's the same
455 situation, but with a `boundary' field between the `x' and `y' fields:
459 Here, if point is at the end of `x', the beginning of `y', or
460 anywhere in-between (within the `boundary' field), we merge all
461 three fields and consider the beginning as being the beginning of
462 the `x' field, and the end as being the end of the `y' field. */
467 /* POS is at the edge of a field, and we should consider it as
468 the beginning of the following field. */
469 *beg
= XFASTINT (pos
);
471 /* Find the previous field boundary. */
473 if (!NILP (merge_at_boundary
) && EQ (before_field
, Qboundary
))
474 /* Skip a `boundary' field. */
475 pos
= Fprevious_single_char_property_change (pos
, Qfield
, Qnil
,
478 pos
= Fprevious_single_char_property_change (pos
, Qfield
, Qnil
,
480 *beg
= NILP (pos
) ? BEGV
: XFASTINT (pos
);
487 /* POS is at the edge of a field, and we should consider it as
488 the end of the previous field. */
489 *end
= XFASTINT (pos
);
491 /* Find the next field boundary. */
493 if (!NILP (merge_at_boundary
) && EQ (after_field
, Qboundary
))
494 /* Skip a `boundary' field. */
495 pos
= Fnext_single_char_property_change (pos
, Qfield
, Qnil
,
498 pos
= Fnext_single_char_property_change (pos
, Qfield
, Qnil
,
500 *end
= NILP (pos
) ? ZV
: XFASTINT (pos
);
506 DEFUN ("delete-field", Fdelete_field
, Sdelete_field
, 0, 1, 0,
507 doc
: /* Delete the field surrounding POS.
508 A field is a region of text with the same `field' property.
509 If POS is nil, the value of point is used for POS. */)
514 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
516 del_range (beg
, end
);
520 DEFUN ("field-string", Ffield_string
, Sfield_string
, 0, 1, 0,
521 doc
: /* Return the contents of the field surrounding POS as a string.
522 A field is a region of text with the same `field' property.
523 If POS is nil, the value of point is used for POS. */)
528 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
529 return make_buffer_string (beg
, end
, 1);
532 DEFUN ("field-string-no-properties", Ffield_string_no_properties
, Sfield_string_no_properties
, 0, 1, 0,
533 doc
: /* Return the contents of the field around POS, without text-properties.
534 A field is a region of text with the same `field' property.
535 If POS is nil, the value of point is used for POS. */)
540 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
541 return make_buffer_string (beg
, end
, 0);
544 DEFUN ("field-beginning", Ffield_beginning
, Sfield_beginning
, 0, 3, 0,
545 doc
: /* Return the beginning of the field surrounding POS.
546 A field is a region of text with the same `field' property.
547 If POS is nil, the value of point is used for POS.
548 If ESCAPE-FROM-EDGE is non-nil and POS is at the beginning of its
549 field, then the beginning of the *previous* field is returned.
550 If LIMIT is non-nil, it is a buffer position; if the beginning of the field
551 is before LIMIT, then LIMIT will be returned instead. */)
552 (pos
, escape_from_edge
, limit
)
553 Lisp_Object pos
, escape_from_edge
, limit
;
556 find_field (pos
, escape_from_edge
, limit
, &beg
, Qnil
, 0);
557 return make_number (beg
);
560 DEFUN ("field-end", Ffield_end
, Sfield_end
, 0, 3, 0,
561 doc
: /* Return the end of the field surrounding POS.
562 A field is a region of text with the same `field' property.
563 If POS is nil, the value of point is used for POS.
564 If ESCAPE-FROM-EDGE is non-nil and POS is at the end of its field,
565 then the end of the *following* field is returned.
566 If LIMIT is non-nil, it is a buffer position; if the end of the field
567 is after LIMIT, then LIMIT will be returned instead. */)
568 (pos
, escape_from_edge
, limit
)
569 Lisp_Object pos
, escape_from_edge
, limit
;
572 find_field (pos
, escape_from_edge
, Qnil
, 0, limit
, &end
);
573 return make_number (end
);
576 DEFUN ("constrain-to-field", Fconstrain_to_field
, Sconstrain_to_field
, 2, 5, 0,
577 doc
: /* Return the position closest to NEW-POS that is in the same field as OLD-POS.
579 A field is a region of text with the same `field' property.
580 If NEW-POS is nil, then the current point is used instead, and set to the
581 constrained position if that is different.
583 If OLD-POS is at the boundary of two fields, then the allowable
584 positions for NEW-POS depends on the value of the optional argument
585 ESCAPE-FROM-EDGE: If ESCAPE-FROM-EDGE is nil, then NEW-POS is
586 constrained to the field that has the same `field' char-property
587 as any new characters inserted at OLD-POS, whereas if ESCAPE-FROM-EDGE
588 is non-nil, NEW-POS is constrained to the union of the two adjacent
589 fields. Additionally, if two fields are separated by another field with
590 the special value `boundary', then any point within this special field is
591 also considered to be `on the boundary'.
593 If the optional argument ONLY-IN-LINE is non-nil and constraining
594 NEW-POS would move it to a different line, NEW-POS is returned
595 unconstrained. This useful for commands that move by line, like
596 \\[next-line] or \\[beginning-of-line], which should generally respect field boundaries
597 only in the case where they can still move to the right line.
599 If the optional argument INHIBIT-CAPTURE-PROPERTY is non-nil, and OLD-POS has
600 a non-nil property of that name, then any field boundaries are ignored.
602 Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil. */)
603 (new_pos
, old_pos
, escape_from_edge
, only_in_line
, inhibit_capture_property
)
604 Lisp_Object new_pos
, old_pos
;
605 Lisp_Object escape_from_edge
, only_in_line
, inhibit_capture_property
;
607 /* If non-zero, then the original point, before re-positioning. */
611 /* Use the current point, and afterwards, set it. */
614 XSETFASTINT (new_pos
, PT
);
617 if (NILP (Vinhibit_field_text_motion
)
618 && !EQ (new_pos
, old_pos
)
619 && (!NILP (Fget_char_property (new_pos
, Qfield
, Qnil
))
620 || !NILP (Fget_char_property (old_pos
, Qfield
, Qnil
)))
621 && (NILP (inhibit_capture_property
)
622 || NILP (Fget_char_property(old_pos
, inhibit_capture_property
, Qnil
))))
623 /* NEW_POS is not within the same field as OLD_POS; try to
624 move NEW_POS so that it is. */
627 Lisp_Object field_bound
;
629 CHECK_NUMBER_COERCE_MARKER (new_pos
);
630 CHECK_NUMBER_COERCE_MARKER (old_pos
);
632 fwd
= (XFASTINT (new_pos
) > XFASTINT (old_pos
));
635 field_bound
= Ffield_end (old_pos
, escape_from_edge
, new_pos
);
637 field_bound
= Ffield_beginning (old_pos
, escape_from_edge
, new_pos
);
639 if (/* See if ESCAPE_FROM_EDGE caused FIELD_BOUND to jump to the
640 other side of NEW_POS, which would mean that NEW_POS is
641 already acceptable, and it's not necessary to constrain it
643 ((XFASTINT (field_bound
) < XFASTINT (new_pos
)) ? fwd
: !fwd
)
644 /* NEW_POS should be constrained, but only if either
645 ONLY_IN_LINE is nil (in which case any constraint is OK),
646 or NEW_POS and FIELD_BOUND are on the same line (in which
647 case the constraint is OK even if ONLY_IN_LINE is non-nil). */
648 && (NILP (only_in_line
)
649 /* This is the ONLY_IN_LINE case, check that NEW_POS and
650 FIELD_BOUND are on the same line by seeing whether
651 there's an intervening newline or not. */
652 || (scan_buffer ('\n',
653 XFASTINT (new_pos
), XFASTINT (field_bound
),
654 fwd
? -1 : 1, &shortage
, 1),
656 /* Constrain NEW_POS to FIELD_BOUND. */
657 new_pos
= field_bound
;
659 if (orig_point
&& XFASTINT (new_pos
) != orig_point
)
660 /* The NEW_POS argument was originally nil, so automatically set PT. */
661 SET_PT (XFASTINT (new_pos
));
668 DEFUN ("line-beginning-position",
669 Fline_beginning_position
, Sline_beginning_position
, 0, 1, 0,
670 doc
: /* Return the character position of the first character on the current line.
671 With argument N not nil or 1, move forward N - 1 lines first.
672 If scan reaches end of buffer, return that position.
674 The scan does not cross a field boundary unless doing so would move
675 beyond there to a different line; if N is nil or 1, and scan starts at a
676 field boundary, the scan stops as soon as it starts. To ignore field
677 boundaries bind `inhibit-field-text-motion' to t.
679 This function does not move point. */)
683 int orig
, orig_byte
, end
;
692 Fforward_line (make_number (XINT (n
) - 1));
695 SET_PT_BOTH (orig
, orig_byte
);
697 /* Return END constrained to the current input field. */
698 return Fconstrain_to_field (make_number (end
), make_number (orig
),
699 XINT (n
) != 1 ? Qt
: Qnil
,
703 DEFUN ("line-end-position", Fline_end_position
, Sline_end_position
, 0, 1, 0,
704 doc
: /* Return the character position of the last character on the current line.
705 With argument N not nil or 1, move forward N - 1 lines first.
706 If scan reaches end of buffer, return that position.
708 The scan does not cross a field boundary unless doing so would move
709 beyond there to a different line; if N is nil or 1, and scan starts at a
710 field boundary, the scan stops as soon as it starts. To ignore field
711 boundaries bind `inhibit-field-text-motion' to t.
713 This function does not move point. */)
725 end_pos
= find_before_next_newline (orig
, 0, XINT (n
) - (XINT (n
) <= 0));
727 /* Return END_POS constrained to the current input field. */
728 return Fconstrain_to_field (make_number (end_pos
), make_number (orig
),
734 save_excursion_save ()
736 int visible
= (XBUFFER (XWINDOW (selected_window
)->buffer
)
739 return Fcons (Fpoint_marker (),
740 Fcons (Fcopy_marker (current_buffer
->mark
, Qnil
),
741 Fcons (visible
? Qt
: Qnil
,
742 Fcons (current_buffer
->mark_active
,
747 save_excursion_restore (info
)
750 Lisp_Object tem
, tem1
, omark
, nmark
;
751 struct gcpro gcpro1
, gcpro2
, gcpro3
;
754 tem
= Fmarker_buffer (XCAR (info
));
755 /* If buffer being returned to is now deleted, avoid error */
756 /* Otherwise could get error here while unwinding to top level
758 /* In that case, Fmarker_buffer returns nil now. */
762 omark
= nmark
= Qnil
;
763 GCPRO3 (info
, omark
, nmark
);
770 unchain_marker (tem
);
775 omark
= Fmarker_position (current_buffer
->mark
);
776 Fset_marker (current_buffer
->mark
, tem
, Fcurrent_buffer ());
777 nmark
= Fmarker_position (tem
);
778 unchain_marker (tem
);
782 visible_p
= !NILP (XCAR (info
));
784 #if 0 /* We used to make the current buffer visible in the selected window
785 if that was true previously. That avoids some anomalies.
786 But it creates others, and it wasn't documented, and it is simpler
787 and cleaner never to alter the window/buffer connections. */
790 && current_buffer
!= XBUFFER (XWINDOW (selected_window
)->buffer
))
791 Fswitch_to_buffer (Fcurrent_buffer (), Qnil
);
797 tem1
= current_buffer
->mark_active
;
798 current_buffer
->mark_active
= tem
;
800 if (!NILP (Vrun_hooks
))
802 /* If mark is active now, and either was not active
803 or was at a different place, run the activate hook. */
804 if (! NILP (current_buffer
->mark_active
))
806 if (! EQ (omark
, nmark
))
807 call1 (Vrun_hooks
, intern ("activate-mark-hook"));
809 /* If mark has ceased to be active, run deactivate hook. */
810 else if (! NILP (tem1
))
811 call1 (Vrun_hooks
, intern ("deactivate-mark-hook"));
814 /* If buffer was visible in a window, and a different window was
815 selected, and the old selected window is still showing this
816 buffer, restore point in that window. */
819 && !EQ (tem
, selected_window
)
820 && (tem1
= XWINDOW (tem
)->buffer
,
821 (/* Window is live... */
823 /* ...and it shows the current buffer. */
824 && XBUFFER (tem1
) == current_buffer
)))
825 Fset_window_point (tem
, make_number (PT
));
831 DEFUN ("save-excursion", Fsave_excursion
, Ssave_excursion
, 0, UNEVALLED
, 0,
832 doc
: /* Save point, mark, and current buffer; execute BODY; restore those things.
833 Executes BODY just like `progn'.
834 The values of point, mark and the current buffer are restored
835 even in case of abnormal exit (throw or error).
836 The state of activation of the mark is also restored.
838 This construct does not save `deactivate-mark', and therefore
839 functions that change the buffer will still cause deactivation
840 of the mark at the end of the command. To prevent that, bind
841 `deactivate-mark' with `let'.
843 usage: (save-excursion &rest BODY) */)
847 register Lisp_Object val
;
848 int count
= specpdl_ptr
- specpdl
;
850 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
853 return unbind_to (count
, val
);
856 DEFUN ("save-current-buffer", Fsave_current_buffer
, Ssave_current_buffer
, 0, UNEVALLED
, 0,
857 doc
: /* Save the current buffer; execute BODY; restore the current buffer.
858 Executes BODY just like `progn'.
859 usage: (save-current-buffer &rest BODY) */)
864 int count
= specpdl_ptr
- specpdl
;
866 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
869 return unbind_to (count
, val
);
872 DEFUN ("buffer-size", Fbufsize
, Sbufsize
, 0, 1, 0,
873 doc
: /* Return the number of characters in the current buffer.
874 If BUFFER, return the number of characters in that buffer instead. */)
879 return make_number (Z
- BEG
);
882 CHECK_BUFFER (buffer
);
883 return make_number (BUF_Z (XBUFFER (buffer
))
884 - BUF_BEG (XBUFFER (buffer
)));
888 DEFUN ("point-min", Fpoint_min
, Spoint_min
, 0, 0, 0,
889 doc
: /* Return the minimum permissible value of point in the current buffer.
890 This is 1, unless narrowing (a buffer restriction) is in effect. */)
894 XSETFASTINT (temp
, BEGV
);
898 DEFUN ("point-min-marker", Fpoint_min_marker
, Spoint_min_marker
, 0, 0, 0,
899 doc
: /* Return a marker to the minimum permissible value of point in this buffer.
900 This is the beginning, unless narrowing (a buffer restriction) is in effect. */)
903 return buildmark (BEGV
, BEGV_BYTE
);
906 DEFUN ("point-max", Fpoint_max
, Spoint_max
, 0, 0, 0,
907 doc
: /* Return the maximum permissible value of point in the current buffer.
908 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
909 is in effect, in which case it is less. */)
913 XSETFASTINT (temp
, ZV
);
917 DEFUN ("point-max-marker", Fpoint_max_marker
, Spoint_max_marker
, 0, 0, 0,
918 doc
: /* Return a marker to the maximum permissible value of point in this buffer.
919 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
920 is in effect, in which case it is less. */)
923 return buildmark (ZV
, ZV_BYTE
);
926 DEFUN ("gap-position", Fgap_position
, Sgap_position
, 0, 0, 0,
927 doc
: /* Return the position of the gap, in the current buffer.
928 See also `gap-size'. */)
932 XSETFASTINT (temp
, GPT
);
936 DEFUN ("gap-size", Fgap_size
, Sgap_size
, 0, 0, 0,
937 doc
: /* Return the size of the current buffer's gap.
938 See also `gap-position'. */)
942 XSETFASTINT (temp
, GAP_SIZE
);
946 DEFUN ("position-bytes", Fposition_bytes
, Sposition_bytes
, 1, 1, 0,
947 doc
: /* Return the byte position for character position POSITION.
948 If POSITION is out of range, the value is nil. */)
950 Lisp_Object position
;
952 CHECK_NUMBER_COERCE_MARKER (position
);
953 if (XINT (position
) < BEG
|| XINT (position
) > Z
)
955 return make_number (CHAR_TO_BYTE (XINT (position
)));
958 DEFUN ("byte-to-position", Fbyte_to_position
, Sbyte_to_position
, 1, 1, 0,
959 doc
: /* Return the character position for byte position BYTEPOS.
960 If BYTEPOS is out of range, the value is nil. */)
964 CHECK_NUMBER (bytepos
);
965 if (XINT (bytepos
) < BEG_BYTE
|| XINT (bytepos
) > Z_BYTE
)
967 return make_number (BYTE_TO_CHAR (XINT (bytepos
)));
970 DEFUN ("following-char", Ffollowing_char
, Sfollowing_char
, 0, 0, 0,
971 doc
: /* Return the character following point, as a number.
972 At the end of the buffer or accessible region, return 0. */)
977 XSETFASTINT (temp
, 0);
979 XSETFASTINT (temp
, FETCH_CHAR (PT_BYTE
));
983 DEFUN ("preceding-char", Fprevious_char
, Sprevious_char
, 0, 0, 0,
984 doc
: /* Return the character preceding point, as a number.
985 At the beginning of the buffer or accessible region, return 0. */)
990 XSETFASTINT (temp
, 0);
991 else if (!NILP (current_buffer
->enable_multibyte_characters
))
995 XSETFASTINT (temp
, FETCH_CHAR (pos
));
998 XSETFASTINT (temp
, FETCH_BYTE (PT_BYTE
- 1));
1002 DEFUN ("bobp", Fbobp
, Sbobp
, 0, 0, 0,
1003 doc
: /* Return t if point is at the beginning of the buffer.
1004 If the buffer is narrowed, this means the beginning of the narrowed part. */)
1012 DEFUN ("eobp", Feobp
, Seobp
, 0, 0, 0,
1013 doc
: /* Return t if point is at the end of the buffer.
1014 If the buffer is narrowed, this means the end of the narrowed part. */)
1022 DEFUN ("bolp", Fbolp
, Sbolp
, 0, 0, 0,
1023 doc
: /* Return t if point is at the beginning of a line. */)
1026 if (PT
== BEGV
|| FETCH_BYTE (PT_BYTE
- 1) == '\n')
1031 DEFUN ("eolp", Feolp
, Seolp
, 0, 0, 0,
1032 doc
: /* Return t if point is at the end of a line.
1033 `End of a line' includes point being at the end of the buffer. */)
1036 if (PT
== ZV
|| FETCH_BYTE (PT_BYTE
) == '\n')
1041 DEFUN ("char-after", Fchar_after
, Schar_after
, 0, 1, 0,
1042 doc
: /* Return character in current buffer at position POS.
1043 POS is an integer or a marker.
1044 If POS is out of range, the value is nil. */)
1048 register int pos_byte
;
1053 XSETFASTINT (pos
, PT
);
1058 pos_byte
= marker_byte_position (pos
);
1059 if (pos_byte
< BEGV_BYTE
|| pos_byte
>= ZV_BYTE
)
1064 CHECK_NUMBER_COERCE_MARKER (pos
);
1065 if (XINT (pos
) < BEGV
|| XINT (pos
) >= ZV
)
1068 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
1071 return make_number (FETCH_CHAR (pos_byte
));
1074 DEFUN ("char-before", Fchar_before
, Schar_before
, 0, 1, 0,
1075 doc
: /* Return character in current buffer preceding position POS.
1076 POS is an integer or a marker.
1077 If POS is out of range, the value is nil. */)
1081 register Lisp_Object val
;
1082 register int pos_byte
;
1087 XSETFASTINT (pos
, PT
);
1092 pos_byte
= marker_byte_position (pos
);
1094 if (pos_byte
<= BEGV_BYTE
|| pos_byte
> ZV_BYTE
)
1099 CHECK_NUMBER_COERCE_MARKER (pos
);
1101 if (XINT (pos
) <= BEGV
|| XINT (pos
) > ZV
)
1104 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
1107 if (!NILP (current_buffer
->enable_multibyte_characters
))
1110 XSETFASTINT (val
, FETCH_CHAR (pos_byte
));
1115 XSETFASTINT (val
, FETCH_BYTE (pos_byte
));
1120 DEFUN ("user-login-name", Fuser_login_name
, Suser_login_name
, 0, 1, 0,
1121 doc
: /* Return the name under which the user logged in, as a string.
1122 This is based on the effective uid, not the real uid.
1123 Also, if the environment variable LOGNAME or USER is set,
1124 that determines the value of this function.
1126 If optional argument UID is an integer, return the login name of the user
1127 with that uid, or nil if there is no such user. */)
1133 /* Set up the user name info if we didn't do it before.
1134 (That can happen if Emacs is dumpable
1135 but you decide to run `temacs -l loadup' and not dump. */
1136 if (INTEGERP (Vuser_login_name
))
1140 return Vuser_login_name
;
1143 pw
= (struct passwd
*) getpwuid (XINT (uid
));
1144 return (pw
? build_string (pw
->pw_name
) : Qnil
);
1147 DEFUN ("user-real-login-name", Fuser_real_login_name
, Suser_real_login_name
,
1149 doc
: /* Return the name of the user's real uid, as a string.
1150 This ignores the environment variables LOGNAME and USER, so it differs from
1151 `user-login-name' when running under `su'. */)
1154 /* Set up the user name info if we didn't do it before.
1155 (That can happen if Emacs is dumpable
1156 but you decide to run `temacs -l loadup' and not dump. */
1157 if (INTEGERP (Vuser_login_name
))
1159 return Vuser_real_login_name
;
1162 DEFUN ("user-uid", Fuser_uid
, Suser_uid
, 0, 0, 0,
1163 doc
: /* Return the effective uid of Emacs.
1164 Value is an integer or float, depending on the value. */)
1167 return make_fixnum_or_float (geteuid ());
1170 DEFUN ("user-real-uid", Fuser_real_uid
, Suser_real_uid
, 0, 0, 0,
1171 doc
: /* Return the real uid of Emacs.
1172 Value is an integer or float, depending on the value. */)
1175 return make_fixnum_or_float (getuid ());
1178 DEFUN ("user-full-name", Fuser_full_name
, Suser_full_name
, 0, 1, 0,
1179 doc
: /* Return the full name of the user logged in, as a string.
1180 If the full name corresponding to Emacs's userid is not known,
1183 If optional argument UID is an integer or float, return the full name
1184 of the user with that uid, or nil if there is no such user.
1185 If UID is a string, return the full name of the user with that login
1186 name, or nil if there is no such user. */)
1191 register unsigned char *p
, *q
;
1195 return Vuser_full_name
;
1196 else if (NUMBERP (uid
))
1197 pw
= (struct passwd
*) getpwuid ((uid_t
) XFLOATINT (uid
));
1198 else if (STRINGP (uid
))
1199 pw
= (struct passwd
*) getpwnam (XSTRING (uid
)->data
);
1201 error ("Invalid UID specification");
1206 p
= (unsigned char *) USER_FULL_NAME
;
1207 /* Chop off everything after the first comma. */
1208 q
= (unsigned char *) index (p
, ',');
1209 full
= make_string (p
, q
? q
- p
: strlen (p
));
1211 #ifdef AMPERSAND_FULL_NAME
1212 p
= XSTRING (full
)->data
;
1213 q
= (unsigned char *) index (p
, '&');
1214 /* Substitute the login name for the &, upcasing the first character. */
1217 register unsigned char *r
;
1220 login
= Fuser_login_name (make_number (pw
->pw_uid
));
1221 r
= (unsigned char *) alloca (strlen (p
) + XSTRING (login
)->size
+ 1);
1222 bcopy (p
, r
, q
- p
);
1224 strcat (r
, XSTRING (login
)->data
);
1225 r
[q
- p
] = UPCASE (r
[q
- p
]);
1227 full
= build_string (r
);
1229 #endif /* AMPERSAND_FULL_NAME */
1234 DEFUN ("system-name", Fsystem_name
, Ssystem_name
, 0, 0, 0,
1235 doc
: /* Return the name of the machine you are running on, as a string. */)
1238 return Vsystem_name
;
1241 /* For the benefit of callers who don't want to include lisp.h */
1246 if (STRINGP (Vsystem_name
))
1247 return (char *) XSTRING (Vsystem_name
)->data
;
1252 DEFUN ("emacs-pid", Femacs_pid
, Semacs_pid
, 0, 0, 0,
1253 doc
: /* Return the process ID of Emacs, as an integer. */)
1256 return make_number (getpid ());
1259 DEFUN ("current-time", Fcurrent_time
, Scurrent_time
, 0, 0, 0,
1260 doc
: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00.
1261 The time is returned as a list of three integers. The first has the
1262 most significant 16 bits of the seconds, while the second has the
1263 least significant 16 bits. The third integer gives the microsecond
1266 The microsecond count is zero on systems that do not provide
1267 resolution finer than a second. */)
1271 Lisp_Object result
[3];
1274 XSETINT (result
[0], (EMACS_SECS (t
) >> 16) & 0xffff);
1275 XSETINT (result
[1], (EMACS_SECS (t
) >> 0) & 0xffff);
1276 XSETINT (result
[2], EMACS_USECS (t
));
1278 return Flist (3, result
);
1283 lisp_time_argument (specified_time
, result
, usec
)
1284 Lisp_Object specified_time
;
1288 if (NILP (specified_time
))
1295 *usec
= EMACS_USECS (t
);
1296 *result
= EMACS_SECS (t
);
1300 return time (result
) != -1;
1304 Lisp_Object high
, low
;
1305 high
= Fcar (specified_time
);
1306 CHECK_NUMBER (high
);
1307 low
= Fcdr (specified_time
);
1312 Lisp_Object usec_l
= Fcdr (low
);
1314 usec_l
= Fcar (usec_l
);
1319 CHECK_NUMBER (usec_l
);
1320 *usec
= XINT (usec_l
);
1328 *result
= (XINT (high
) << 16) + (XINT (low
) & 0xffff);
1329 return *result
>> 16 == XINT (high
);
1333 DEFUN ("float-time", Ffloat_time
, Sfloat_time
, 0, 1, 0,
1334 doc
: /* Return the current time, as a float number of seconds since the epoch.
1335 If an argument is given, it specifies a time to convert to float
1336 instead of the current time. The argument should have the forms:
1337 (HIGH . LOW) or (HIGH LOW USEC) or (HIGH LOW . USEC).
1338 Thus, you can use times obtained from `current-time'
1339 and from `file-attributes'.
1341 WARNING: Since the result is floating point, it may not be exact.
1342 Do not use this function if precise time stamps are required. */)
1344 Lisp_Object specified_time
;
1349 if (! lisp_time_argument (specified_time
, &sec
, &usec
))
1350 error ("Invalid time specification");
1352 return make_float ((sec
* 1e6
+ usec
) / 1e6
);
1355 /* Write information into buffer S of size MAXSIZE, according to the
1356 FORMAT of length FORMAT_LEN, using time information taken from *TP.
1357 Default to Universal Time if UT is nonzero, local time otherwise.
1358 Return the number of bytes written, not including the terminating
1359 '\0'. If S is NULL, nothing will be written anywhere; so to
1360 determine how many bytes would be written, use NULL for S and
1361 ((size_t) -1) for MAXSIZE.
1363 This function behaves like emacs_strftimeu, except it allows null
1366 emacs_memftimeu (s
, maxsize
, format
, format_len
, tp
, ut
)
1371 const struct tm
*tp
;
1376 /* Loop through all the null-terminated strings in the format
1377 argument. Normally there's just one null-terminated string, but
1378 there can be arbitrarily many, concatenated together, if the
1379 format contains '\0' bytes. emacs_strftimeu stops at the first
1380 '\0' byte so we must invoke it separately for each such string. */
1389 result
= emacs_strftimeu (s
, maxsize
, format
, tp
, ut
);
1393 if (result
== 0 && s
[0] != '\0')
1398 maxsize
-= result
+ 1;
1400 len
= strlen (format
);
1401 if (len
== format_len
)
1405 format_len
-= len
+ 1;
1409 DEFUN ("format-time-string", Fformat_time_string
, Sformat_time_string
, 1, 3, 0,
1410 doc
: /* Use FORMAT-STRING to format the time TIME, or now if omitted.
1411 TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as returned by
1412 `current-time' or `file-attributes'.
1413 The third, optional, argument UNIVERSAL, if non-nil, means describe TIME
1414 as Universal Time; nil means describe TIME in the local time zone.
1415 The value is a copy of FORMAT-STRING, but with certain constructs replaced
1416 by text that describes the specified date and time in TIME:
1418 %Y is the year, %y within the century, %C the century.
1419 %G is the year corresponding to the ISO week, %g within the century.
1420 %m is the numeric month.
1421 %b and %h are the locale's abbreviated month name, %B the full name.
1422 %d is the day of the month, zero-padded, %e is blank-padded.
1423 %u is the numeric day of week from 1 (Monday) to 7, %w from 0 (Sunday) to 6.
1424 %a is the locale's abbreviated name of the day of week, %A the full name.
1425 %U is the week number starting on Sunday, %W starting on Monday,
1426 %V according to ISO 8601.
1427 %j is the day of the year.
1429 %H is the hour on a 24-hour clock, %I is on a 12-hour clock, %k is like %H
1430 only blank-padded, %l is like %I blank-padded.
1431 %p is the locale's equivalent of either AM or PM.
1434 %Z is the time zone name, %z is the numeric form.
1435 %s is the number of seconds since 1970-01-01 00:00:00 +0000.
1437 %c is the locale's date and time format.
1438 %x is the locale's "preferred" date format.
1439 %D is like "%m/%d/%y".
1441 %R is like "%H:%M", %T is like "%H:%M:%S", %r is like "%I:%M:%S %p".
1442 %X is the locale's "preferred" time format.
1444 Finally, %n is a newline, %t is a tab, %% is a literal %.
1446 Certain flags and modifiers are available with some format controls.
1447 The flags are `_', `-', `^' and `#'. For certain characters X,
1448 %_X is like %X, but padded with blanks; %-X is like %X,
1449 ut without padding. %^X is like %X but with all textual
1450 characters up-cased; %#X is like %X but with letter-case of
1451 all textual characters reversed.
1452 %NX (where N stands for an integer) is like %X,
1453 but takes up at least N (a number) positions.
1454 The modifiers are `E' and `O'. For certain characters X,
1455 %EX is a locale's alternative version of %X;
1456 %OX is like %X, but uses the locale's number symbols.
1458 For example, to produce full ISO 8601 format, use "%Y-%m-%dT%T%z". */)
1459 (format_string
, time
, universal
)
1460 Lisp_Object format_string
, time
, universal
;
1465 int ut
= ! NILP (universal
);
1467 CHECK_STRING (format_string
);
1469 if (! lisp_time_argument (time
, &value
, NULL
))
1470 error ("Invalid time specification");
1472 format_string
= code_convert_string_norecord (format_string
,
1473 Vlocale_coding_system
, 1);
1475 /* This is probably enough. */
1476 size
= STRING_BYTES (XSTRING (format_string
)) * 6 + 50;
1478 tm
= ut
? gmtime (&value
) : localtime (&value
);
1480 error ("Specified time is not representable");
1482 synchronize_system_time_locale ();
1486 char *buf
= (char *) alloca (size
+ 1);
1490 result
= emacs_memftimeu (buf
, size
, XSTRING (format_string
)->data
,
1491 STRING_BYTES (XSTRING (format_string
)),
1493 if ((result
> 0 && result
< size
) || (result
== 0 && buf
[0] == '\0'))
1494 return code_convert_string_norecord (make_string (buf
, result
),
1495 Vlocale_coding_system
, 0);
1497 /* If buffer was too small, make it bigger and try again. */
1498 result
= emacs_memftimeu (NULL
, (size_t) -1,
1499 XSTRING (format_string
)->data
,
1500 STRING_BYTES (XSTRING (format_string
)),
1506 DEFUN ("decode-time", Fdecode_time
, Sdecode_time
, 0, 1, 0,
1507 doc
: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).
1508 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED)
1509 or (HIGH . LOW), as from `current-time' and `file-attributes', or `nil'
1510 to use the current time. The list has the following nine members:
1511 SEC is an integer between 0 and 60; SEC is 60 for a leap second, which
1512 only some operating systems support. MINUTE is an integer between 0 and 59.
1513 HOUR is an integer between 0 and 23. DAY is an integer between 1 and 31.
1514 MONTH is an integer between 1 and 12. YEAR is an integer indicating the
1515 four-digit year. DOW is the day of week, an integer between 0 and 6, where
1516 0 is Sunday. DST is t if daylight savings time is effect, otherwise nil.
1517 ZONE is an integer indicating the number of seconds east of Greenwich.
1518 (Note that Common Lisp has different meanings for DOW and ZONE.) */)
1520 Lisp_Object specified_time
;
1524 struct tm
*decoded_time
;
1525 Lisp_Object list_args
[9];
1527 if (! lisp_time_argument (specified_time
, &time_spec
, NULL
))
1528 error ("Invalid time specification");
1530 decoded_time
= localtime (&time_spec
);
1532 error ("Specified time is not representable");
1533 XSETFASTINT (list_args
[0], decoded_time
->tm_sec
);
1534 XSETFASTINT (list_args
[1], decoded_time
->tm_min
);
1535 XSETFASTINT (list_args
[2], decoded_time
->tm_hour
);
1536 XSETFASTINT (list_args
[3], decoded_time
->tm_mday
);
1537 XSETFASTINT (list_args
[4], decoded_time
->tm_mon
+ 1);
1538 XSETINT (list_args
[5], decoded_time
->tm_year
+ 1900);
1539 XSETFASTINT (list_args
[6], decoded_time
->tm_wday
);
1540 list_args
[7] = (decoded_time
->tm_isdst
)? Qt
: Qnil
;
1542 /* Make a copy, in case gmtime modifies the struct. */
1543 save_tm
= *decoded_time
;
1544 decoded_time
= gmtime (&time_spec
);
1545 if (decoded_time
== 0)
1546 list_args
[8] = Qnil
;
1548 XSETINT (list_args
[8], tm_diff (&save_tm
, decoded_time
));
1549 return Flist (9, list_args
);
1552 DEFUN ("encode-time", Fencode_time
, Sencode_time
, 6, MANY
, 0,
1553 doc
: /* Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
1554 This is the reverse operation of `decode-time', which see.
1555 ZONE defaults to the current time zone rule. This can
1556 be a string or t (as from `set-time-zone-rule'), or it can be a list
1557 \(as from `current-time-zone') or an integer (as from `decode-time')
1558 applied without consideration for daylight savings time.
1560 You can pass more than 7 arguments; then the first six arguments
1561 are used as SECOND through YEAR, and the *last* argument is used as ZONE.
1562 The intervening arguments are ignored.
1563 This feature lets (apply 'encode-time (decode-time ...)) work.
1565 Out-of-range values for SEC, MINUTE, HOUR, DAY, or MONTH are allowed;
1566 for example, a DAY of 0 means the day preceding the given month.
1567 Year numbers less than 100 are treated just like other year numbers.
1568 If you want them to stand for years in this century, you must do that yourself.
1570 usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */)
1573 register Lisp_Object
*args
;
1577 Lisp_Object zone
= (nargs
> 6 ? args
[nargs
- 1] : Qnil
);
1579 CHECK_NUMBER (args
[0]); /* second */
1580 CHECK_NUMBER (args
[1]); /* minute */
1581 CHECK_NUMBER (args
[2]); /* hour */
1582 CHECK_NUMBER (args
[3]); /* day */
1583 CHECK_NUMBER (args
[4]); /* month */
1584 CHECK_NUMBER (args
[5]); /* year */
1586 tm
.tm_sec
= XINT (args
[0]);
1587 tm
.tm_min
= XINT (args
[1]);
1588 tm
.tm_hour
= XINT (args
[2]);
1589 tm
.tm_mday
= XINT (args
[3]);
1590 tm
.tm_mon
= XINT (args
[4]) - 1;
1591 tm
.tm_year
= XINT (args
[5]) - 1900;
1597 time
= mktime (&tm
);
1602 char **oldenv
= environ
, **newenv
;
1606 else if (STRINGP (zone
))
1607 tzstring
= (char *) XSTRING (zone
)->data
;
1608 else if (INTEGERP (zone
))
1610 int abszone
= abs (XINT (zone
));
1611 sprintf (tzbuf
, "XXX%s%d:%02d:%02d", "-" + (XINT (zone
) < 0),
1612 abszone
/ (60*60), (abszone
/60) % 60, abszone
% 60);
1616 error ("Invalid time zone specification");
1618 /* Set TZ before calling mktime; merely adjusting mktime's returned
1619 value doesn't suffice, since that would mishandle leap seconds. */
1620 set_time_zone_rule (tzstring
);
1622 time
= mktime (&tm
);
1624 /* Restore TZ to previous value. */
1628 #ifdef LOCALTIME_CACHE
1633 if (time
== (time_t) -1)
1634 error ("Specified time is not representable");
1636 return make_time (time
);
1639 DEFUN ("current-time-string", Fcurrent_time_string
, Scurrent_time_string
, 0, 1, 0,
1640 doc
: /* Return the current time, as a human-readable string.
1641 Programs can use this function to decode a time,
1642 since the number of columns in each field is fixed.
1643 The format is `Sun Sep 16 01:03:52 1973'.
1644 However, see also the functions `decode-time' and `format-time-string'
1645 which provide a much more powerful and general facility.
1647 If an argument is given, it specifies a time to format
1648 instead of the current time. The argument should have the form:
1651 (HIGH LOW . IGNORED).
1652 Thus, you can use times obtained from `current-time'
1653 and from `file-attributes'. */)
1655 Lisp_Object specified_time
;
1661 if (! lisp_time_argument (specified_time
, &value
, NULL
))
1663 tem
= (char *) ctime (&value
);
1665 strncpy (buf
, tem
, 24);
1668 return build_string (buf
);
1671 #define TM_YEAR_BASE 1900
1673 /* Yield A - B, measured in seconds.
1674 This function is copied from the GNU C Library. */
1679 /* Compute intervening leap days correctly even if year is negative.
1680 Take care to avoid int overflow in leap day calculations,
1681 but it's OK to assume that A and B are close to each other. */
1682 int a4
= (a
->tm_year
>> 2) + (TM_YEAR_BASE
>> 2) - ! (a
->tm_year
& 3);
1683 int b4
= (b
->tm_year
>> 2) + (TM_YEAR_BASE
>> 2) - ! (b
->tm_year
& 3);
1684 int a100
= a4
/ 25 - (a4
% 25 < 0);
1685 int b100
= b4
/ 25 - (b4
% 25 < 0);
1686 int a400
= a100
>> 2;
1687 int b400
= b100
>> 2;
1688 int intervening_leap_days
= (a4
- b4
) - (a100
- b100
) + (a400
- b400
);
1689 int years
= a
->tm_year
- b
->tm_year
;
1690 int days
= (365 * years
+ intervening_leap_days
1691 + (a
->tm_yday
- b
->tm_yday
));
1692 return (60 * (60 * (24 * days
+ (a
->tm_hour
- b
->tm_hour
))
1693 + (a
->tm_min
- b
->tm_min
))
1694 + (a
->tm_sec
- b
->tm_sec
));
1697 DEFUN ("current-time-zone", Fcurrent_time_zone
, Scurrent_time_zone
, 0, 1, 0,
1698 doc
: /* Return the offset and name for the local time zone.
1699 This returns a list of the form (OFFSET NAME).
1700 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
1701 A negative value means west of Greenwich.
1702 NAME is a string giving the name of the time zone.
1703 If an argument is given, it specifies when the time zone offset is determined
1704 instead of using the current time. The argument should have the form:
1707 (HIGH LOW . IGNORED).
1708 Thus, you can use times obtained from `current-time'
1709 and from `file-attributes'.
1711 Some operating systems cannot provide all this information to Emacs;
1712 in this case, `current-time-zone' returns a list containing nil for
1713 the data it can't find. */)
1715 Lisp_Object specified_time
;
1721 if (lisp_time_argument (specified_time
, &value
, NULL
)
1722 && (t
= gmtime (&value
)) != 0
1723 && (gmt
= *t
, t
= localtime (&value
)) != 0)
1725 int offset
= tm_diff (t
, &gmt
);
1730 s
= (char *)t
->tm_zone
;
1731 #else /* not HAVE_TM_ZONE */
1733 if (t
->tm_isdst
== 0 || t
->tm_isdst
== 1)
1734 s
= tzname
[t
->tm_isdst
];
1736 #endif /* not HAVE_TM_ZONE */
1738 #if defined HAVE_TM_ZONE || defined HAVE_TZNAME
1741 /* On Japanese w32, we can get a Japanese string as time
1742 zone name. Don't accept that. */
1744 for (p
= s
; *p
&& (isalnum ((unsigned char)*p
) || *p
== ' '); ++p
)
1753 /* No local time zone name is available; use "+-NNNN" instead. */
1754 int am
= (offset
< 0 ? -offset
: offset
) / 60;
1755 sprintf (buf
, "%c%02d%02d", (offset
< 0 ? '-' : '+'), am
/60, am
%60);
1758 return Fcons (make_number (offset
), Fcons (build_string (s
), Qnil
));
1761 return Fmake_list (make_number (2), Qnil
);
1764 /* This holds the value of `environ' produced by the previous
1765 call to Fset_time_zone_rule, or 0 if Fset_time_zone_rule
1766 has never been called. */
1767 static char **environbuf
;
1769 DEFUN ("set-time-zone-rule", Fset_time_zone_rule
, Sset_time_zone_rule
, 1, 1, 0,
1770 doc
: /* Set the local time zone using TZ, a string specifying a time zone rule.
1771 If TZ is nil, use implementation-defined default time zone information.
1772 If TZ is t, use Universal Time. */)
1780 else if (EQ (tz
, Qt
))
1785 tzstring
= (char *) XSTRING (tz
)->data
;
1788 set_time_zone_rule (tzstring
);
1791 environbuf
= environ
;
1796 #ifdef LOCALTIME_CACHE
1798 /* These two values are known to load tz files in buggy implementations,
1799 i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2.
1800 Their values shouldn't matter in non-buggy implementations.
1801 We don't use string literals for these strings,
1802 since if a string in the environment is in readonly
1803 storage, it runs afoul of bugs in SVR4 and Solaris 2.3.
1804 See Sun bugs 1113095 and 1114114, ``Timezone routines
1805 improperly modify environment''. */
1807 static char set_time_zone_rule_tz1
[] = "TZ=GMT+0";
1808 static char set_time_zone_rule_tz2
[] = "TZ=GMT+1";
1812 /* Set the local time zone rule to TZSTRING.
1813 This allocates memory into `environ', which it is the caller's
1814 responsibility to free. */
1817 set_time_zone_rule (tzstring
)
1821 char **from
, **to
, **newenv
;
1823 /* Make the ENVIRON vector longer with room for TZSTRING. */
1824 for (from
= environ
; *from
; from
++)
1826 envptrs
= from
- environ
+ 2;
1827 newenv
= to
= (char **) xmalloc (envptrs
* sizeof (char *)
1828 + (tzstring
? strlen (tzstring
) + 4 : 0));
1830 /* Add TZSTRING to the end of environ, as a value for TZ. */
1833 char *t
= (char *) (to
+ envptrs
);
1835 strcat (t
, tzstring
);
1839 /* Copy the old environ vector elements into NEWENV,
1840 but don't copy the TZ variable.
1841 So we have only one definition of TZ, which came from TZSTRING. */
1842 for (from
= environ
; *from
; from
++)
1843 if (strncmp (*from
, "TZ=", 3) != 0)
1849 /* If we do have a TZSTRING, NEWENV points to the vector slot where
1850 the TZ variable is stored. If we do not have a TZSTRING,
1851 TO points to the vector slot which has the terminating null. */
1853 #ifdef LOCALTIME_CACHE
1855 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like
1856 "US/Pacific" that loads a tz file, then changes to a value like
1857 "XXX0" that does not load a tz file, and then changes back to
1858 its original value, the last change is (incorrectly) ignored.
1859 Also, if TZ changes twice in succession to values that do
1860 not load a tz file, tzset can dump core (see Sun bug#1225179).
1861 The following code works around these bugs. */
1865 /* Temporarily set TZ to a value that loads a tz file
1866 and that differs from tzstring. */
1868 *newenv
= (strcmp (tzstring
, set_time_zone_rule_tz1
+ 3) == 0
1869 ? set_time_zone_rule_tz2
: set_time_zone_rule_tz1
);
1875 /* The implied tzstring is unknown, so temporarily set TZ to
1876 two different values that each load a tz file. */
1877 *to
= set_time_zone_rule_tz1
;
1880 *to
= set_time_zone_rule_tz2
;
1885 /* Now TZ has the desired value, and tzset can be invoked safely. */
1892 /* Insert NARGS Lisp objects in the array ARGS by calling INSERT_FUNC
1893 (if a type of object is Lisp_Int) or INSERT_FROM_STRING_FUNC (if a
1894 type of object is Lisp_String). INHERIT is passed to
1895 INSERT_FROM_STRING_FUNC as the last argument. */
1898 general_insert_function (insert_func
, insert_from_string_func
,
1899 inherit
, nargs
, args
)
1900 void (*insert_func
) P_ ((unsigned char *, int));
1901 void (*insert_from_string_func
) P_ ((Lisp_Object
, int, int, int, int, int));
1903 register Lisp_Object
*args
;
1905 register int argnum
;
1906 register Lisp_Object val
;
1908 for (argnum
= 0; argnum
< nargs
; argnum
++)
1914 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1917 if (!NILP (current_buffer
->enable_multibyte_characters
))
1918 len
= CHAR_STRING (XFASTINT (val
), str
);
1921 str
[0] = (SINGLE_BYTE_CHAR_P (XINT (val
))
1923 : multibyte_char_to_unibyte (XINT (val
), Qnil
));
1926 (*insert_func
) (str
, len
);
1928 else if (STRINGP (val
))
1930 (*insert_from_string_func
) (val
, 0, 0,
1931 XSTRING (val
)->size
,
1932 STRING_BYTES (XSTRING (val
)),
1937 val
= wrong_type_argument (Qchar_or_string_p
, val
);
1951 /* Callers passing one argument to Finsert need not gcpro the
1952 argument "array", since the only element of the array will
1953 not be used after calling insert or insert_from_string, so
1954 we don't care if it gets trashed. */
1956 DEFUN ("insert", Finsert
, Sinsert
, 0, MANY
, 0,
1957 doc
: /* Insert the arguments, either strings or characters, at point.
1958 Point and before-insertion markers move forward to end up
1959 after the inserted text.
1960 Any other markers at the point of insertion remain before the text.
1962 If the current buffer is multibyte, unibyte strings are converted
1963 to multibyte for insertion (see `unibyte-char-to-multibyte').
1964 If the current buffer is unibyte, multibyte strings are converted
1965 to unibyte for insertion.
1967 usage: (insert &rest ARGS) */)
1970 register Lisp_Object
*args
;
1972 general_insert_function (insert
, insert_from_string
, 0, nargs
, args
);
1976 DEFUN ("insert-and-inherit", Finsert_and_inherit
, Sinsert_and_inherit
,
1978 doc
: /* Insert the arguments at point, inheriting properties from adjoining text.
1979 Point and before-insertion markers move forward to end up
1980 after the inserted text.
1981 Any other markers at the point of insertion remain before the text.
1983 If the current buffer is multibyte, unibyte strings are converted
1984 to multibyte for insertion (see `unibyte-char-to-multibyte').
1985 If the current buffer is unibyte, multibyte strings are converted
1986 to unibyte for insertion.
1988 usage: (insert-and-inherit &rest ARGS) */)
1991 register Lisp_Object
*args
;
1993 general_insert_function (insert_and_inherit
, insert_from_string
, 1,
1998 DEFUN ("insert-before-markers", Finsert_before_markers
, Sinsert_before_markers
, 0, MANY
, 0,
1999 doc
: /* Insert strings or characters at point, relocating markers after the text.
2000 Point and markers move forward to end up after the inserted text.
2002 If the current buffer is multibyte, unibyte strings are converted
2003 to multibyte for insertion (see `unibyte-char-to-multibyte').
2004 If the current buffer is unibyte, multibyte strings are converted
2005 to unibyte for insertion.
2007 usage: (insert-before-markers &rest ARGS) */)
2010 register Lisp_Object
*args
;
2012 general_insert_function (insert_before_markers
,
2013 insert_from_string_before_markers
, 0,
2018 DEFUN ("insert-before-markers-and-inherit", Finsert_and_inherit_before_markers
,
2019 Sinsert_and_inherit_before_markers
, 0, MANY
, 0,
2020 doc
: /* Insert text at point, relocating markers and inheriting properties.
2021 Point and markers move forward to end up after the inserted text.
2023 If the current buffer is multibyte, unibyte strings are converted
2024 to multibyte for insertion (see `unibyte-char-to-multibyte').
2025 If the current buffer is unibyte, multibyte strings are converted
2026 to unibyte for insertion.
2028 usage: (insert-before-markers-and-inherit &rest ARGS) */)
2031 register Lisp_Object
*args
;
2033 general_insert_function (insert_before_markers_and_inherit
,
2034 insert_from_string_before_markers
, 1,
2039 DEFUN ("insert-char", Finsert_char
, Sinsert_char
, 2, 3, 0,
2040 doc
: /* Insert COUNT (second arg) copies of CHARACTER (first arg).
2041 Both arguments are required.
2042 Point, and before-insertion markers, are relocated as in the function `insert'.
2043 The optional third arg INHERIT, if non-nil, says to inherit text properties
2044 from adjoining text, if those properties are sticky. */)
2045 (character
, count
, inherit
)
2046 Lisp_Object character
, count
, inherit
;
2048 register unsigned char *string
;
2049 register int strlen
;
2052 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
2054 CHECK_NUMBER (character
);
2055 CHECK_NUMBER (count
);
2057 if (!NILP (current_buffer
->enable_multibyte_characters
))
2058 len
= CHAR_STRING (XFASTINT (character
), str
);
2060 str
[0] = XFASTINT (character
), len
= 1;
2061 n
= XINT (count
) * len
;
2064 strlen
= min (n
, 256 * len
);
2065 string
= (unsigned char *) alloca (strlen
);
2066 for (i
= 0; i
< strlen
; i
++)
2067 string
[i
] = str
[i
% len
];
2071 if (!NILP (inherit
))
2072 insert_and_inherit (string
, strlen
);
2074 insert (string
, strlen
);
2079 if (!NILP (inherit
))
2080 insert_and_inherit (string
, n
);
2088 /* Making strings from buffer contents. */
2090 /* Return a Lisp_String containing the text of the current buffer from
2091 START to END. If text properties are in use and the current buffer
2092 has properties in the range specified, the resulting string will also
2093 have them, if PROPS is nonzero.
2095 We don't want to use plain old make_string here, because it calls
2096 make_uninit_string, which can cause the buffer arena to be
2097 compacted. make_string has no way of knowing that the data has
2098 been moved, and thus copies the wrong data into the string. This
2099 doesn't effect most of the other users of make_string, so it should
2100 be left as is. But we should use this function when conjuring
2101 buffer substrings. */
2104 make_buffer_string (start
, end
, props
)
2108 int start_byte
= CHAR_TO_BYTE (start
);
2109 int end_byte
= CHAR_TO_BYTE (end
);
2111 return make_buffer_string_both (start
, start_byte
, end
, end_byte
, props
);
2114 /* Return a Lisp_String containing the text of the current buffer from
2115 START / START_BYTE to END / END_BYTE.
2117 If text properties are in use and the current buffer
2118 has properties in the range specified, the resulting string will also
2119 have them, if PROPS is nonzero.
2121 We don't want to use plain old make_string here, because it calls
2122 make_uninit_string, which can cause the buffer arena to be
2123 compacted. make_string has no way of knowing that the data has
2124 been moved, and thus copies the wrong data into the string. This
2125 doesn't effect most of the other users of make_string, so it should
2126 be left as is. But we should use this function when conjuring
2127 buffer substrings. */
2130 make_buffer_string_both (start
, start_byte
, end
, end_byte
, props
)
2131 int start
, start_byte
, end
, end_byte
;
2134 Lisp_Object result
, tem
, tem1
;
2136 if (start
< GPT
&& GPT
< end
)
2139 if (! NILP (current_buffer
->enable_multibyte_characters
))
2140 result
= make_uninit_multibyte_string (end
- start
, end_byte
- start_byte
);
2142 result
= make_uninit_string (end
- start
);
2143 bcopy (BYTE_POS_ADDR (start_byte
), XSTRING (result
)->data
,
2144 end_byte
- start_byte
);
2146 /* If desired, update and copy the text properties. */
2149 update_buffer_properties (start
, end
);
2151 tem
= Fnext_property_change (make_number (start
), Qnil
, make_number (end
));
2152 tem1
= Ftext_properties_at (make_number (start
), Qnil
);
2154 if (XINT (tem
) != end
|| !NILP (tem1
))
2155 copy_intervals_to_string (result
, current_buffer
, start
,
2162 /* Call Vbuffer_access_fontify_functions for the range START ... END
2163 in the current buffer, if necessary. */
2166 update_buffer_properties (start
, end
)
2169 /* If this buffer has some access functions,
2170 call them, specifying the range of the buffer being accessed. */
2171 if (!NILP (Vbuffer_access_fontify_functions
))
2173 Lisp_Object args
[3];
2176 args
[0] = Qbuffer_access_fontify_functions
;
2177 XSETINT (args
[1], start
);
2178 XSETINT (args
[2], end
);
2180 /* But don't call them if we can tell that the work
2181 has already been done. */
2182 if (!NILP (Vbuffer_access_fontified_property
))
2184 tem
= Ftext_property_any (args
[1], args
[2],
2185 Vbuffer_access_fontified_property
,
2188 Frun_hook_with_args (3, args
);
2191 Frun_hook_with_args (3, args
);
2195 DEFUN ("buffer-substring", Fbuffer_substring
, Sbuffer_substring
, 2, 2, 0,
2196 doc
: /* Return the contents of part of the current buffer as a string.
2197 The two arguments START and END are character positions;
2198 they can be in either order.
2199 The string returned is multibyte if the buffer is multibyte.
2201 This function copies the text properties of that part of the buffer
2202 into the result string; if you don't want the text properties,
2203 use `buffer-substring-no-properties' instead. */)
2205 Lisp_Object start
, end
;
2209 validate_region (&start
, &end
);
2213 return make_buffer_string (b
, e
, 1);
2216 DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties
,
2217 Sbuffer_substring_no_properties
, 2, 2, 0,
2218 doc
: /* Return the characters of part of the buffer, without the text properties.
2219 The two arguments START and END are character positions;
2220 they can be in either order. */)
2222 Lisp_Object start
, end
;
2226 validate_region (&start
, &end
);
2230 return make_buffer_string (b
, e
, 0);
2233 DEFUN ("buffer-string", Fbuffer_string
, Sbuffer_string
, 0, 0, 0,
2234 doc
: /* Return the contents of the current buffer as a string.
2235 If narrowing is in effect, this function returns only the visible part
2239 return make_buffer_string (BEGV
, ZV
, 1);
2242 DEFUN ("insert-buffer-substring", Finsert_buffer_substring
, Sinsert_buffer_substring
,
2244 doc
: /* Insert before point a substring of the contents of buffer BUFFER.
2245 BUFFER may be a buffer or a buffer name.
2246 Arguments START and END are character numbers specifying the substring.
2247 They default to the beginning and the end of BUFFER. */)
2249 Lisp_Object buf
, start
, end
;
2251 register int b
, e
, temp
;
2252 register struct buffer
*bp
, *obuf
;
2255 buffer
= Fget_buffer (buf
);
2258 bp
= XBUFFER (buffer
);
2259 if (NILP (bp
->name
))
2260 error ("Selecting deleted buffer");
2266 CHECK_NUMBER_COERCE_MARKER (start
);
2273 CHECK_NUMBER_COERCE_MARKER (end
);
2278 temp
= b
, b
= e
, e
= temp
;
2280 if (!(BUF_BEGV (bp
) <= b
&& e
<= BUF_ZV (bp
)))
2281 args_out_of_range (start
, end
);
2283 obuf
= current_buffer
;
2284 set_buffer_internal_1 (bp
);
2285 update_buffer_properties (b
, e
);
2286 set_buffer_internal_1 (obuf
);
2288 insert_from_buffer (bp
, b
, e
- b
, 0);
2292 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings
, Scompare_buffer_substrings
,
2294 doc
: /* Compare two substrings of two buffers; return result as number.
2295 the value is -N if first string is less after N-1 chars,
2296 +N if first string is greater after N-1 chars, or 0 if strings match.
2297 Each substring is represented as three arguments: BUFFER, START and END.
2298 That makes six args in all, three for each substring.
2300 The value of `case-fold-search' in the current buffer
2301 determines whether case is significant or ignored. */)
2302 (buffer1
, start1
, end1
, buffer2
, start2
, end2
)
2303 Lisp_Object buffer1
, start1
, end1
, buffer2
, start2
, end2
;
2305 register int begp1
, endp1
, begp2
, endp2
, temp
;
2306 register struct buffer
*bp1
, *bp2
;
2307 register Lisp_Object
*trt
2308 = (!NILP (current_buffer
->case_fold_search
)
2309 ? XCHAR_TABLE (current_buffer
->case_canon_table
)->contents
: 0);
2311 int i1
, i2
, i1_byte
, i2_byte
;
2313 /* Find the first buffer and its substring. */
2316 bp1
= current_buffer
;
2320 buf1
= Fget_buffer (buffer1
);
2323 bp1
= XBUFFER (buf1
);
2324 if (NILP (bp1
->name
))
2325 error ("Selecting deleted buffer");
2329 begp1
= BUF_BEGV (bp1
);
2332 CHECK_NUMBER_COERCE_MARKER (start1
);
2333 begp1
= XINT (start1
);
2336 endp1
= BUF_ZV (bp1
);
2339 CHECK_NUMBER_COERCE_MARKER (end1
);
2340 endp1
= XINT (end1
);
2344 temp
= begp1
, begp1
= endp1
, endp1
= temp
;
2346 if (!(BUF_BEGV (bp1
) <= begp1
2348 && endp1
<= BUF_ZV (bp1
)))
2349 args_out_of_range (start1
, end1
);
2351 /* Likewise for second substring. */
2354 bp2
= current_buffer
;
2358 buf2
= Fget_buffer (buffer2
);
2361 bp2
= XBUFFER (buf2
);
2362 if (NILP (bp2
->name
))
2363 error ("Selecting deleted buffer");
2367 begp2
= BUF_BEGV (bp2
);
2370 CHECK_NUMBER_COERCE_MARKER (start2
);
2371 begp2
= XINT (start2
);
2374 endp2
= BUF_ZV (bp2
);
2377 CHECK_NUMBER_COERCE_MARKER (end2
);
2378 endp2
= XINT (end2
);
2382 temp
= begp2
, begp2
= endp2
, endp2
= temp
;
2384 if (!(BUF_BEGV (bp2
) <= begp2
2386 && endp2
<= BUF_ZV (bp2
)))
2387 args_out_of_range (start2
, end2
);
2391 i1_byte
= buf_charpos_to_bytepos (bp1
, i1
);
2392 i2_byte
= buf_charpos_to_bytepos (bp2
, i2
);
2394 while (i1
< endp1
&& i2
< endp2
)
2396 /* When we find a mismatch, we must compare the
2397 characters, not just the bytes. */
2402 if (! NILP (bp1
->enable_multibyte_characters
))
2404 c1
= BUF_FETCH_MULTIBYTE_CHAR (bp1
, i1_byte
);
2405 BUF_INC_POS (bp1
, i1_byte
);
2410 c1
= BUF_FETCH_BYTE (bp1
, i1
);
2411 c1
= unibyte_char_to_multibyte (c1
);
2415 if (! NILP (bp2
->enable_multibyte_characters
))
2417 c2
= BUF_FETCH_MULTIBYTE_CHAR (bp2
, i2_byte
);
2418 BUF_INC_POS (bp2
, i2_byte
);
2423 c2
= BUF_FETCH_BYTE (bp2
, i2
);
2424 c2
= unibyte_char_to_multibyte (c2
);
2430 c1
= XINT (trt
[c1
]);
2431 c2
= XINT (trt
[c2
]);
2434 return make_number (- 1 - chars
);
2436 return make_number (chars
+ 1);
2441 /* The strings match as far as they go.
2442 If one is shorter, that one is less. */
2443 if (chars
< endp1
- begp1
)
2444 return make_number (chars
+ 1);
2445 else if (chars
< endp2
- begp2
)
2446 return make_number (- chars
- 1);
2448 /* Same length too => they are equal. */
2449 return make_number (0);
2453 subst_char_in_region_unwind (arg
)
2456 return current_buffer
->undo_list
= arg
;
2460 subst_char_in_region_unwind_1 (arg
)
2463 return current_buffer
->filename
= arg
;
2466 DEFUN ("subst-char-in-region", Fsubst_char_in_region
,
2467 Ssubst_char_in_region
, 4, 5, 0,
2468 doc
: /* From START to END, replace FROMCHAR with TOCHAR each time it occurs.
2469 If optional arg NOUNDO is non-nil, don't record this change for undo
2470 and don't mark the buffer as really changed.
2471 Both characters must have the same length of multi-byte form. */)
2472 (start
, end
, fromchar
, tochar
, noundo
)
2473 Lisp_Object start
, end
, fromchar
, tochar
, noundo
;
2475 register int pos
, pos_byte
, stop
, i
, len
, end_byte
;
2477 unsigned char fromstr
[MAX_MULTIBYTE_LENGTH
], tostr
[MAX_MULTIBYTE_LENGTH
];
2479 int count
= specpdl_ptr
- specpdl
;
2480 #define COMBINING_NO 0
2481 #define COMBINING_BEFORE 1
2482 #define COMBINING_AFTER 2
2483 #define COMBINING_BOTH (COMBINING_BEFORE | COMBINING_AFTER)
2484 int maybe_byte_combining
= COMBINING_NO
;
2485 int last_changed
= 0;
2486 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
2488 validate_region (&start
, &end
);
2489 CHECK_NUMBER (fromchar
);
2490 CHECK_NUMBER (tochar
);
2494 len
= CHAR_STRING (XFASTINT (fromchar
), fromstr
);
2495 if (CHAR_STRING (XFASTINT (tochar
), tostr
) != len
)
2496 error ("Characters in subst-char-in-region have different byte-lengths");
2497 if (!ASCII_BYTE_P (*tostr
))
2499 /* If *TOSTR is in the range 0x80..0x9F and TOCHAR is not a
2500 complete multibyte character, it may be combined with the
2501 after bytes. If it is in the range 0xA0..0xFF, it may be
2502 combined with the before and after bytes. */
2503 if (!CHAR_HEAD_P (*tostr
))
2504 maybe_byte_combining
= COMBINING_BOTH
;
2505 else if (BYTES_BY_CHAR_HEAD (*tostr
) > len
)
2506 maybe_byte_combining
= COMBINING_AFTER
;
2512 fromstr
[0] = XFASTINT (fromchar
);
2513 tostr
[0] = XFASTINT (tochar
);
2517 pos_byte
= CHAR_TO_BYTE (pos
);
2518 stop
= CHAR_TO_BYTE (XINT (end
));
2521 /* If we don't want undo, turn off putting stuff on the list.
2522 That's faster than getting rid of things,
2523 and it prevents even the entry for a first change.
2524 Also inhibit locking the file. */
2527 record_unwind_protect (subst_char_in_region_unwind
,
2528 current_buffer
->undo_list
);
2529 current_buffer
->undo_list
= Qt
;
2530 /* Don't do file-locking. */
2531 record_unwind_protect (subst_char_in_region_unwind_1
,
2532 current_buffer
->filename
);
2533 current_buffer
->filename
= Qnil
;
2536 if (pos_byte
< GPT_BYTE
)
2537 stop
= min (stop
, GPT_BYTE
);
2540 int pos_byte_next
= pos_byte
;
2542 if (pos_byte
>= stop
)
2544 if (pos_byte
>= end_byte
) break;
2547 p
= BYTE_POS_ADDR (pos_byte
);
2549 INC_POS (pos_byte_next
);
2552 if (pos_byte_next
- pos_byte
== len
2553 && p
[0] == fromstr
[0]
2555 || (p
[1] == fromstr
[1]
2556 && (len
== 2 || (p
[2] == fromstr
[2]
2557 && (len
== 3 || p
[3] == fromstr
[3]))))))
2562 modify_region (current_buffer
, changed
, XINT (end
));
2564 if (! NILP (noundo
))
2566 if (MODIFF
- 1 == SAVE_MODIFF
)
2568 if (MODIFF
- 1 == current_buffer
->auto_save_modified
)
2569 current_buffer
->auto_save_modified
++;
2573 /* Take care of the case where the new character
2574 combines with neighboring bytes. */
2575 if (maybe_byte_combining
2576 && (maybe_byte_combining
== COMBINING_AFTER
2577 ? (pos_byte_next
< Z_BYTE
2578 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next
)))
2579 : ((pos_byte_next
< Z_BYTE
2580 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next
)))
2581 || (pos_byte
> BEG_BYTE
2582 && ! ASCII_BYTE_P (FETCH_BYTE (pos_byte
- 1))))))
2584 Lisp_Object tem
, string
;
2586 struct gcpro gcpro1
;
2588 tem
= current_buffer
->undo_list
;
2591 /* Make a multibyte string containing this single character. */
2592 string
= make_multibyte_string (tostr
, 1, len
);
2593 /* replace_range is less efficient, because it moves the gap,
2594 but it handles combining correctly. */
2595 replace_range (pos
, pos
+ 1, string
,
2597 pos_byte_next
= CHAR_TO_BYTE (pos
);
2598 if (pos_byte_next
> pos_byte
)
2599 /* Before combining happened. We should not increment
2600 POS. So, to cancel the later increment of POS,
2604 INC_POS (pos_byte_next
);
2606 if (! NILP (noundo
))
2607 current_buffer
->undo_list
= tem
;
2614 record_change (pos
, 1);
2615 for (i
= 0; i
< len
; i
++) *p
++ = tostr
[i
];
2617 last_changed
= pos
+ 1;
2619 pos_byte
= pos_byte_next
;
2625 signal_after_change (changed
,
2626 last_changed
- changed
, last_changed
- changed
);
2627 update_compositions (changed
, last_changed
, CHECK_ALL
);
2630 unbind_to (count
, Qnil
);
2634 DEFUN ("translate-region", Ftranslate_region
, Stranslate_region
, 3, 3, 0,
2635 doc
: /* From START to END, translate characters according to TABLE.
2636 TABLE is a string; the Nth character in it is the mapping
2637 for the character with code N.
2638 This function does not alter multibyte characters.
2639 It returns the number of characters changed. */)
2643 register Lisp_Object table
;
2645 register int pos_byte
, stop
; /* Limits of the region. */
2646 register unsigned char *tt
; /* Trans table. */
2647 register int nc
; /* New character. */
2648 int cnt
; /* Number of changes made. */
2649 int size
; /* Size of translate table. */
2651 int multibyte
= !NILP (current_buffer
->enable_multibyte_characters
);
2653 validate_region (&start
, &end
);
2654 CHECK_STRING (table
);
2656 size
= STRING_BYTES (XSTRING (table
));
2657 tt
= XSTRING (table
)->data
;
2659 pos_byte
= CHAR_TO_BYTE (XINT (start
));
2660 stop
= CHAR_TO_BYTE (XINT (end
));
2661 modify_region (current_buffer
, XINT (start
), XINT (end
));
2665 for (; pos_byte
< stop
; )
2667 register unsigned char *p
= BYTE_POS_ADDR (pos_byte
);
2673 oc
= STRING_CHAR_AND_LENGTH (p
, stop
- pos_byte
, len
);
2676 pos_byte_next
= pos_byte
+ len
;
2677 if (oc
< size
&& len
== 1)
2682 /* Take care of the case where the new character
2683 combines with neighboring bytes. */
2684 if (!ASCII_BYTE_P (nc
)
2685 && (CHAR_HEAD_P (nc
)
2686 ? ! CHAR_HEAD_P (FETCH_BYTE (pos_byte
+ 1))
2687 : (pos_byte
> BEG_BYTE
2688 && ! ASCII_BYTE_P (FETCH_BYTE (pos_byte
- 1)))))
2692 string
= make_multibyte_string (tt
+ oc
, 1, 1);
2693 /* This is less efficient, because it moves the gap,
2694 but it handles combining correctly. */
2695 replace_range (pos
, pos
+ 1, string
,
2697 pos_byte_next
= CHAR_TO_BYTE (pos
);
2698 if (pos_byte_next
> pos_byte
)
2699 /* Before combining happened. We should not
2700 increment POS. So, to cancel the later
2701 increment of POS, we decrease it now. */
2704 INC_POS (pos_byte_next
);
2708 record_change (pos
, 1);
2710 signal_after_change (pos
, 1, 1);
2711 update_compositions (pos
, pos
+ 1, CHECK_BORDER
);
2716 pos_byte
= pos_byte_next
;
2720 return make_number (cnt
);
2723 DEFUN ("delete-region", Fdelete_region
, Sdelete_region
, 2, 2, "r",
2724 doc
: /* Delete the text between point and mark.
2725 When called from a program, expects two arguments,
2726 positions (integers or markers) specifying the stretch to be deleted. */)
2728 Lisp_Object start
, end
;
2730 validate_region (&start
, &end
);
2731 del_range (XINT (start
), XINT (end
));
2735 DEFUN ("delete-and-extract-region", Fdelete_and_extract_region
,
2736 Sdelete_and_extract_region
, 2, 2, 0,
2737 doc
: /* Delete the text between START and END and return it. */)
2739 Lisp_Object start
, end
;
2741 validate_region (&start
, &end
);
2742 return del_range_1 (XINT (start
), XINT (end
), 1, 1);
2745 DEFUN ("widen", Fwiden
, Swiden
, 0, 0, "",
2746 doc
: /* Remove restrictions (narrowing) from current buffer.
2747 This allows the buffer's full text to be seen and edited. */)
2750 if (BEG
!= BEGV
|| Z
!= ZV
)
2751 current_buffer
->clip_changed
= 1;
2753 BEGV_BYTE
= BEG_BYTE
;
2754 SET_BUF_ZV_BOTH (current_buffer
, Z
, Z_BYTE
);
2755 /* Changing the buffer bounds invalidates any recorded current column. */
2756 invalidate_current_column ();
2760 DEFUN ("narrow-to-region", Fnarrow_to_region
, Snarrow_to_region
, 2, 2, "r",
2761 doc
: /* Restrict editing in this buffer to the current region.
2762 The rest of the text becomes temporarily invisible and untouchable
2763 but is not deleted; if you save the buffer in a file, the invisible
2764 text is included in the file. \\[widen] makes all visible again.
2765 See also `save-restriction'.
2767 When calling from a program, pass two arguments; positions (integers
2768 or markers) bounding the text that should remain visible. */)
2770 register Lisp_Object start
, end
;
2772 CHECK_NUMBER_COERCE_MARKER (start
);
2773 CHECK_NUMBER_COERCE_MARKER (end
);
2775 if (XINT (start
) > XINT (end
))
2778 tem
= start
; start
= end
; end
= tem
;
2781 if (!(BEG
<= XINT (start
) && XINT (start
) <= XINT (end
) && XINT (end
) <= Z
))
2782 args_out_of_range (start
, end
);
2784 if (BEGV
!= XFASTINT (start
) || ZV
!= XFASTINT (end
))
2785 current_buffer
->clip_changed
= 1;
2787 SET_BUF_BEGV (current_buffer
, XFASTINT (start
));
2788 SET_BUF_ZV (current_buffer
, XFASTINT (end
));
2789 if (PT
< XFASTINT (start
))
2790 SET_PT (XFASTINT (start
));
2791 if (PT
> XFASTINT (end
))
2792 SET_PT (XFASTINT (end
));
2793 /* Changing the buffer bounds invalidates any recorded current column. */
2794 invalidate_current_column ();
2799 save_restriction_save ()
2801 if (BEGV
== BEG
&& ZV
== Z
)
2802 /* The common case that the buffer isn't narrowed.
2803 We return just the buffer object, which save_restriction_restore
2804 recognizes as meaning `no restriction'. */
2805 return Fcurrent_buffer ();
2807 /* We have to save a restriction, so return a pair of markers, one
2808 for the beginning and one for the end. */
2810 Lisp_Object beg
, end
;
2812 beg
= buildmark (BEGV
, BEGV_BYTE
);
2813 end
= buildmark (ZV
, ZV_BYTE
);
2815 /* END must move forward if text is inserted at its exact location. */
2816 XMARKER(end
)->insertion_type
= 1;
2818 return Fcons (beg
, end
);
2823 save_restriction_restore (data
)
2827 /* A pair of marks bounding a saved restriction. */
2829 struct Lisp_Marker
*beg
= XMARKER (XCAR (data
));
2830 struct Lisp_Marker
*end
= XMARKER (XCDR (data
));
2831 struct buffer
*buf
= beg
->buffer
; /* END should have the same buffer. */
2833 if (beg
->charpos
!= BUF_BEGV(buf
) || end
->charpos
!= BUF_ZV(buf
))
2834 /* The restriction has changed from the saved one, so restore
2835 the saved restriction. */
2837 int pt
= BUF_PT (buf
);
2839 SET_BUF_BEGV_BOTH (buf
, beg
->charpos
, beg
->bytepos
);
2840 SET_BUF_ZV_BOTH (buf
, end
->charpos
, end
->bytepos
);
2842 if (pt
< beg
->charpos
|| pt
> end
->charpos
)
2843 /* The point is outside the new visible range, move it inside. */
2844 SET_BUF_PT_BOTH (buf
,
2845 clip_to_bounds (beg
->charpos
, pt
, end
->charpos
),
2846 clip_to_bounds (beg
->bytepos
, BUF_PT_BYTE(buf
),
2849 buf
->clip_changed
= 1; /* Remember that the narrowing changed. */
2853 /* A buffer, which means that there was no old restriction. */
2855 struct buffer
*buf
= XBUFFER (data
);
2857 if (BUF_BEGV(buf
) != BUF_BEG(buf
) || BUF_ZV(buf
) != BUF_Z(buf
))
2858 /* The buffer has been narrowed, get rid of the narrowing. */
2860 SET_BUF_BEGV_BOTH (buf
, BUF_BEG(buf
), BUF_BEG_BYTE(buf
));
2861 SET_BUF_ZV_BOTH (buf
, BUF_Z(buf
), BUF_Z_BYTE(buf
));
2863 buf
->clip_changed
= 1; /* Remember that the narrowing changed. */
2870 DEFUN ("save-restriction", Fsave_restriction
, Ssave_restriction
, 0, UNEVALLED
, 0,
2871 doc
: /* Execute BODY, saving and restoring current buffer's restrictions.
2872 The buffer's restrictions make parts of the beginning and end invisible.
2873 (They are set up with `narrow-to-region' and eliminated with `widen'.)
2874 This special form, `save-restriction', saves the current buffer's restrictions
2875 when it is entered, and restores them when it is exited.
2876 So any `narrow-to-region' within BODY lasts only until the end of the form.
2877 The old restrictions settings are restored
2878 even in case of abnormal exit (throw or error).
2880 The value returned is the value of the last form in BODY.
2882 Note: if you are using both `save-excursion' and `save-restriction',
2883 use `save-excursion' outermost:
2884 (save-excursion (save-restriction ...))
2886 usage: (save-restriction &rest BODY) */)
2890 register Lisp_Object val
;
2891 int count
= specpdl_ptr
- specpdl
;
2893 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
2894 val
= Fprogn (body
);
2895 return unbind_to (count
, val
);
2898 /* Buffer for the most recent text displayed by Fmessage_box. */
2899 static char *message_text
;
2901 /* Allocated length of that buffer. */
2902 static int message_length
;
2904 DEFUN ("message", Fmessage
, Smessage
, 1, MANY
, 0,
2905 doc
: /* Print a one-line message at the bottom of the screen.
2906 The first argument is a format control string, and the rest are data
2907 to be formatted under control of the string. See `format' for details.
2909 If the first argument is nil, clear any existing message; let the
2910 minibuffer contents show.
2912 usage: (message STRING &rest ARGS) */)
2924 register Lisp_Object val
;
2925 val
= Fformat (nargs
, args
);
2926 message3 (val
, STRING_BYTES (XSTRING (val
)), STRING_MULTIBYTE (val
));
2931 DEFUN ("message-box", Fmessage_box
, Smessage_box
, 1, MANY
, 0,
2932 doc
: /* Display a message, in a dialog box if possible.
2933 If a dialog box is not available, use the echo area.
2934 The first argument is a format control string, and the rest are data
2935 to be formatted under control of the string. See `format' for details.
2937 If the first argument is nil, clear any existing message; let the
2938 minibuffer contents show.
2940 usage: (message-box STRING &rest ARGS) */)
2952 register Lisp_Object val
;
2953 val
= Fformat (nargs
, args
);
2955 /* The MS-DOS frames support popup menus even though they are
2956 not FRAME_WINDOW_P. */
2957 if (FRAME_WINDOW_P (XFRAME (selected_frame
))
2958 || FRAME_MSDOS_P (XFRAME (selected_frame
)))
2960 Lisp_Object pane
, menu
, obj
;
2961 struct gcpro gcpro1
;
2962 pane
= Fcons (Fcons (build_string ("OK"), Qt
), Qnil
);
2964 menu
= Fcons (val
, pane
);
2965 obj
= Fx_popup_dialog (Qt
, menu
);
2969 #endif /* HAVE_MENUS */
2970 /* Copy the data so that it won't move when we GC. */
2973 message_text
= (char *)xmalloc (80);
2974 message_length
= 80;
2976 if (STRING_BYTES (XSTRING (val
)) > message_length
)
2978 message_length
= STRING_BYTES (XSTRING (val
));
2979 message_text
= (char *)xrealloc (message_text
, message_length
);
2981 bcopy (XSTRING (val
)->data
, message_text
, STRING_BYTES (XSTRING (val
)));
2982 message2 (message_text
, STRING_BYTES (XSTRING (val
)),
2983 STRING_MULTIBYTE (val
));
2988 extern Lisp_Object last_nonmenu_event
;
2991 DEFUN ("message-or-box", Fmessage_or_box
, Smessage_or_box
, 1, MANY
, 0,
2992 doc
: /* Display a message in a dialog box or in the echo area.
2993 If this command was invoked with the mouse, use a dialog box if
2994 `use-dialog-box' is non-nil.
2995 Otherwise, use the echo area.
2996 The first argument is a format control string, and the rest are data
2997 to be formatted under control of the string. See `format' for details.
2999 If the first argument is nil, clear any existing message; let the
3000 minibuffer contents show.
3002 usage: (message-or-box STRING &rest ARGS) */)
3008 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
3010 return Fmessage_box (nargs
, args
);
3012 return Fmessage (nargs
, args
);
3015 DEFUN ("current-message", Fcurrent_message
, Scurrent_message
, 0, 0, 0,
3016 doc
: /* Return the string currently displayed in the echo area, or nil if none. */)
3019 return current_message ();
3023 DEFUN ("propertize", Fpropertize
, Spropertize
, 1, MANY
, 0,
3024 doc
: /* Return a copy of STRING with text properties added.
3025 First argument is the string to copy.
3026 Remaining arguments form a sequence of PROPERTY VALUE pairs for text
3027 properties to add to the result.
3028 usage: (propertize STRING &rest PROPERTIES) */)
3033 Lisp_Object properties
, string
;
3034 struct gcpro gcpro1
, gcpro2
;
3037 /* Number of args must be odd. */
3038 if ((nargs
& 1) == 0 || nargs
< 1)
3039 error ("Wrong number of arguments");
3041 properties
= string
= Qnil
;
3042 GCPRO2 (properties
, string
);
3044 /* First argument must be a string. */
3045 CHECK_STRING (args
[0]);
3046 string
= Fcopy_sequence (args
[0]);
3048 for (i
= 1; i
< nargs
; i
+= 2)
3050 CHECK_SYMBOL (args
[i
]);
3051 properties
= Fcons (args
[i
], Fcons (args
[i
+ 1], properties
));
3054 Fadd_text_properties (make_number (0),
3055 make_number (XSTRING (string
)->size
),
3056 properties
, string
);
3057 RETURN_UNGCPRO (string
);
3061 /* Number of bytes that STRING will occupy when put into the result.
3062 MULTIBYTE is nonzero if the result should be multibyte. */
3064 #define CONVERTED_BYTE_SIZE(MULTIBYTE, STRING) \
3065 (((MULTIBYTE) && ! STRING_MULTIBYTE (STRING)) \
3066 ? count_size_as_multibyte (XSTRING (STRING)->data, \
3067 STRING_BYTES (XSTRING (STRING))) \
3068 : STRING_BYTES (XSTRING (STRING)))
3070 DEFUN ("format", Fformat
, Sformat
, 1, MANY
, 0,
3071 doc
: /* Format a string out of a control-string and arguments.
3072 The first argument is a control string.
3073 The other arguments are substituted into it to make the result, a string.
3074 It may contain %-sequences meaning to substitute the next argument.
3075 %s means print a string argument. Actually, prints any object, with `princ'.
3076 %d means print as number in decimal (%o octal, %x hex).
3077 %X is like %x, but uses upper case.
3078 %e means print a number in exponential notation.
3079 %f means print a number in decimal-point notation.
3080 %g means print a number in exponential notation
3081 or decimal-point notation, whichever uses fewer characters.
3082 %c means print a number as a single character.
3083 %S means print any object as an s-expression (using `prin1').
3084 The argument used for %d, %o, %x, %e, %f, %g or %c must be a number.
3085 Use %% to put a single % into the output.
3087 usage: (format STRING &rest OBJECTS) */)
3090 register Lisp_Object
*args
;
3092 register int n
; /* The number of the next arg to substitute */
3093 register int total
; /* An estimate of the final length */
3095 register unsigned char *format
, *end
;
3097 /* Nonzero if the output should be a multibyte string,
3098 which is true if any of the inputs is one. */
3100 /* When we make a multibyte string, we must pay attention to the
3101 byte combining problem, i.e., a byte may be combined with a
3102 multibyte charcter of the previous string. This flag tells if we
3103 must consider such a situation or not. */
3104 int maybe_combine_byte
;
3105 unsigned char *this_format
;
3113 /* It should not be necessary to GCPRO ARGS, because
3114 the caller in the interpreter should take care of that. */
3116 /* Try to determine whether the result should be multibyte.
3117 This is not always right; sometimes the result needs to be multibyte
3118 because of an object that we will pass through prin1,
3119 and in that case, we won't know it here. */
3120 for (n
= 0; n
< nargs
; n
++)
3121 if (STRINGP (args
[n
]) && STRING_MULTIBYTE (args
[n
]))
3124 CHECK_STRING (args
[0]);
3126 /* If we start out planning a unibyte result,
3127 and later find it has to be multibyte, we jump back to retry. */
3130 format
= XSTRING (args
[0])->data
;
3131 end
= format
+ STRING_BYTES (XSTRING (args
[0]));
3134 /* Make room in result for all the non-%-codes in the control string. */
3135 total
= 5 + CONVERTED_BYTE_SIZE (multibyte
, args
[0]);
3137 /* Add to TOTAL enough space to hold the converted arguments. */
3140 while (format
!= end
)
3141 if (*format
++ == '%')
3144 int actual_width
= 0;
3145 unsigned char *this_format_start
= format
- 1;
3146 int field_width
, precision
;
3148 /* General format specifications look like
3150 '%' [flags] [field-width] [precision] format
3155 field-width ::= [0-9]+
3156 precision ::= '.' [0-9]*
3158 If a field-width is specified, it specifies to which width
3159 the output should be padded with blanks, iff the output
3160 string is shorter than field-width.
3162 if precision is specified, it specifies the number of
3163 digits to print after the '.' for floats, or the max.
3164 number of chars to print from a string. */
3166 precision
= field_width
= 0;
3168 while (index ("-*# 0", *format
))
3171 if (*format
>= '0' && *format
<= '9')
3173 for (field_width
= 0; *format
>= '0' && *format
<= '9'; ++format
)
3174 field_width
= 10 * field_width
+ *format
- '0';
3180 for (precision
= 0; *format
>= '0' && *format
<= '9'; ++format
)
3181 precision
= 10 * precision
+ *format
- '0';
3184 if (format
- this_format_start
+ 1 > longest_format
)
3185 longest_format
= format
- this_format_start
+ 1;
3188 error ("Format string ends in middle of format specifier");
3191 else if (++n
>= nargs
)
3192 error ("Not enough arguments for format string");
3193 else if (*format
== 'S')
3195 /* For `S', prin1 the argument and then treat like a string. */
3196 register Lisp_Object tem
;
3197 tem
= Fprin1_to_string (args
[n
], Qnil
);
3198 if (STRING_MULTIBYTE (tem
) && ! multibyte
)
3206 else if (SYMBOLP (args
[n
]))
3208 /* Use a temp var to avoid problems when ENABLE_CHECKING
3210 struct Lisp_String
*t
= XSYMBOL (args
[n
])->name
;
3211 XSETSTRING (args
[n
], t
);
3212 if (STRING_MULTIBYTE (args
[n
]) && ! multibyte
)
3219 else if (STRINGP (args
[n
]))
3222 if (*format
!= 's' && *format
!= 'S')
3223 error ("Format specifier doesn't match argument type");
3224 thissize
= CONVERTED_BYTE_SIZE (multibyte
, args
[n
]);
3225 actual_width
= lisp_string_width (args
[n
], -1, NULL
, NULL
);
3227 /* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */
3228 else if (INTEGERP (args
[n
]) && *format
!= 's')
3230 /* The following loop assumes the Lisp type indicates
3231 the proper way to pass the argument.
3232 So make sure we have a flonum if the argument should
3234 if (*format
== 'e' || *format
== 'f' || *format
== 'g')
3235 args
[n
] = Ffloat (args
[n
]);
3237 if (*format
!= 'd' && *format
!= 'o' && *format
!= 'x'
3238 && *format
!= 'i' && *format
!= 'X' && *format
!= 'c')
3239 error ("Invalid format operation %%%c", *format
);
3243 && (! SINGLE_BYTE_CHAR_P (XINT (args
[n
]))
3244 || XINT (args
[n
]) == 0))
3251 args
[n
] = Fchar_to_string (args
[n
]);
3252 thissize
= STRING_BYTES (XSTRING (args
[n
]));
3255 else if (FLOATP (args
[n
]) && *format
!= 's')
3257 if (! (*format
== 'e' || *format
== 'f' || *format
== 'g'))
3258 args
[n
] = Ftruncate (args
[n
], Qnil
);
3260 /* Note that we're using sprintf to print floats,
3261 so we have to take into account what that function
3263 thissize
= MAX_10_EXP
+ 100 + precision
;
3267 /* Anything but a string, convert to a string using princ. */
3268 register Lisp_Object tem
;
3269 tem
= Fprin1_to_string (args
[n
], Qt
);
3270 if (STRING_MULTIBYTE (tem
) & ! multibyte
)
3279 thissize
+= max (0, field_width
- actual_width
);
3280 total
+= thissize
+ 4;
3283 /* Now we can no longer jump to retry.
3284 TOTAL and LONGEST_FORMAT are known for certain. */
3286 this_format
= (unsigned char *) alloca (longest_format
+ 1);
3288 /* Allocate the space for the result.
3289 Note that TOTAL is an overestimate. */
3291 buf
= (char *) alloca (total
+ 1);
3293 buf
= (char *) xmalloc (total
+ 1);
3299 /* Scan the format and store result in BUF. */
3300 format
= XSTRING (args
[0])->data
;
3301 maybe_combine_byte
= 0;
3302 while (format
!= end
)
3308 unsigned char *this_format_start
= format
;
3312 /* Process a numeric arg and skip it. */
3313 minlen
= atoi (format
);
3315 minlen
= - minlen
, negative
= 1;
3317 while ((*format
>= '0' && *format
<= '9')
3318 || *format
== '-' || *format
== ' ' || *format
== '.')
3321 if (*format
++ == '%')
3330 if (STRINGP (args
[n
]))
3332 int padding
, nbytes
, start
, end
;
3333 int width
= lisp_string_width (args
[n
], -1, NULL
, NULL
);
3335 /* If spec requires it, pad on right with spaces. */
3336 padding
= minlen
- width
;
3338 while (padding
-- > 0)
3348 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
3349 && STRING_MULTIBYTE (args
[n
])
3350 && !CHAR_HEAD_P (XSTRING (args
[n
])->data
[0]))
3351 maybe_combine_byte
= 1;
3352 nbytes
= copy_text (XSTRING (args
[n
])->data
, p
,
3353 STRING_BYTES (XSTRING (args
[n
])),
3354 STRING_MULTIBYTE (args
[n
]), multibyte
);
3356 nchars
+= XSTRING (args
[n
])->size
;
3360 while (padding
-- > 0)
3366 /* If this argument has text properties, record where
3367 in the result string it appears. */
3368 if (XSTRING (args
[n
])->intervals
)
3372 int nbytes
= nargs
* sizeof *info
;
3373 info
= (struct info
*) alloca (nbytes
);
3374 bzero (info
, nbytes
);
3377 info
[n
].start
= start
;
3381 else if (INTEGERP (args
[n
]) || FLOATP (args
[n
]))
3385 bcopy (this_format_start
, this_format
,
3386 format
- this_format_start
);
3387 this_format
[format
- this_format_start
] = 0;
3389 if (INTEGERP (args
[n
]))
3390 sprintf (p
, this_format
, XINT (args
[n
]));
3392 sprintf (p
, this_format
, XFLOAT_DATA (args
[n
]));
3396 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
3397 && !CHAR_HEAD_P (*((unsigned char *) p
)))
3398 maybe_combine_byte
= 1;
3399 this_nchars
= strlen (p
);
3401 p
+= str_to_multibyte (p
, buf
+ total
- p
, this_nchars
);
3404 nchars
+= this_nchars
;
3407 else if (STRING_MULTIBYTE (args
[0]))
3409 /* Copy a whole multibyte character. */
3412 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
3413 && !CHAR_HEAD_P (*format
))
3414 maybe_combine_byte
= 1;
3416 while (! CHAR_HEAD_P (*format
)) *p
++ = *format
++;
3421 /* Convert a single-byte character to multibyte. */
3422 int len
= copy_text (format
, p
, 1, 0, 1);
3429 *p
++ = *format
++, nchars
++;
3432 if (p
> buf
+ total
+ 1)
3435 if (maybe_combine_byte
)
3436 nchars
= multibyte_chars_in_text (buf
, p
- buf
);
3437 val
= make_specified_string (buf
, nchars
, p
- buf
, multibyte
);
3439 /* If we allocated BUF with malloc, free it too. */
3443 /* If the format string has text properties, or any of the string
3444 arguments has text properties, set up text properties of the
3447 if (XSTRING (args
[0])->intervals
|| info
)
3449 Lisp_Object len
, new_len
, props
;
3450 struct gcpro gcpro1
;
3452 /* Add text properties from the format string. */
3453 len
= make_number (XSTRING (args
[0])->size
);
3454 props
= text_property_list (args
[0], make_number (0), len
, Qnil
);
3459 new_len
= make_number (XSTRING (val
)->size
);
3460 extend_property_ranges (props
, len
, new_len
);
3461 add_text_properties_from_list (val
, props
, make_number (0));
3464 /* Add text properties from arguments. */
3466 for (n
= 1; n
< nargs
; ++n
)
3469 len
= make_number (XSTRING (args
[n
])->size
);
3470 new_len
= make_number (info
[n
].end
- info
[n
].start
);
3471 props
= text_property_list (args
[n
], make_number (0), len
, Qnil
);
3472 extend_property_ranges (props
, len
, new_len
);
3473 /* If successive arguments have properites, be sure that
3474 the value of `composition' property be the copy. */
3475 if (n
> 1 && info
[n
- 1].end
)
3476 make_composition_value_copy (props
);
3477 add_text_properties_from_list (val
, props
,
3478 make_number (info
[n
].start
));
3491 format1 (string1
, arg0
, arg1
, arg2
, arg3
, arg4
)
3492 EMACS_INT arg0
, arg1
, arg2
, arg3
, arg4
;
3506 doprnt (buf
, sizeof buf
, string1
, (char *)0, 5, (char **) args
);
3508 doprnt (buf
, sizeof buf
, string1
, (char *)0, 5, &string1
+ 1);
3510 return build_string (buf
);
3513 DEFUN ("char-equal", Fchar_equal
, Schar_equal
, 2, 2, 0,
3514 doc
: /* Return t if two characters match, optionally ignoring case.
3515 Both arguments must be characters (i.e. integers).
3516 Case is ignored if `case-fold-search' is non-nil in the current buffer. */)
3518 register Lisp_Object c1
, c2
;
3524 if (XINT (c1
) == XINT (c2
))
3526 if (NILP (current_buffer
->case_fold_search
))
3529 /* Do these in separate statements,
3530 then compare the variables.
3531 because of the way DOWNCASE uses temp variables. */
3532 i1
= DOWNCASE (XFASTINT (c1
));
3533 i2
= DOWNCASE (XFASTINT (c2
));
3534 return (i1
== i2
? Qt
: Qnil
);
3537 /* Transpose the markers in two regions of the current buffer, and
3538 adjust the ones between them if necessary (i.e.: if the regions
3541 START1, END1 are the character positions of the first region.
3542 START1_BYTE, END1_BYTE are the byte positions.
3543 START2, END2 are the character positions of the second region.
3544 START2_BYTE, END2_BYTE are the byte positions.
3546 Traverses the entire marker list of the buffer to do so, adding an
3547 appropriate amount to some, subtracting from some, and leaving the
3548 rest untouched. Most of this is copied from adjust_markers in insdel.c.
3550 It's the caller's job to ensure that START1 <= END1 <= START2 <= END2. */
3553 transpose_markers (start1
, end1
, start2
, end2
,
3554 start1_byte
, end1_byte
, start2_byte
, end2_byte
)
3555 register int start1
, end1
, start2
, end2
;
3556 register int start1_byte
, end1_byte
, start2_byte
, end2_byte
;
3558 register int amt1
, amt1_byte
, amt2
, amt2_byte
, diff
, diff_byte
, mpos
;
3559 register Lisp_Object marker
;
3561 /* Update point as if it were a marker. */
3565 TEMP_SET_PT_BOTH (PT
+ (end2
- end1
),
3566 PT_BYTE
+ (end2_byte
- end1_byte
));
3567 else if (PT
< start2
)
3568 TEMP_SET_PT_BOTH (PT
+ (end2
- start2
) - (end1
- start1
),
3569 (PT_BYTE
+ (end2_byte
- start2_byte
)
3570 - (end1_byte
- start1_byte
)));
3572 TEMP_SET_PT_BOTH (PT
- (start2
- start1
),
3573 PT_BYTE
- (start2_byte
- start1_byte
));
3575 /* We used to adjust the endpoints here to account for the gap, but that
3576 isn't good enough. Even if we assume the caller has tried to move the
3577 gap out of our way, it might still be at start1 exactly, for example;
3578 and that places it `inside' the interval, for our purposes. The amount
3579 of adjustment is nontrivial if there's a `denormalized' marker whose
3580 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
3581 the dirty work to Fmarker_position, below. */
3583 /* The difference between the region's lengths */
3584 diff
= (end2
- start2
) - (end1
- start1
);
3585 diff_byte
= (end2_byte
- start2_byte
) - (end1_byte
- start1_byte
);
3587 /* For shifting each marker in a region by the length of the other
3588 region plus the distance between the regions. */
3589 amt1
= (end2
- start2
) + (start2
- end1
);
3590 amt2
= (end1
- start1
) + (start2
- end1
);
3591 amt1_byte
= (end2_byte
- start2_byte
) + (start2_byte
- end1_byte
);
3592 amt2_byte
= (end1_byte
- start1_byte
) + (start2_byte
- end1_byte
);
3594 for (marker
= BUF_MARKERS (current_buffer
); !NILP (marker
);
3595 marker
= XMARKER (marker
)->chain
)
3597 mpos
= marker_byte_position (marker
);
3598 if (mpos
>= start1_byte
&& mpos
< end2_byte
)
3600 if (mpos
< end1_byte
)
3602 else if (mpos
< start2_byte
)
3606 XMARKER (marker
)->bytepos
= mpos
;
3608 mpos
= XMARKER (marker
)->charpos
;
3609 if (mpos
>= start1
&& mpos
< end2
)
3613 else if (mpos
< start2
)
3618 XMARKER (marker
)->charpos
= mpos
;
3622 DEFUN ("transpose-regions", Ftranspose_regions
, Stranspose_regions
, 4, 5, 0,
3623 doc
: /* Transpose region START1 to END1 with START2 to END2.
3624 The regions may not be overlapping, because the size of the buffer is
3625 never changed in a transposition.
3627 Optional fifth arg LEAVE_MARKERS, if non-nil, means don't update
3628 any markers that happen to be located in the regions.
3630 Transposing beyond buffer boundaries is an error. */)
3631 (startr1
, endr1
, startr2
, endr2
, leave_markers
)
3632 Lisp_Object startr1
, endr1
, startr2
, endr2
, leave_markers
;
3634 register int start1
, end1
, start2
, end2
;
3635 int start1_byte
, start2_byte
, len1_byte
, len2_byte
;
3636 int gap
, len1
, len_mid
, len2
;
3637 unsigned char *start1_addr
, *start2_addr
, *temp
;
3639 INTERVAL cur_intv
, tmp_interval1
, tmp_interval_mid
, tmp_interval2
;
3640 cur_intv
= BUF_INTERVALS (current_buffer
);
3642 validate_region (&startr1
, &endr1
);
3643 validate_region (&startr2
, &endr2
);
3645 start1
= XFASTINT (startr1
);
3646 end1
= XFASTINT (endr1
);
3647 start2
= XFASTINT (startr2
);
3648 end2
= XFASTINT (endr2
);
3651 /* Swap the regions if they're reversed. */
3654 register int glumph
= start1
;
3662 len1
= end1
- start1
;
3663 len2
= end2
- start2
;
3666 error ("Transposed regions overlap");
3667 else if (start1
== end1
|| start2
== end2
)
3668 error ("Transposed region has length 0");
3670 /* The possibilities are:
3671 1. Adjacent (contiguous) regions, or separate but equal regions
3672 (no, really equal, in this case!), or
3673 2. Separate regions of unequal size.
3675 The worst case is usually No. 2. It means that (aside from
3676 potential need for getting the gap out of the way), there also
3677 needs to be a shifting of the text between the two regions. So
3678 if they are spread far apart, we are that much slower... sigh. */
3680 /* It must be pointed out that the really studly thing to do would
3681 be not to move the gap at all, but to leave it in place and work
3682 around it if necessary. This would be extremely efficient,
3683 especially considering that people are likely to do
3684 transpositions near where they are working interactively, which
3685 is exactly where the gap would be found. However, such code
3686 would be much harder to write and to read. So, if you are
3687 reading this comment and are feeling squirrely, by all means have
3688 a go! I just didn't feel like doing it, so I will simply move
3689 the gap the minimum distance to get it out of the way, and then
3690 deal with an unbroken array. */
3692 /* Make sure the gap won't interfere, by moving it out of the text
3693 we will operate on. */
3694 if (start1
< gap
&& gap
< end2
)
3696 if (gap
- start1
< end2
- gap
)
3702 start1_byte
= CHAR_TO_BYTE (start1
);
3703 start2_byte
= CHAR_TO_BYTE (start2
);
3704 len1_byte
= CHAR_TO_BYTE (end1
) - start1_byte
;
3705 len2_byte
= CHAR_TO_BYTE (end2
) - start2_byte
;
3707 #ifdef BYTE_COMBINING_DEBUG
3710 if (count_combining_before (BYTE_POS_ADDR (start2_byte
),
3711 len2_byte
, start1
, start1_byte
)
3712 || count_combining_before (BYTE_POS_ADDR (start1_byte
),
3713 len1_byte
, end2
, start2_byte
+ len2_byte
)
3714 || count_combining_after (BYTE_POS_ADDR (start1_byte
),
3715 len1_byte
, end2
, start2_byte
+ len2_byte
))
3720 if (count_combining_before (BYTE_POS_ADDR (start2_byte
),
3721 len2_byte
, start1
, start1_byte
)
3722 || count_combining_before (BYTE_POS_ADDR (start1_byte
),
3723 len1_byte
, start2
, start2_byte
)
3724 || count_combining_after (BYTE_POS_ADDR (start2_byte
),
3725 len2_byte
, end1
, start1_byte
+ len1_byte
)
3726 || count_combining_after (BYTE_POS_ADDR (start1_byte
),
3727 len1_byte
, end2
, start2_byte
+ len2_byte
))
3732 /* Hmmm... how about checking to see if the gap is large
3733 enough to use as the temporary storage? That would avoid an
3734 allocation... interesting. Later, don't fool with it now. */
3736 /* Working without memmove, for portability (sigh), so must be
3737 careful of overlapping subsections of the array... */
3739 if (end1
== start2
) /* adjacent regions */
3741 modify_region (current_buffer
, start1
, end2
);
3742 record_change (start1
, len1
+ len2
);
3744 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
3745 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
3746 Fset_text_properties (make_number (start1
), make_number (end2
),
3749 /* First region smaller than second. */
3750 if (len1_byte
< len2_byte
)
3752 /* We use alloca only if it is small,
3753 because we want to avoid stack overflow. */
3754 if (len2_byte
> 20000)
3755 temp
= (unsigned char *) xmalloc (len2_byte
);
3757 temp
= (unsigned char *) alloca (len2_byte
);
3759 /* Don't precompute these addresses. We have to compute them
3760 at the last minute, because the relocating allocator might
3761 have moved the buffer around during the xmalloc. */
3762 start1_addr
= BYTE_POS_ADDR (start1_byte
);
3763 start2_addr
= BYTE_POS_ADDR (start2_byte
);
3765 bcopy (start2_addr
, temp
, len2_byte
);
3766 bcopy (start1_addr
, start1_addr
+ len2_byte
, len1_byte
);
3767 bcopy (temp
, start1_addr
, len2_byte
);
3768 if (len2_byte
> 20000)
3772 /* First region not smaller than second. */
3774 if (len1_byte
> 20000)
3775 temp
= (unsigned char *) xmalloc (len1_byte
);
3777 temp
= (unsigned char *) alloca (len1_byte
);
3778 start1_addr
= BYTE_POS_ADDR (start1_byte
);
3779 start2_addr
= BYTE_POS_ADDR (start2_byte
);
3780 bcopy (start1_addr
, temp
, len1_byte
);
3781 bcopy (start2_addr
, start1_addr
, len2_byte
);
3782 bcopy (temp
, start1_addr
+ len2_byte
, len1_byte
);
3783 if (len1_byte
> 20000)
3786 graft_intervals_into_buffer (tmp_interval1
, start1
+ len2
,
3787 len1
, current_buffer
, 0);
3788 graft_intervals_into_buffer (tmp_interval2
, start1
,
3789 len2
, current_buffer
, 0);
3790 update_compositions (start1
, start1
+ len2
, CHECK_BORDER
);
3791 update_compositions (start1
+ len2
, end2
, CHECK_TAIL
);
3793 /* Non-adjacent regions, because end1 != start2, bleagh... */
3796 len_mid
= start2_byte
- (start1_byte
+ len1_byte
);
3798 if (len1_byte
== len2_byte
)
3799 /* Regions are same size, though, how nice. */
3801 modify_region (current_buffer
, start1
, end1
);
3802 modify_region (current_buffer
, start2
, end2
);
3803 record_change (start1
, len1
);
3804 record_change (start2
, len2
);
3805 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
3806 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
3807 Fset_text_properties (make_number (start1
), make_number (end1
),
3809 Fset_text_properties (make_number (start2
), make_number (end2
),
3812 if (len1_byte
> 20000)
3813 temp
= (unsigned char *) xmalloc (len1_byte
);
3815 temp
= (unsigned char *) alloca (len1_byte
);
3816 start1_addr
= BYTE_POS_ADDR (start1_byte
);
3817 start2_addr
= BYTE_POS_ADDR (start2_byte
);
3818 bcopy (start1_addr
, temp
, len1_byte
);
3819 bcopy (start2_addr
, start1_addr
, len2_byte
);
3820 bcopy (temp
, start2_addr
, len1_byte
);
3821 if (len1_byte
> 20000)
3823 graft_intervals_into_buffer (tmp_interval1
, start2
,
3824 len1
, current_buffer
, 0);
3825 graft_intervals_into_buffer (tmp_interval2
, start1
,
3826 len2
, current_buffer
, 0);
3829 else if (len1_byte
< len2_byte
) /* Second region larger than first */
3830 /* Non-adjacent & unequal size, area between must also be shifted. */
3832 modify_region (current_buffer
, start1
, end2
);
3833 record_change (start1
, (end2
- start1
));
3834 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
3835 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
3836 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
3837 Fset_text_properties (make_number (start1
), make_number (end2
),
3840 /* holds region 2 */
3841 if (len2_byte
> 20000)
3842 temp
= (unsigned char *) xmalloc (len2_byte
);
3844 temp
= (unsigned char *) alloca (len2_byte
);
3845 start1_addr
= BYTE_POS_ADDR (start1_byte
);
3846 start2_addr
= BYTE_POS_ADDR (start2_byte
);
3847 bcopy (start2_addr
, temp
, len2_byte
);
3848 bcopy (start1_addr
, start1_addr
+ len_mid
+ len2_byte
, len1_byte
);
3849 safe_bcopy (start1_addr
+ len1_byte
, start1_addr
+ len2_byte
, len_mid
);
3850 bcopy (temp
, start1_addr
, len2_byte
);
3851 if (len2_byte
> 20000)
3853 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
3854 len1
, current_buffer
, 0);
3855 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
3856 len_mid
, current_buffer
, 0);
3857 graft_intervals_into_buffer (tmp_interval2
, start1
,
3858 len2
, current_buffer
, 0);
3861 /* Second region smaller than first. */
3863 record_change (start1
, (end2
- start1
));
3864 modify_region (current_buffer
, start1
, end2
);
3866 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
3867 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
3868 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
3869 Fset_text_properties (make_number (start1
), make_number (end2
),
3872 /* holds region 1 */
3873 if (len1_byte
> 20000)
3874 temp
= (unsigned char *) xmalloc (len1_byte
);
3876 temp
= (unsigned char *) alloca (len1_byte
);
3877 start1_addr
= BYTE_POS_ADDR (start1_byte
);
3878 start2_addr
= BYTE_POS_ADDR (start2_byte
);
3879 bcopy (start1_addr
, temp
, len1_byte
);
3880 bcopy (start2_addr
, start1_addr
, len2_byte
);
3881 bcopy (start1_addr
+ len1_byte
, start1_addr
+ len2_byte
, len_mid
);
3882 bcopy (temp
, start1_addr
+ len2_byte
+ len_mid
, len1_byte
);
3883 if (len1_byte
> 20000)
3885 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
3886 len1
, current_buffer
, 0);
3887 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
3888 len_mid
, current_buffer
, 0);
3889 graft_intervals_into_buffer (tmp_interval2
, start1
,
3890 len2
, current_buffer
, 0);
3893 update_compositions (start1
, start1
+ len2
, CHECK_BORDER
);
3894 update_compositions (end2
- len1
, end2
, CHECK_BORDER
);
3897 /* When doing multiple transpositions, it might be nice
3898 to optimize this. Perhaps the markers in any one buffer
3899 should be organized in some sorted data tree. */
3900 if (NILP (leave_markers
))
3902 transpose_markers (start1
, end1
, start2
, end2
,
3903 start1_byte
, start1_byte
+ len1_byte
,
3904 start2_byte
, start2_byte
+ len2_byte
);
3905 fix_overlays_in_range (start1
, end2
);
3917 Qbuffer_access_fontify_functions
3918 = intern ("buffer-access-fontify-functions");
3919 staticpro (&Qbuffer_access_fontify_functions
);
3921 DEFVAR_LISP ("inhibit-field-text-motion", &Vinhibit_field_text_motion
,
3922 doc
: /* Non-nil means text motion commands don't notice fields. */);
3923 Vinhibit_field_text_motion
= Qnil
;
3925 DEFVAR_LISP ("buffer-access-fontify-functions",
3926 &Vbuffer_access_fontify_functions
,
3927 doc
: /* List of functions called by `buffer-substring' to fontify if necessary.
3928 Each function is called with two arguments which specify the range
3929 of the buffer being accessed. */);
3930 Vbuffer_access_fontify_functions
= Qnil
;
3934 extern Lisp_Object Vprin1_to_string_buffer
;
3935 obuf
= Fcurrent_buffer ();
3936 /* Do this here, because init_buffer_once is too early--it won't work. */
3937 Fset_buffer (Vprin1_to_string_buffer
);
3938 /* Make sure buffer-access-fontify-functions is nil in this buffer. */
3939 Fset (Fmake_local_variable (intern ("buffer-access-fontify-functions")),
3944 DEFVAR_LISP ("buffer-access-fontified-property",
3945 &Vbuffer_access_fontified_property
,
3946 doc
: /* Property which (if non-nil) indicates text has been fontified.
3947 `buffer-substring' need not call the `buffer-access-fontify-functions'
3948 functions if all the text being accessed has this property. */);
3949 Vbuffer_access_fontified_property
= Qnil
;
3951 DEFVAR_LISP ("system-name", &Vsystem_name
,
3952 doc
: /* The name of the machine Emacs is running on. */);
3954 DEFVAR_LISP ("user-full-name", &Vuser_full_name
,
3955 doc
: /* The full name of the user logged in. */);
3957 DEFVAR_LISP ("user-login-name", &Vuser_login_name
,
3958 doc
: /* The user's name, taken from environment variables if possible. */);
3960 DEFVAR_LISP ("user-real-login-name", &Vuser_real_login_name
,
3961 doc
: /* The user's name, based upon the real uid only. */);
3963 defsubr (&Spropertize
);
3964 defsubr (&Schar_equal
);
3965 defsubr (&Sgoto_char
);
3966 defsubr (&Sstring_to_char
);
3967 defsubr (&Schar_to_string
);
3968 defsubr (&Sbuffer_substring
);
3969 defsubr (&Sbuffer_substring_no_properties
);
3970 defsubr (&Sbuffer_string
);
3972 defsubr (&Spoint_marker
);
3973 defsubr (&Smark_marker
);
3975 defsubr (&Sregion_beginning
);
3976 defsubr (&Sregion_end
);
3978 staticpro (&Qfield
);
3979 Qfield
= intern ("field");
3980 staticpro (&Qboundary
);
3981 Qboundary
= intern ("boundary");
3982 defsubr (&Sfield_beginning
);
3983 defsubr (&Sfield_end
);
3984 defsubr (&Sfield_string
);
3985 defsubr (&Sfield_string_no_properties
);
3986 defsubr (&Sdelete_field
);
3987 defsubr (&Sconstrain_to_field
);
3989 defsubr (&Sline_beginning_position
);
3990 defsubr (&Sline_end_position
);
3992 /* defsubr (&Smark); */
3993 /* defsubr (&Sset_mark); */
3994 defsubr (&Ssave_excursion
);
3995 defsubr (&Ssave_current_buffer
);
3997 defsubr (&Sbufsize
);
3998 defsubr (&Spoint_max
);
3999 defsubr (&Spoint_min
);
4000 defsubr (&Spoint_min_marker
);
4001 defsubr (&Spoint_max_marker
);
4002 defsubr (&Sgap_position
);
4003 defsubr (&Sgap_size
);
4004 defsubr (&Sposition_bytes
);
4005 defsubr (&Sbyte_to_position
);
4011 defsubr (&Sfollowing_char
);
4012 defsubr (&Sprevious_char
);
4013 defsubr (&Schar_after
);
4014 defsubr (&Schar_before
);
4016 defsubr (&Sinsert_before_markers
);
4017 defsubr (&Sinsert_and_inherit
);
4018 defsubr (&Sinsert_and_inherit_before_markers
);
4019 defsubr (&Sinsert_char
);
4021 defsubr (&Suser_login_name
);
4022 defsubr (&Suser_real_login_name
);
4023 defsubr (&Suser_uid
);
4024 defsubr (&Suser_real_uid
);
4025 defsubr (&Suser_full_name
);
4026 defsubr (&Semacs_pid
);
4027 defsubr (&Scurrent_time
);
4028 defsubr (&Sformat_time_string
);
4029 defsubr (&Sfloat_time
);
4030 defsubr (&Sdecode_time
);
4031 defsubr (&Sencode_time
);
4032 defsubr (&Scurrent_time_string
);
4033 defsubr (&Scurrent_time_zone
);
4034 defsubr (&Sset_time_zone_rule
);
4035 defsubr (&Ssystem_name
);
4036 defsubr (&Smessage
);
4037 defsubr (&Smessage_box
);
4038 defsubr (&Smessage_or_box
);
4039 defsubr (&Scurrent_message
);
4042 defsubr (&Sinsert_buffer_substring
);
4043 defsubr (&Scompare_buffer_substrings
);
4044 defsubr (&Ssubst_char_in_region
);
4045 defsubr (&Stranslate_region
);
4046 defsubr (&Sdelete_region
);
4047 defsubr (&Sdelete_and_extract_region
);
4049 defsubr (&Snarrow_to_region
);
4050 defsubr (&Ssave_restriction
);
4051 defsubr (&Stranspose_regions
);