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>
36 /* Without this, sprintf on Mac OS Classic will produce wrong
45 #include "intervals.h"
56 #define MAX_10_EXP DBL_MAX_10_EXP
58 #define MAX_10_EXP 310
66 extern char **environ
;
69 extern Lisp_Object make_time
P_ ((time_t));
70 extern size_t emacs_strftimeu
P_ ((char *, size_t, const char *,
71 const struct tm
*, int));
72 static int tm_diff
P_ ((struct tm
*, struct tm
*));
73 static void find_field
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
, int *, Lisp_Object
, int *));
74 static void update_buffer_properties
P_ ((int, int));
75 static Lisp_Object region_limit
P_ ((int));
76 static int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
77 static size_t emacs_memftimeu
P_ ((char *, size_t, const char *,
78 size_t, const struct tm
*, int));
79 static void general_insert_function
P_ ((void (*) (const unsigned char *, int),
80 void (*) (Lisp_Object
, int, int, int,
82 int, int, Lisp_Object
*));
83 static Lisp_Object subst_char_in_region_unwind
P_ ((Lisp_Object
));
84 static Lisp_Object subst_char_in_region_unwind_1
P_ ((Lisp_Object
));
85 static void transpose_markers
P_ ((int, int, int, int, int, int, int, int));
88 extern char *index
P_ ((const char *, int));
91 Lisp_Object Vbuffer_access_fontify_functions
;
92 Lisp_Object Qbuffer_access_fontify_functions
;
93 Lisp_Object Vbuffer_access_fontified_property
;
95 Lisp_Object Fuser_full_name
P_ ((Lisp_Object
));
97 /* Non-nil means don't stop at field boundary in text motion commands. */
99 Lisp_Object Vinhibit_field_text_motion
;
101 /* Some static data, and a function to initialize it for each run */
103 Lisp_Object Vsystem_name
;
104 Lisp_Object Vuser_real_login_name
; /* login name of current user ID */
105 Lisp_Object Vuser_full_name
; /* full name of current user */
106 Lisp_Object Vuser_login_name
; /* user name from LOGNAME or USER */
108 /* Symbol for the text property used to mark fields. */
112 /* A special value for Qfield properties. */
114 Lisp_Object Qboundary
;
121 register unsigned char *p
;
122 struct passwd
*pw
; /* password entry for the current user */
125 /* Set up system_name even when dumping. */
129 /* Don't bother with this on initial start when just dumping out */
132 #endif /* not CANNOT_DUMP */
134 pw
= (struct passwd
*) getpwuid (getuid ());
136 /* We let the real user name default to "root" because that's quite
137 accurate on MSDOG and because it lets Emacs find the init file.
138 (The DVX libraries override the Djgpp libraries here.) */
139 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "root");
141 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "unknown");
144 /* Get the effective user name, by consulting environment variables,
145 or the effective uid if those are unset. */
146 user_name
= (char *) getenv ("LOGNAME");
149 user_name
= (char *) getenv ("USERNAME"); /* it's USERNAME on NT */
150 #else /* WINDOWSNT */
151 user_name
= (char *) getenv ("USER");
152 #endif /* WINDOWSNT */
155 pw
= (struct passwd
*) getpwuid (geteuid ());
156 user_name
= (char *) (pw
? pw
->pw_name
: "unknown");
158 Vuser_login_name
= build_string (user_name
);
160 /* If the user name claimed in the environment vars differs from
161 the real uid, use the claimed name to find the full name. */
162 tem
= Fstring_equal (Vuser_login_name
, Vuser_real_login_name
);
163 Vuser_full_name
= Fuser_full_name (NILP (tem
)? make_number (geteuid())
166 p
= (unsigned char *) getenv ("NAME");
168 Vuser_full_name
= build_string (p
);
169 else if (NILP (Vuser_full_name
))
170 Vuser_full_name
= build_string ("unknown");
173 DEFUN ("char-to-string", Fchar_to_string
, Schar_to_string
, 1, 1, 0,
174 doc
: /* Convert arg CHAR to a string containing that character.
175 usage: (char-to-string CHAR) */)
177 Lisp_Object character
;
180 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
182 CHECK_NUMBER (character
);
184 len
= (SINGLE_BYTE_CHAR_P (XFASTINT (character
))
185 ? (*str
= (unsigned char)(XFASTINT (character
)), 1)
186 : char_to_string (XFASTINT (character
), str
));
187 return make_string_from_bytes (str
, 1, len
);
190 DEFUN ("string-to-char", Fstring_to_char
, Sstring_to_char
, 1, 1, 0,
191 doc
: /* Convert arg STRING to a character, the first character of that string.
192 A multibyte character is handled correctly. */)
194 register Lisp_Object string
;
196 register Lisp_Object val
;
197 CHECK_STRING (string
);
200 if (STRING_MULTIBYTE (string
))
201 XSETFASTINT (val
, STRING_CHAR (SDATA (string
), SBYTES (string
)));
203 XSETFASTINT (val
, SREF (string
, 0));
206 XSETFASTINT (val
, 0);
211 buildmark (charpos
, bytepos
)
212 int charpos
, bytepos
;
214 register Lisp_Object mark
;
215 mark
= Fmake_marker ();
216 set_marker_both (mark
, Qnil
, charpos
, bytepos
);
220 DEFUN ("point", Fpoint
, Spoint
, 0, 0, 0,
221 doc
: /* Return value of point, as an integer.
222 Beginning of buffer is position (point-min). */)
226 XSETFASTINT (temp
, PT
);
230 DEFUN ("point-marker", Fpoint_marker
, Spoint_marker
, 0, 0, 0,
231 doc
: /* Return value of point, as a marker object. */)
234 return buildmark (PT
, PT_BYTE
);
238 clip_to_bounds (lower
, num
, upper
)
239 int lower
, num
, upper
;
243 else if (num
> upper
)
249 DEFUN ("goto-char", Fgoto_char
, Sgoto_char
, 1, 1, "NGoto char: ",
250 doc
: /* Set point to POSITION, a number or marker.
251 Beginning of buffer is position (point-min), end is (point-max).
252 If the position is in the middle of a multibyte form,
253 the actual point is set at the head of the multibyte form
254 except in the case that `enable-multibyte-characters' is nil. */)
256 register Lisp_Object position
;
260 if (MARKERP (position
)
261 && current_buffer
== XMARKER (position
)->buffer
)
263 pos
= marker_position (position
);
265 SET_PT_BOTH (BEGV
, BEGV_BYTE
);
267 SET_PT_BOTH (ZV
, ZV_BYTE
);
269 SET_PT_BOTH (pos
, marker_byte_position (position
));
274 CHECK_NUMBER_COERCE_MARKER (position
);
276 pos
= clip_to_bounds (BEGV
, XINT (position
), ZV
);
282 /* Return the start or end position of the region.
283 BEGINNINGP non-zero means return the start.
284 If there is no region active, signal an error. */
287 region_limit (beginningp
)
290 extern Lisp_Object Vmark_even_if_inactive
; /* Defined in callint.c. */
293 if (!NILP (Vtransient_mark_mode
)
294 && NILP (Vmark_even_if_inactive
)
295 && NILP (current_buffer
->mark_active
))
296 Fsignal (Qmark_inactive
, Qnil
);
298 m
= Fmarker_position (current_buffer
->mark
);
300 error ("The mark is not set now, so there is no region");
302 if ((PT
< XFASTINT (m
)) == beginningp
)
303 m
= make_number (PT
);
307 DEFUN ("region-beginning", Fregion_beginning
, Sregion_beginning
, 0, 0, 0,
308 doc
: /* Return position of beginning of region, as an integer. */)
311 return region_limit (1);
314 DEFUN ("region-end", Fregion_end
, Sregion_end
, 0, 0, 0,
315 doc
: /* Return position of end of region, as an integer. */)
318 return region_limit (0);
321 DEFUN ("mark-marker", Fmark_marker
, Smark_marker
, 0, 0, 0,
322 doc
: /* Return this buffer's mark, as a marker object.
323 Watch out! Moving this marker changes the mark position.
324 If you set the marker not to point anywhere, the buffer will have no mark. */)
327 return current_buffer
->mark
;
331 /* Find the field surrounding POS in *BEG and *END. If POS is nil,
332 the value of point is used instead. If BEG or END null,
333 means don't store the beginning or end of the field.
335 BEG_LIMIT and END_LIMIT serve to limit the ranged of the returned
336 results; they do not effect boundary behavior.
338 If MERGE_AT_BOUNDARY is nonzero, then if POS is at the very first
339 position of a field, then the beginning of the previous field is
340 returned instead of the beginning of POS's field (since the end of a
341 field is actually also the beginning of the next input field, this
342 behavior is sometimes useful). Additionally in the MERGE_AT_BOUNDARY
343 true case, if two fields are separated by a field with the special
344 value `boundary', and POS lies within it, then the two separated
345 fields are considered to be adjacent, and POS between them, when
346 finding the beginning and ending of the "merged" field.
348 Either BEG or END may be 0, in which case the corresponding value
352 find_field (pos
, merge_at_boundary
, beg_limit
, beg
, end_limit
, end
)
354 Lisp_Object merge_at_boundary
;
355 Lisp_Object beg_limit
, end_limit
;
358 /* Fields right before and after the point. */
359 Lisp_Object before_field
, after_field
;
360 /* If the fields came from overlays, the associated overlays.
361 Qnil means they came from text-properties. */
362 Lisp_Object before_overlay
= Qnil
, after_overlay
= Qnil
;
363 /* 1 if POS counts as the start of a field. */
364 int at_field_start
= 0;
365 /* 1 if POS counts as the end of a field. */
366 int at_field_end
= 0;
369 XSETFASTINT (pos
, PT
);
371 CHECK_NUMBER_COERCE_MARKER (pos
);
374 = get_char_property_and_overlay (pos
, Qfield
, Qnil
, &after_overlay
);
376 = (XFASTINT (pos
) > BEGV
377 ? get_char_property_and_overlay (make_number (XINT (pos
) - 1),
382 /* See if we need to handle the case where MERGE_AT_BOUNDARY is nil
383 and POS is at beginning of a field, which can also be interpreted
384 as the end of the previous field. Note that the case where if
385 MERGE_AT_BOUNDARY is non-nil (see function comment) is actually the
386 more natural one; then we avoid treating the beginning of a field
388 if (NILP (merge_at_boundary
) && !EQ (after_field
, before_field
))
389 /* We are at a boundary, see which direction is inclusive. We
390 decide by seeing which field the `field' property sticks to. */
392 /* -1 means insertions go into before_field, 1 means they go
393 into after_field, 0 means neither. */
395 /* Whether the before/after_field come from overlays. */
396 int bop
= !NILP (before_overlay
);
397 int aop
= !NILP (after_overlay
);
399 if (bop
&& XMARKER (OVERLAY_END (before_overlay
))->insertion_type
== 1)
400 /* before_field is from an overlay, which expands upon
401 end-insertions. Note that it's possible for after_overlay to
402 also eat insertions here, but then they will overlap, and
403 there's not much we can do. */
406 && XMARKER (OVERLAY_START (after_overlay
))->insertion_type
== 0)
407 /* after_field is from an overlay, which expand to contain
411 /* Both fields come from overlays, but neither will contain any
415 /* before_field is an overlay that won't eat any insertion, but
416 after_field is from a text-property. Assume that the
417 text-property continues underneath the overlay, and so will
418 be inherited by any insertion, regardless of any stickiness
422 /* Similarly, when after_field is the overlay. */
425 /* Both fields come from text-properties. Look for explicit
426 stickiness properties. */
427 stickiness
= text_property_stickiness (Qfield
, pos
);
431 else if (stickiness
< 0)
434 /* STICKINESS == 0 means that any inserted text will get a
435 `field' char-property of nil, so check to see if that
436 matches either of the adjacent characters (this being a
437 kind of "stickiness by default"). */
439 if (NILP (before_field
))
440 at_field_end
= 1; /* Sticks to the left. */
441 else if (NILP (after_field
))
442 at_field_start
= 1; /* Sticks to the right. */
446 /* Note about special `boundary' fields:
448 Consider the case where the point (`.') is between the fields `x' and `y':
452 In this situation, if merge_at_boundary is true, we consider the
453 `x' and `y' fields as forming one big merged field, and so the end
454 of the field is the end of `y'.
456 However, if `x' and `y' are separated by a special `boundary' field
457 (a field with a `field' char-property of 'boundary), then we ignore
458 this special field when merging adjacent fields. Here's the same
459 situation, but with a `boundary' field between the `x' and `y' fields:
463 Here, if point is at the end of `x', the beginning of `y', or
464 anywhere in-between (within the `boundary' field), we merge all
465 three fields and consider the beginning as being the beginning of
466 the `x' field, and the end as being the end of the `y' field. */
471 /* POS is at the edge of a field, and we should consider it as
472 the beginning of the following field. */
473 *beg
= XFASTINT (pos
);
475 /* Find the previous field boundary. */
477 if (!NILP (merge_at_boundary
) && EQ (before_field
, Qboundary
))
478 /* Skip a `boundary' field. */
479 pos
= Fprevious_single_char_property_change (pos
, Qfield
, Qnil
,
482 pos
= Fprevious_single_char_property_change (pos
, Qfield
, Qnil
,
484 *beg
= NILP (pos
) ? BEGV
: XFASTINT (pos
);
491 /* POS is at the edge of a field, and we should consider it as
492 the end of the previous field. */
493 *end
= XFASTINT (pos
);
495 /* Find the next field boundary. */
497 if (!NILP (merge_at_boundary
) && EQ (after_field
, Qboundary
))
498 /* Skip a `boundary' field. */
499 pos
= Fnext_single_char_property_change (pos
, Qfield
, Qnil
,
502 pos
= Fnext_single_char_property_change (pos
, Qfield
, Qnil
,
504 *end
= NILP (pos
) ? ZV
: XFASTINT (pos
);
510 DEFUN ("delete-field", Fdelete_field
, Sdelete_field
, 0, 1, 0,
511 doc
: /* Delete the field surrounding POS.
512 A field is a region of text with the same `field' property.
513 If POS is nil, the value of point is used for POS. */)
518 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
520 del_range (beg
, end
);
524 DEFUN ("field-string", Ffield_string
, Sfield_string
, 0, 1, 0,
525 doc
: /* Return the contents of the field surrounding POS as a string.
526 A field is a region of text with the same `field' property.
527 If POS is nil, the value of point is used for POS. */)
532 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
533 return make_buffer_string (beg
, end
, 1);
536 DEFUN ("field-string-no-properties", Ffield_string_no_properties
, Sfield_string_no_properties
, 0, 1, 0,
537 doc
: /* Return the contents of the field around POS, without text-properties.
538 A field is a region of text with the same `field' property.
539 If POS is nil, the value of point is used for POS. */)
544 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
545 return make_buffer_string (beg
, end
, 0);
548 DEFUN ("field-beginning", Ffield_beginning
, Sfield_beginning
, 0, 3, 0,
549 doc
: /* Return the beginning of the field surrounding POS.
550 A field is a region of text with the same `field' property.
551 If POS is nil, the value of point is used for POS.
552 If ESCAPE-FROM-EDGE is non-nil and POS is at the beginning of its
553 field, then the beginning of the *previous* field is returned.
554 If LIMIT is non-nil, it is a buffer position; if the beginning of the field
555 is before LIMIT, then LIMIT will be returned instead. */)
556 (pos
, escape_from_edge
, limit
)
557 Lisp_Object pos
, escape_from_edge
, limit
;
560 find_field (pos
, escape_from_edge
, limit
, &beg
, Qnil
, 0);
561 return make_number (beg
);
564 DEFUN ("field-end", Ffield_end
, Sfield_end
, 0, 3, 0,
565 doc
: /* Return the end of the field surrounding POS.
566 A field is a region of text with the same `field' property.
567 If POS is nil, the value of point is used for POS.
568 If ESCAPE-FROM-EDGE is non-nil and POS is at the end of its field,
569 then the end of the *following* field is returned.
570 If LIMIT is non-nil, it is a buffer position; if the end of the field
571 is after LIMIT, then LIMIT will be returned instead. */)
572 (pos
, escape_from_edge
, limit
)
573 Lisp_Object pos
, escape_from_edge
, limit
;
576 find_field (pos
, escape_from_edge
, Qnil
, 0, limit
, &end
);
577 return make_number (end
);
580 DEFUN ("constrain-to-field", Fconstrain_to_field
, Sconstrain_to_field
, 2, 5, 0,
581 doc
: /* Return the position closest to NEW-POS that is in the same field as OLD-POS.
583 A field is a region of text with the same `field' property.
584 If NEW-POS is nil, then the current point is used instead, and set to the
585 constrained position if that is different.
587 If OLD-POS is at the boundary of two fields, then the allowable
588 positions for NEW-POS depends on the value of the optional argument
589 ESCAPE-FROM-EDGE: If ESCAPE-FROM-EDGE is nil, then NEW-POS is
590 constrained to the field that has the same `field' char-property
591 as any new characters inserted at OLD-POS, whereas if ESCAPE-FROM-EDGE
592 is non-nil, NEW-POS is constrained to the union of the two adjacent
593 fields. Additionally, if two fields are separated by another field with
594 the special value `boundary', then any point within this special field is
595 also considered to be `on the boundary'.
597 If the optional argument ONLY-IN-LINE is non-nil and constraining
598 NEW-POS would move it to a different line, NEW-POS is returned
599 unconstrained. This useful for commands that move by line, like
600 \\[next-line] or \\[beginning-of-line], which should generally respect field boundaries
601 only in the case where they can still move to the right line.
603 If the optional argument INHIBIT-CAPTURE-PROPERTY is non-nil, and OLD-POS has
604 a non-nil property of that name, then any field boundaries are ignored.
606 Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil. */)
607 (new_pos
, old_pos
, escape_from_edge
, only_in_line
, inhibit_capture_property
)
608 Lisp_Object new_pos
, old_pos
;
609 Lisp_Object escape_from_edge
, only_in_line
, inhibit_capture_property
;
611 /* If non-zero, then the original point, before re-positioning. */
615 /* Use the current point, and afterwards, set it. */
618 XSETFASTINT (new_pos
, PT
);
621 if (NILP (Vinhibit_field_text_motion
)
622 && !EQ (new_pos
, old_pos
)
623 && (!NILP (Fget_char_property (new_pos
, Qfield
, Qnil
))
624 || !NILP (Fget_char_property (old_pos
, Qfield
, Qnil
)))
625 && (NILP (inhibit_capture_property
)
626 || NILP (Fget_char_property(old_pos
, inhibit_capture_property
, Qnil
))))
627 /* NEW_POS is not within the same field as OLD_POS; try to
628 move NEW_POS so that it is. */
631 Lisp_Object field_bound
;
633 CHECK_NUMBER_COERCE_MARKER (new_pos
);
634 CHECK_NUMBER_COERCE_MARKER (old_pos
);
636 fwd
= (XFASTINT (new_pos
) > XFASTINT (old_pos
));
639 field_bound
= Ffield_end (old_pos
, escape_from_edge
, new_pos
);
641 field_bound
= Ffield_beginning (old_pos
, escape_from_edge
, new_pos
);
643 if (/* See if ESCAPE_FROM_EDGE caused FIELD_BOUND to jump to the
644 other side of NEW_POS, which would mean that NEW_POS is
645 already acceptable, and it's not necessary to constrain it
647 ((XFASTINT (field_bound
) < XFASTINT (new_pos
)) ? fwd
: !fwd
)
648 /* NEW_POS should be constrained, but only if either
649 ONLY_IN_LINE is nil (in which case any constraint is OK),
650 or NEW_POS and FIELD_BOUND are on the same line (in which
651 case the constraint is OK even if ONLY_IN_LINE is non-nil). */
652 && (NILP (only_in_line
)
653 /* This is the ONLY_IN_LINE case, check that NEW_POS and
654 FIELD_BOUND are on the same line by seeing whether
655 there's an intervening newline or not. */
656 || (scan_buffer ('\n',
657 XFASTINT (new_pos
), XFASTINT (field_bound
),
658 fwd
? -1 : 1, &shortage
, 1),
660 /* Constrain NEW_POS to FIELD_BOUND. */
661 new_pos
= field_bound
;
663 if (orig_point
&& XFASTINT (new_pos
) != orig_point
)
664 /* The NEW_POS argument was originally nil, so automatically set PT. */
665 SET_PT (XFASTINT (new_pos
));
672 DEFUN ("line-beginning-position",
673 Fline_beginning_position
, Sline_beginning_position
, 0, 1, 0,
674 doc
: /* Return the character position of the first character on the current line.
675 With argument N not nil or 1, move forward N - 1 lines first.
676 If scan reaches end of buffer, return that position.
678 The scan does not cross a field boundary unless doing so would move
679 beyond there to a different line; if N is nil or 1, and scan starts at a
680 field boundary, the scan stops as soon as it starts. To ignore field
681 boundaries bind `inhibit-field-text-motion' to t.
683 This function does not move point. */)
687 int orig
, orig_byte
, end
;
696 Fforward_line (make_number (XINT (n
) - 1));
699 SET_PT_BOTH (orig
, orig_byte
);
701 /* Return END constrained to the current input field. */
702 return Fconstrain_to_field (make_number (end
), make_number (orig
),
703 XINT (n
) != 1 ? Qt
: Qnil
,
707 DEFUN ("line-end-position", Fline_end_position
, Sline_end_position
, 0, 1, 0,
708 doc
: /* Return the character position of the last character on the current line.
709 With argument N not nil or 1, move forward N - 1 lines first.
710 If scan reaches end of buffer, return that position.
712 The scan does not cross a field boundary unless doing so would move
713 beyond there to a different line; if N is nil or 1, and scan starts at a
714 field boundary, the scan stops as soon as it starts. To ignore field
715 boundaries bind `inhibit-field-text-motion' to t.
717 This function does not move point. */)
729 end_pos
= find_before_next_newline (orig
, 0, XINT (n
) - (XINT (n
) <= 0));
731 /* Return END_POS constrained to the current input field. */
732 return Fconstrain_to_field (make_number (end_pos
), make_number (orig
),
738 save_excursion_save ()
740 int visible
= (XBUFFER (XWINDOW (selected_window
)->buffer
)
743 return Fcons (Fpoint_marker (),
744 Fcons (Fcopy_marker (current_buffer
->mark
, Qnil
),
745 Fcons (visible
? Qt
: Qnil
,
746 Fcons (current_buffer
->mark_active
,
751 save_excursion_restore (info
)
754 Lisp_Object tem
, tem1
, omark
, nmark
;
755 struct gcpro gcpro1
, gcpro2
, gcpro3
;
758 tem
= Fmarker_buffer (XCAR (info
));
759 /* If buffer being returned to is now deleted, avoid error */
760 /* Otherwise could get error here while unwinding to top level
762 /* In that case, Fmarker_buffer returns nil now. */
766 omark
= nmark
= Qnil
;
767 GCPRO3 (info
, omark
, nmark
);
774 unchain_marker (tem
);
779 omark
= Fmarker_position (current_buffer
->mark
);
780 Fset_marker (current_buffer
->mark
, tem
, Fcurrent_buffer ());
781 nmark
= Fmarker_position (tem
);
782 unchain_marker (tem
);
786 visible_p
= !NILP (XCAR (info
));
788 #if 0 /* We used to make the current buffer visible in the selected window
789 if that was true previously. That avoids some anomalies.
790 But it creates others, and it wasn't documented, and it is simpler
791 and cleaner never to alter the window/buffer connections. */
794 && current_buffer
!= XBUFFER (XWINDOW (selected_window
)->buffer
))
795 Fswitch_to_buffer (Fcurrent_buffer (), Qnil
);
801 tem1
= current_buffer
->mark_active
;
802 current_buffer
->mark_active
= tem
;
804 if (!NILP (Vrun_hooks
))
806 /* If mark is active now, and either was not active
807 or was at a different place, run the activate hook. */
808 if (! NILP (current_buffer
->mark_active
))
810 if (! EQ (omark
, nmark
))
811 call1 (Vrun_hooks
, intern ("activate-mark-hook"));
813 /* If mark has ceased to be active, run deactivate hook. */
814 else if (! NILP (tem1
))
815 call1 (Vrun_hooks
, intern ("deactivate-mark-hook"));
818 /* If buffer was visible in a window, and a different window was
819 selected, and the old selected window is still showing this
820 buffer, restore point in that window. */
823 && !EQ (tem
, selected_window
)
824 && (tem1
= XWINDOW (tem
)->buffer
,
825 (/* Window is live... */
827 /* ...and it shows the current buffer. */
828 && XBUFFER (tem1
) == current_buffer
)))
829 Fset_window_point (tem
, make_number (PT
));
835 DEFUN ("save-excursion", Fsave_excursion
, Ssave_excursion
, 0, UNEVALLED
, 0,
836 doc
: /* Save point, mark, and current buffer; execute BODY; restore those things.
837 Executes BODY just like `progn'.
838 The values of point, mark and the current buffer are restored
839 even in case of abnormal exit (throw or error).
840 The state of activation of the mark is also restored.
842 This construct does not save `deactivate-mark', and therefore
843 functions that change the buffer will still cause deactivation
844 of the mark at the end of the command. To prevent that, bind
845 `deactivate-mark' with `let'.
847 usage: (save-excursion &rest BODY) */)
851 register Lisp_Object val
;
852 int count
= SPECPDL_INDEX ();
854 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
857 return unbind_to (count
, val
);
860 DEFUN ("save-current-buffer", Fsave_current_buffer
, Ssave_current_buffer
, 0, UNEVALLED
, 0,
861 doc
: /* Save the current buffer; execute BODY; restore the current buffer.
862 Executes BODY just like `progn'.
863 usage: (save-current-buffer &rest BODY) */)
868 int count
= SPECPDL_INDEX ();
870 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
873 return unbind_to (count
, val
);
876 DEFUN ("buffer-size", Fbufsize
, Sbufsize
, 0, 1, 0,
877 doc
: /* Return the number of characters in the current buffer.
878 If BUFFER, return the number of characters in that buffer instead. */)
883 return make_number (Z
- BEG
);
886 CHECK_BUFFER (buffer
);
887 return make_number (BUF_Z (XBUFFER (buffer
))
888 - BUF_BEG (XBUFFER (buffer
)));
892 DEFUN ("point-min", Fpoint_min
, Spoint_min
, 0, 0, 0,
893 doc
: /* Return the minimum permissible value of point in the current buffer.
894 This is 1, unless narrowing (a buffer restriction) is in effect. */)
898 XSETFASTINT (temp
, BEGV
);
902 DEFUN ("point-min-marker", Fpoint_min_marker
, Spoint_min_marker
, 0, 0, 0,
903 doc
: /* Return a marker to the minimum permissible value of point in this buffer.
904 This is the beginning, unless narrowing (a buffer restriction) is in effect. */)
907 return buildmark (BEGV
, BEGV_BYTE
);
910 DEFUN ("point-max", Fpoint_max
, Spoint_max
, 0, 0, 0,
911 doc
: /* Return the maximum permissible value of point in the current buffer.
912 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
913 is in effect, in which case it is less. */)
917 XSETFASTINT (temp
, ZV
);
921 DEFUN ("point-max-marker", Fpoint_max_marker
, Spoint_max_marker
, 0, 0, 0,
922 doc
: /* Return a marker to the maximum permissible value of point in this buffer.
923 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
924 is in effect, in which case it is less. */)
927 return buildmark (ZV
, ZV_BYTE
);
930 DEFUN ("gap-position", Fgap_position
, Sgap_position
, 0, 0, 0,
931 doc
: /* Return the position of the gap, in the current buffer.
932 See also `gap-size'. */)
936 XSETFASTINT (temp
, GPT
);
940 DEFUN ("gap-size", Fgap_size
, Sgap_size
, 0, 0, 0,
941 doc
: /* Return the size of the current buffer's gap.
942 See also `gap-position'. */)
946 XSETFASTINT (temp
, GAP_SIZE
);
950 DEFUN ("position-bytes", Fposition_bytes
, Sposition_bytes
, 1, 1, 0,
951 doc
: /* Return the byte position for character position POSITION.
952 If POSITION is out of range, the value is nil. */)
954 Lisp_Object position
;
956 CHECK_NUMBER_COERCE_MARKER (position
);
957 if (XINT (position
) < BEG
|| XINT (position
) > Z
)
959 return make_number (CHAR_TO_BYTE (XINT (position
)));
962 DEFUN ("byte-to-position", Fbyte_to_position
, Sbyte_to_position
, 1, 1, 0,
963 doc
: /* Return the character position for byte position BYTEPOS.
964 If BYTEPOS is out of range, the value is nil. */)
968 CHECK_NUMBER (bytepos
);
969 if (XINT (bytepos
) < BEG_BYTE
|| XINT (bytepos
) > Z_BYTE
)
971 return make_number (BYTE_TO_CHAR (XINT (bytepos
)));
974 DEFUN ("following-char", Ffollowing_char
, Sfollowing_char
, 0, 0, 0,
975 doc
: /* Return the character following point, as a number.
976 At the end of the buffer or accessible region, return 0. */)
981 XSETFASTINT (temp
, 0);
983 XSETFASTINT (temp
, FETCH_CHAR (PT_BYTE
));
987 DEFUN ("preceding-char", Fprevious_char
, Sprevious_char
, 0, 0, 0,
988 doc
: /* Return the character preceding point, as a number.
989 At the beginning of the buffer or accessible region, return 0. */)
994 XSETFASTINT (temp
, 0);
995 else if (!NILP (current_buffer
->enable_multibyte_characters
))
999 XSETFASTINT (temp
, FETCH_CHAR (pos
));
1002 XSETFASTINT (temp
, FETCH_BYTE (PT_BYTE
- 1));
1006 DEFUN ("bobp", Fbobp
, Sbobp
, 0, 0, 0,
1007 doc
: /* Return t if point is at the beginning of the buffer.
1008 If the buffer is narrowed, this means the beginning of the narrowed part. */)
1016 DEFUN ("eobp", Feobp
, Seobp
, 0, 0, 0,
1017 doc
: /* Return t if point is at the end of the buffer.
1018 If the buffer is narrowed, this means the end of the narrowed part. */)
1026 DEFUN ("bolp", Fbolp
, Sbolp
, 0, 0, 0,
1027 doc
: /* Return t if point is at the beginning of a line. */)
1030 if (PT
== BEGV
|| FETCH_BYTE (PT_BYTE
- 1) == '\n')
1035 DEFUN ("eolp", Feolp
, Seolp
, 0, 0, 0,
1036 doc
: /* Return t if point is at the end of a line.
1037 `End of a line' includes point being at the end of the buffer. */)
1040 if (PT
== ZV
|| FETCH_BYTE (PT_BYTE
) == '\n')
1045 DEFUN ("char-after", Fchar_after
, Schar_after
, 0, 1, 0,
1046 doc
: /* Return character in current buffer at position POS.
1047 POS is an integer or a marker.
1048 If POS is out of range, the value is nil. */)
1052 register int pos_byte
;
1057 XSETFASTINT (pos
, PT
);
1062 pos_byte
= marker_byte_position (pos
);
1063 if (pos_byte
< BEGV_BYTE
|| pos_byte
>= ZV_BYTE
)
1068 CHECK_NUMBER_COERCE_MARKER (pos
);
1069 if (XINT (pos
) < BEGV
|| XINT (pos
) >= ZV
)
1072 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
1075 return make_number (FETCH_CHAR (pos_byte
));
1078 DEFUN ("char-before", Fchar_before
, Schar_before
, 0, 1, 0,
1079 doc
: /* Return character in current buffer preceding position POS.
1080 POS is an integer or a marker.
1081 If POS is out of range, the value is nil. */)
1085 register Lisp_Object val
;
1086 register int pos_byte
;
1091 XSETFASTINT (pos
, PT
);
1096 pos_byte
= marker_byte_position (pos
);
1098 if (pos_byte
<= BEGV_BYTE
|| pos_byte
> ZV_BYTE
)
1103 CHECK_NUMBER_COERCE_MARKER (pos
);
1105 if (XINT (pos
) <= BEGV
|| XINT (pos
) > ZV
)
1108 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
1111 if (!NILP (current_buffer
->enable_multibyte_characters
))
1114 XSETFASTINT (val
, FETCH_CHAR (pos_byte
));
1119 XSETFASTINT (val
, FETCH_BYTE (pos_byte
));
1124 DEFUN ("user-login-name", Fuser_login_name
, Suser_login_name
, 0, 1, 0,
1125 doc
: /* Return the name under which the user logged in, as a string.
1126 This is based on the effective uid, not the real uid.
1127 Also, if the environment variable LOGNAME or USER is set,
1128 that determines the value of this function.
1130 If optional argument UID is an integer, return the login name of the user
1131 with that uid, or nil if there is no such user. */)
1137 /* Set up the user name info if we didn't do it before.
1138 (That can happen if Emacs is dumpable
1139 but you decide to run `temacs -l loadup' and not dump. */
1140 if (INTEGERP (Vuser_login_name
))
1144 return Vuser_login_name
;
1147 pw
= (struct passwd
*) getpwuid (XINT (uid
));
1148 return (pw
? build_string (pw
->pw_name
) : Qnil
);
1151 DEFUN ("user-real-login-name", Fuser_real_login_name
, Suser_real_login_name
,
1153 doc
: /* Return the name of the user's real uid, as a string.
1154 This ignores the environment variables LOGNAME and USER, so it differs from
1155 `user-login-name' when running under `su'. */)
1158 /* Set up the user name info if we didn't do it before.
1159 (That can happen if Emacs is dumpable
1160 but you decide to run `temacs -l loadup' and not dump. */
1161 if (INTEGERP (Vuser_login_name
))
1163 return Vuser_real_login_name
;
1166 DEFUN ("user-uid", Fuser_uid
, Suser_uid
, 0, 0, 0,
1167 doc
: /* Return the effective uid of Emacs.
1168 Value is an integer or float, depending on the value. */)
1171 return make_fixnum_or_float (geteuid ());
1174 DEFUN ("user-real-uid", Fuser_real_uid
, Suser_real_uid
, 0, 0, 0,
1175 doc
: /* Return the real uid of Emacs.
1176 Value is an integer or float, depending on the value. */)
1179 return make_fixnum_or_float (getuid ());
1182 DEFUN ("user-full-name", Fuser_full_name
, Suser_full_name
, 0, 1, 0,
1183 doc
: /* Return the full name of the user logged in, as a string.
1184 If the full name corresponding to Emacs's userid is not known,
1187 If optional argument UID is an integer or float, return the full name
1188 of the user with that uid, or nil if there is no such user.
1189 If UID is a string, return the full name of the user with that login
1190 name, or nil if there is no such user. */)
1195 register unsigned char *p
, *q
;
1199 return Vuser_full_name
;
1200 else if (NUMBERP (uid
))
1201 pw
= (struct passwd
*) getpwuid ((uid_t
) XFLOATINT (uid
));
1202 else if (STRINGP (uid
))
1203 pw
= (struct passwd
*) getpwnam (SDATA (uid
));
1205 error ("Invalid UID specification");
1210 p
= (unsigned char *) USER_FULL_NAME
;
1211 /* Chop off everything after the first comma. */
1212 q
= (unsigned char *) index (p
, ',');
1213 full
= make_string (p
, q
? q
- p
: strlen (p
));
1215 #ifdef AMPERSAND_FULL_NAME
1217 q
= (unsigned char *) index (p
, '&');
1218 /* Substitute the login name for the &, upcasing the first character. */
1221 register unsigned char *r
;
1224 login
= Fuser_login_name (make_number (pw
->pw_uid
));
1225 r
= (unsigned char *) alloca (strlen (p
) + SCHARS (login
) + 1);
1226 bcopy (p
, r
, q
- p
);
1228 strcat (r
, SDATA (login
));
1229 r
[q
- p
] = UPCASE (r
[q
- p
]);
1231 full
= build_string (r
);
1233 #endif /* AMPERSAND_FULL_NAME */
1238 DEFUN ("system-name", Fsystem_name
, Ssystem_name
, 0, 0, 0,
1239 doc
: /* Return the name of the machine you are running on, as a string. */)
1242 return Vsystem_name
;
1245 /* For the benefit of callers who don't want to include lisp.h */
1250 if (STRINGP (Vsystem_name
))
1251 return (char *) SDATA (Vsystem_name
);
1256 DEFUN ("emacs-pid", Femacs_pid
, Semacs_pid
, 0, 0, 0,
1257 doc
: /* Return the process ID of Emacs, as an integer. */)
1260 return make_number (getpid ());
1263 DEFUN ("current-time", Fcurrent_time
, Scurrent_time
, 0, 0, 0,
1264 doc
: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00.
1265 The time is returned as a list of three integers. The first has the
1266 most significant 16 bits of the seconds, while the second has the
1267 least significant 16 bits. The third integer gives the microsecond
1270 The microsecond count is zero on systems that do not provide
1271 resolution finer than a second. */)
1275 Lisp_Object result
[3];
1278 XSETINT (result
[0], (EMACS_SECS (t
) >> 16) & 0xffff);
1279 XSETINT (result
[1], (EMACS_SECS (t
) >> 0) & 0xffff);
1280 XSETINT (result
[2], EMACS_USECS (t
));
1282 return Flist (3, result
);
1287 lisp_time_argument (specified_time
, result
, usec
)
1288 Lisp_Object specified_time
;
1292 if (NILP (specified_time
))
1299 *usec
= EMACS_USECS (t
);
1300 *result
= EMACS_SECS (t
);
1304 return time (result
) != -1;
1308 Lisp_Object high
, low
;
1309 high
= Fcar (specified_time
);
1310 CHECK_NUMBER (high
);
1311 low
= Fcdr (specified_time
);
1316 Lisp_Object usec_l
= Fcdr (low
);
1318 usec_l
= Fcar (usec_l
);
1323 CHECK_NUMBER (usec_l
);
1324 *usec
= XINT (usec_l
);
1332 *result
= (XINT (high
) << 16) + (XINT (low
) & 0xffff);
1333 return *result
>> 16 == XINT (high
);
1337 DEFUN ("float-time", Ffloat_time
, Sfloat_time
, 0, 1, 0,
1338 doc
: /* Return the current time, as a float number of seconds since the epoch.
1339 If an argument is given, it specifies a time to convert to float
1340 instead of the current time. The argument should have the forms:
1341 (HIGH . LOW) or (HIGH LOW USEC) or (HIGH LOW . USEC).
1342 Thus, you can use times obtained from `current-time'
1343 and from `file-attributes'.
1345 WARNING: Since the result is floating point, it may not be exact.
1346 Do not use this function if precise time stamps are required. */)
1348 Lisp_Object specified_time
;
1353 if (! lisp_time_argument (specified_time
, &sec
, &usec
))
1354 error ("Invalid time specification");
1356 return make_float ((sec
* 1e6
+ usec
) / 1e6
);
1359 /* Write information into buffer S of size MAXSIZE, according to the
1360 FORMAT of length FORMAT_LEN, using time information taken from *TP.
1361 Default to Universal Time if UT is nonzero, local time otherwise.
1362 Return the number of bytes written, not including the terminating
1363 '\0'. If S is NULL, nothing will be written anywhere; so to
1364 determine how many bytes would be written, use NULL for S and
1365 ((size_t) -1) for MAXSIZE.
1367 This function behaves like emacs_strftimeu, except it allows null
1370 emacs_memftimeu (s
, maxsize
, format
, format_len
, tp
, ut
)
1375 const struct tm
*tp
;
1380 /* Loop through all the null-terminated strings in the format
1381 argument. Normally there's just one null-terminated string, but
1382 there can be arbitrarily many, concatenated together, if the
1383 format contains '\0' bytes. emacs_strftimeu stops at the first
1384 '\0' byte so we must invoke it separately for each such string. */
1393 result
= emacs_strftimeu (s
, maxsize
, format
, tp
, ut
);
1397 if (result
== 0 && s
[0] != '\0')
1402 maxsize
-= result
+ 1;
1404 len
= strlen (format
);
1405 if (len
== format_len
)
1409 format_len
-= len
+ 1;
1413 DEFUN ("format-time-string", Fformat_time_string
, Sformat_time_string
, 1, 3, 0,
1414 doc
: /* Use FORMAT-STRING to format the time TIME, or now if omitted.
1415 TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as returned by
1416 `current-time' or `file-attributes'.
1417 The third, optional, argument UNIVERSAL, if non-nil, means describe TIME
1418 as Universal Time; nil means describe TIME in the local time zone.
1419 The value is a copy of FORMAT-STRING, but with certain constructs replaced
1420 by text that describes the specified date and time in TIME:
1422 %Y is the year, %y within the century, %C the century.
1423 %G is the year corresponding to the ISO week, %g within the century.
1424 %m is the numeric month.
1425 %b and %h are the locale's abbreviated month name, %B the full name.
1426 %d is the day of the month, zero-padded, %e is blank-padded.
1427 %u is the numeric day of week from 1 (Monday) to 7, %w from 0 (Sunday) to 6.
1428 %a is the locale's abbreviated name of the day of week, %A the full name.
1429 %U is the week number starting on Sunday, %W starting on Monday,
1430 %V according to ISO 8601.
1431 %j is the day of the year.
1433 %H is the hour on a 24-hour clock, %I is on a 12-hour clock, %k is like %H
1434 only blank-padded, %l is like %I blank-padded.
1435 %p is the locale's equivalent of either AM or PM.
1438 %Z is the time zone name, %z is the numeric form.
1439 %s is the number of seconds since 1970-01-01 00:00:00 +0000.
1441 %c is the locale's date and time format.
1442 %x is the locale's "preferred" date format.
1443 %D is like "%m/%d/%y".
1445 %R is like "%H:%M", %T is like "%H:%M:%S", %r is like "%I:%M:%S %p".
1446 %X is the locale's "preferred" time format.
1448 Finally, %n is a newline, %t is a tab, %% is a literal %.
1450 Certain flags and modifiers are available with some format controls.
1451 The flags are `_', `-', `^' and `#'. For certain characters X,
1452 %_X is like %X, but padded with blanks; %-X is like %X,
1453 ut without padding. %^X is like %X but with all textual
1454 characters up-cased; %#X is like %X but with letter-case of
1455 all textual characters reversed.
1456 %NX (where N stands for an integer) is like %X,
1457 but takes up at least N (a number) positions.
1458 The modifiers are `E' and `O'. For certain characters X,
1459 %EX is a locale's alternative version of %X;
1460 %OX is like %X, but uses the locale's number symbols.
1462 For example, to produce full ISO 8601 format, use "%Y-%m-%dT%T%z". */)
1463 (format_string
, time
, universal
)
1464 Lisp_Object format_string
, time
, universal
;
1469 int ut
= ! NILP (universal
);
1471 CHECK_STRING (format_string
);
1473 if (! lisp_time_argument (time
, &value
, NULL
))
1474 error ("Invalid time specification");
1476 format_string
= code_convert_string_norecord (format_string
,
1477 Vlocale_coding_system
, 1);
1479 /* This is probably enough. */
1480 size
= SBYTES (format_string
) * 6 + 50;
1482 tm
= ut
? gmtime (&value
) : localtime (&value
);
1484 error ("Specified time is not representable");
1486 synchronize_system_time_locale ();
1490 char *buf
= (char *) alloca (size
+ 1);
1494 result
= emacs_memftimeu (buf
, size
, SDATA (format_string
),
1495 SBYTES (format_string
),
1497 if ((result
> 0 && result
< size
) || (result
== 0 && buf
[0] == '\0'))
1498 return code_convert_string_norecord (make_string (buf
, result
),
1499 Vlocale_coding_system
, 0);
1501 /* If buffer was too small, make it bigger and try again. */
1502 result
= emacs_memftimeu (NULL
, (size_t) -1,
1503 SDATA (format_string
),
1504 SBYTES (format_string
),
1510 DEFUN ("decode-time", Fdecode_time
, Sdecode_time
, 0, 1, 0,
1511 doc
: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).
1512 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED)
1513 or (HIGH . LOW), as from `current-time' and `file-attributes', or `nil'
1514 to use the current time. The list has the following nine members:
1515 SEC is an integer between 0 and 60; SEC is 60 for a leap second, which
1516 only some operating systems support. MINUTE is an integer between 0 and 59.
1517 HOUR is an integer between 0 and 23. DAY is an integer between 1 and 31.
1518 MONTH is an integer between 1 and 12. YEAR is an integer indicating the
1519 four-digit year. DOW is the day of week, an integer between 0 and 6, where
1520 0 is Sunday. DST is t if daylight savings time is effect, otherwise nil.
1521 ZONE is an integer indicating the number of seconds east of Greenwich.
1522 (Note that Common Lisp has different meanings for DOW and ZONE.) */)
1524 Lisp_Object specified_time
;
1528 struct tm
*decoded_time
;
1529 Lisp_Object list_args
[9];
1531 if (! lisp_time_argument (specified_time
, &time_spec
, NULL
))
1532 error ("Invalid time specification");
1534 decoded_time
= localtime (&time_spec
);
1536 error ("Specified time is not representable");
1537 XSETFASTINT (list_args
[0], decoded_time
->tm_sec
);
1538 XSETFASTINT (list_args
[1], decoded_time
->tm_min
);
1539 XSETFASTINT (list_args
[2], decoded_time
->tm_hour
);
1540 XSETFASTINT (list_args
[3], decoded_time
->tm_mday
);
1541 XSETFASTINT (list_args
[4], decoded_time
->tm_mon
+ 1);
1542 XSETINT (list_args
[5], decoded_time
->tm_year
+ 1900);
1543 XSETFASTINT (list_args
[6], decoded_time
->tm_wday
);
1544 list_args
[7] = (decoded_time
->tm_isdst
)? Qt
: Qnil
;
1546 /* Make a copy, in case gmtime modifies the struct. */
1547 save_tm
= *decoded_time
;
1548 decoded_time
= gmtime (&time_spec
);
1549 if (decoded_time
== 0)
1550 list_args
[8] = Qnil
;
1552 XSETINT (list_args
[8], tm_diff (&save_tm
, decoded_time
));
1553 return Flist (9, list_args
);
1556 DEFUN ("encode-time", Fencode_time
, Sencode_time
, 6, MANY
, 0,
1557 doc
: /* Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
1558 This is the reverse operation of `decode-time', which see.
1559 ZONE defaults to the current time zone rule. This can
1560 be a string or t (as from `set-time-zone-rule'), or it can be a list
1561 \(as from `current-time-zone') or an integer (as from `decode-time')
1562 applied without consideration for daylight savings time.
1564 You can pass more than 7 arguments; then the first six arguments
1565 are used as SECOND through YEAR, and the *last* argument is used as ZONE.
1566 The intervening arguments are ignored.
1567 This feature lets (apply 'encode-time (decode-time ...)) work.
1569 Out-of-range values for SEC, MINUTE, HOUR, DAY, or MONTH are allowed;
1570 for example, a DAY of 0 means the day preceding the given month.
1571 Year numbers less than 100 are treated just like other year numbers.
1572 If you want them to stand for years in this century, you must do that yourself.
1574 usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */)
1577 register Lisp_Object
*args
;
1581 Lisp_Object zone
= (nargs
> 6 ? args
[nargs
- 1] : Qnil
);
1583 CHECK_NUMBER (args
[0]); /* second */
1584 CHECK_NUMBER (args
[1]); /* minute */
1585 CHECK_NUMBER (args
[2]); /* hour */
1586 CHECK_NUMBER (args
[3]); /* day */
1587 CHECK_NUMBER (args
[4]); /* month */
1588 CHECK_NUMBER (args
[5]); /* year */
1590 tm
.tm_sec
= XINT (args
[0]);
1591 tm
.tm_min
= XINT (args
[1]);
1592 tm
.tm_hour
= XINT (args
[2]);
1593 tm
.tm_mday
= XINT (args
[3]);
1594 tm
.tm_mon
= XINT (args
[4]) - 1;
1595 tm
.tm_year
= XINT (args
[5]) - 1900;
1601 time
= mktime (&tm
);
1606 char **oldenv
= environ
, **newenv
;
1610 else if (STRINGP (zone
))
1611 tzstring
= (char *) SDATA (zone
);
1612 else if (INTEGERP (zone
))
1614 int abszone
= abs (XINT (zone
));
1615 sprintf (tzbuf
, "XXX%s%d:%02d:%02d", "-" + (XINT (zone
) < 0),
1616 abszone
/ (60*60), (abszone
/60) % 60, abszone
% 60);
1620 error ("Invalid time zone specification");
1622 /* Set TZ before calling mktime; merely adjusting mktime's returned
1623 value doesn't suffice, since that would mishandle leap seconds. */
1624 set_time_zone_rule (tzstring
);
1626 time
= mktime (&tm
);
1628 /* Restore TZ to previous value. */
1632 #ifdef LOCALTIME_CACHE
1637 if (time
== (time_t) -1)
1638 error ("Specified time is not representable");
1640 return make_time (time
);
1643 DEFUN ("current-time-string", Fcurrent_time_string
, Scurrent_time_string
, 0, 1, 0,
1644 doc
: /* Return the current time, as a human-readable string.
1645 Programs can use this function to decode a time,
1646 since the number of columns in each field is fixed.
1647 The format is `Sun Sep 16 01:03:52 1973'.
1648 However, see also the functions `decode-time' and `format-time-string'
1649 which provide a much more powerful and general facility.
1651 If an argument is given, it specifies a time to format
1652 instead of the current time. The argument should have the form:
1655 (HIGH LOW . IGNORED).
1656 Thus, you can use times obtained from `current-time'
1657 and from `file-attributes'. */)
1659 Lisp_Object specified_time
;
1665 if (! lisp_time_argument (specified_time
, &value
, NULL
))
1667 tem
= (char *) ctime (&value
);
1669 strncpy (buf
, tem
, 24);
1672 return build_string (buf
);
1675 #define TM_YEAR_BASE 1900
1677 /* Yield A - B, measured in seconds.
1678 This function is copied from the GNU C Library. */
1683 /* Compute intervening leap days correctly even if year is negative.
1684 Take care to avoid int overflow in leap day calculations,
1685 but it's OK to assume that A and B are close to each other. */
1686 int a4
= (a
->tm_year
>> 2) + (TM_YEAR_BASE
>> 2) - ! (a
->tm_year
& 3);
1687 int b4
= (b
->tm_year
>> 2) + (TM_YEAR_BASE
>> 2) - ! (b
->tm_year
& 3);
1688 int a100
= a4
/ 25 - (a4
% 25 < 0);
1689 int b100
= b4
/ 25 - (b4
% 25 < 0);
1690 int a400
= a100
>> 2;
1691 int b400
= b100
>> 2;
1692 int intervening_leap_days
= (a4
- b4
) - (a100
- b100
) + (a400
- b400
);
1693 int years
= a
->tm_year
- b
->tm_year
;
1694 int days
= (365 * years
+ intervening_leap_days
1695 + (a
->tm_yday
- b
->tm_yday
));
1696 return (60 * (60 * (24 * days
+ (a
->tm_hour
- b
->tm_hour
))
1697 + (a
->tm_min
- b
->tm_min
))
1698 + (a
->tm_sec
- b
->tm_sec
));
1701 DEFUN ("current-time-zone", Fcurrent_time_zone
, Scurrent_time_zone
, 0, 1, 0,
1702 doc
: /* Return the offset and name for the local time zone.
1703 This returns a list of the form (OFFSET NAME).
1704 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
1705 A negative value means west of Greenwich.
1706 NAME is a string giving the name of the time zone.
1707 If an argument is given, it specifies when the time zone offset is determined
1708 instead of using the current time. The argument should have the form:
1711 (HIGH LOW . IGNORED).
1712 Thus, you can use times obtained from `current-time'
1713 and from `file-attributes'.
1715 Some operating systems cannot provide all this information to Emacs;
1716 in this case, `current-time-zone' returns a list containing nil for
1717 the data it can't find. */)
1719 Lisp_Object specified_time
;
1725 if (lisp_time_argument (specified_time
, &value
, NULL
)
1726 && (t
= gmtime (&value
)) != 0
1727 && (gmt
= *t
, t
= localtime (&value
)) != 0)
1729 int offset
= tm_diff (t
, &gmt
);
1734 s
= (char *)t
->tm_zone
;
1735 #else /* not HAVE_TM_ZONE */
1737 if (t
->tm_isdst
== 0 || t
->tm_isdst
== 1)
1738 s
= tzname
[t
->tm_isdst
];
1740 #endif /* not HAVE_TM_ZONE */
1742 #if defined HAVE_TM_ZONE || defined HAVE_TZNAME
1745 /* On Japanese w32, we can get a Japanese string as time
1746 zone name. Don't accept that. */
1748 for (p
= s
; *p
&& (isalnum ((unsigned char)*p
) || *p
== ' '); ++p
)
1757 /* No local time zone name is available; use "+-NNNN" instead. */
1758 int am
= (offset
< 0 ? -offset
: offset
) / 60;
1759 sprintf (buf
, "%c%02d%02d", (offset
< 0 ? '-' : '+'), am
/60, am
%60);
1762 return Fcons (make_number (offset
), Fcons (build_string (s
), Qnil
));
1765 return Fmake_list (make_number (2), Qnil
);
1768 /* This holds the value of `environ' produced by the previous
1769 call to Fset_time_zone_rule, or 0 if Fset_time_zone_rule
1770 has never been called. */
1771 static char **environbuf
;
1773 DEFUN ("set-time-zone-rule", Fset_time_zone_rule
, Sset_time_zone_rule
, 1, 1, 0,
1774 doc
: /* Set the local time zone using TZ, a string specifying a time zone rule.
1775 If TZ is nil, use implementation-defined default time zone information.
1776 If TZ is t, use Universal Time. */)
1784 else if (EQ (tz
, Qt
))
1789 tzstring
= (char *) SDATA (tz
);
1792 set_time_zone_rule (tzstring
);
1795 environbuf
= environ
;
1800 #ifdef LOCALTIME_CACHE
1802 /* These two values are known to load tz files in buggy implementations,
1803 i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2.
1804 Their values shouldn't matter in non-buggy implementations.
1805 We don't use string literals for these strings,
1806 since if a string in the environment is in readonly
1807 storage, it runs afoul of bugs in SVR4 and Solaris 2.3.
1808 See Sun bugs 1113095 and 1114114, ``Timezone routines
1809 improperly modify environment''. */
1811 static char set_time_zone_rule_tz1
[] = "TZ=GMT+0";
1812 static char set_time_zone_rule_tz2
[] = "TZ=GMT+1";
1816 /* Set the local time zone rule to TZSTRING.
1817 This allocates memory into `environ', which it is the caller's
1818 responsibility to free. */
1821 set_time_zone_rule (tzstring
)
1825 char **from
, **to
, **newenv
;
1827 /* Make the ENVIRON vector longer with room for TZSTRING. */
1828 for (from
= environ
; *from
; from
++)
1830 envptrs
= from
- environ
+ 2;
1831 newenv
= to
= (char **) xmalloc (envptrs
* sizeof (char *)
1832 + (tzstring
? strlen (tzstring
) + 4 : 0));
1834 /* Add TZSTRING to the end of environ, as a value for TZ. */
1837 char *t
= (char *) (to
+ envptrs
);
1839 strcat (t
, tzstring
);
1843 /* Copy the old environ vector elements into NEWENV,
1844 but don't copy the TZ variable.
1845 So we have only one definition of TZ, which came from TZSTRING. */
1846 for (from
= environ
; *from
; from
++)
1847 if (strncmp (*from
, "TZ=", 3) != 0)
1853 /* If we do have a TZSTRING, NEWENV points to the vector slot where
1854 the TZ variable is stored. If we do not have a TZSTRING,
1855 TO points to the vector slot which has the terminating null. */
1857 #ifdef LOCALTIME_CACHE
1859 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like
1860 "US/Pacific" that loads a tz file, then changes to a value like
1861 "XXX0" that does not load a tz file, and then changes back to
1862 its original value, the last change is (incorrectly) ignored.
1863 Also, if TZ changes twice in succession to values that do
1864 not load a tz file, tzset can dump core (see Sun bug#1225179).
1865 The following code works around these bugs. */
1869 /* Temporarily set TZ to a value that loads a tz file
1870 and that differs from tzstring. */
1872 *newenv
= (strcmp (tzstring
, set_time_zone_rule_tz1
+ 3) == 0
1873 ? set_time_zone_rule_tz2
: set_time_zone_rule_tz1
);
1879 /* The implied tzstring is unknown, so temporarily set TZ to
1880 two different values that each load a tz file. */
1881 *to
= set_time_zone_rule_tz1
;
1884 *to
= set_time_zone_rule_tz2
;
1889 /* Now TZ has the desired value, and tzset can be invoked safely. */
1896 /* Insert NARGS Lisp objects in the array ARGS by calling INSERT_FUNC
1897 (if a type of object is Lisp_Int) or INSERT_FROM_STRING_FUNC (if a
1898 type of object is Lisp_String). INHERIT is passed to
1899 INSERT_FROM_STRING_FUNC as the last argument. */
1902 general_insert_function (insert_func
, insert_from_string_func
,
1903 inherit
, nargs
, args
)
1904 void (*insert_func
) P_ ((const unsigned char *, int));
1905 void (*insert_from_string_func
) P_ ((Lisp_Object
, int, int, int, int, int));
1907 register Lisp_Object
*args
;
1909 register int argnum
;
1910 register Lisp_Object val
;
1912 for (argnum
= 0; argnum
< nargs
; argnum
++)
1918 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1921 if (!NILP (current_buffer
->enable_multibyte_characters
))
1922 len
= CHAR_STRING (XFASTINT (val
), str
);
1925 str
[0] = (SINGLE_BYTE_CHAR_P (XINT (val
))
1927 : multibyte_char_to_unibyte (XINT (val
), Qnil
));
1930 (*insert_func
) (str
, len
);
1932 else if (STRINGP (val
))
1934 (*insert_from_string_func
) (val
, 0, 0,
1941 val
= wrong_type_argument (Qchar_or_string_p
, val
);
1955 /* Callers passing one argument to Finsert need not gcpro the
1956 argument "array", since the only element of the array will
1957 not be used after calling insert or insert_from_string, so
1958 we don't care if it gets trashed. */
1960 DEFUN ("insert", Finsert
, Sinsert
, 0, MANY
, 0,
1961 doc
: /* Insert the arguments, either strings or characters, at point.
1962 Point and before-insertion markers move forward to end up
1963 after the inserted text.
1964 Any other markers at the point of insertion remain before the text.
1966 If the current buffer is multibyte, unibyte strings are converted
1967 to multibyte for insertion (see `unibyte-char-to-multibyte').
1968 If the current buffer is unibyte, multibyte strings are converted
1969 to unibyte for insertion.
1971 usage: (insert &rest ARGS) */)
1974 register Lisp_Object
*args
;
1976 general_insert_function (insert
, insert_from_string
, 0, nargs
, args
);
1980 DEFUN ("insert-and-inherit", Finsert_and_inherit
, Sinsert_and_inherit
,
1982 doc
: /* Insert the arguments at point, inheriting properties from adjoining text.
1983 Point and before-insertion markers move forward to end up
1984 after the inserted text.
1985 Any other markers at the point of insertion remain before the text.
1987 If the current buffer is multibyte, unibyte strings are converted
1988 to multibyte for insertion (see `unibyte-char-to-multibyte').
1989 If the current buffer is unibyte, multibyte strings are converted
1990 to unibyte for insertion.
1992 usage: (insert-and-inherit &rest ARGS) */)
1995 register Lisp_Object
*args
;
1997 general_insert_function (insert_and_inherit
, insert_from_string
, 1,
2002 DEFUN ("insert-before-markers", Finsert_before_markers
, Sinsert_before_markers
, 0, MANY
, 0,
2003 doc
: /* Insert strings or characters at point, relocating markers after the text.
2004 Point and markers move forward to end up after the inserted text.
2006 If the current buffer is multibyte, unibyte strings are converted
2007 to multibyte for insertion (see `unibyte-char-to-multibyte').
2008 If the current buffer is unibyte, multibyte strings are converted
2009 to unibyte for insertion.
2011 usage: (insert-before-markers &rest ARGS) */)
2014 register Lisp_Object
*args
;
2016 general_insert_function (insert_before_markers
,
2017 insert_from_string_before_markers
, 0,
2022 DEFUN ("insert-before-markers-and-inherit", Finsert_and_inherit_before_markers
,
2023 Sinsert_and_inherit_before_markers
, 0, MANY
, 0,
2024 doc
: /* Insert text at point, relocating markers and inheriting properties.
2025 Point and markers move forward to end up after the inserted text.
2027 If the current buffer is multibyte, unibyte strings are converted
2028 to multibyte for insertion (see `unibyte-char-to-multibyte').
2029 If the current buffer is unibyte, multibyte strings are converted
2030 to unibyte for insertion.
2032 usage: (insert-before-markers-and-inherit &rest ARGS) */)
2035 register Lisp_Object
*args
;
2037 general_insert_function (insert_before_markers_and_inherit
,
2038 insert_from_string_before_markers
, 1,
2043 DEFUN ("insert-char", Finsert_char
, Sinsert_char
, 2, 3, 0,
2044 doc
: /* Insert COUNT (second arg) copies of CHARACTER (first arg).
2045 Both arguments are required.
2046 Point, and before-insertion markers, are relocated as in the function `insert'.
2047 The optional third arg INHERIT, if non-nil, says to inherit text properties
2048 from adjoining text, if those properties are sticky. */)
2049 (character
, count
, inherit
)
2050 Lisp_Object character
, count
, inherit
;
2052 register unsigned char *string
;
2053 register int strlen
;
2056 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
2058 CHECK_NUMBER (character
);
2059 CHECK_NUMBER (count
);
2061 if (!NILP (current_buffer
->enable_multibyte_characters
))
2062 len
= CHAR_STRING (XFASTINT (character
), str
);
2064 str
[0] = XFASTINT (character
), len
= 1;
2065 n
= XINT (count
) * len
;
2068 strlen
= min (n
, 256 * len
);
2069 string
= (unsigned char *) alloca (strlen
);
2070 for (i
= 0; i
< strlen
; i
++)
2071 string
[i
] = str
[i
% len
];
2075 if (!NILP (inherit
))
2076 insert_and_inherit (string
, strlen
);
2078 insert (string
, strlen
);
2083 if (!NILP (inherit
))
2084 insert_and_inherit (string
, n
);
2092 /* Making strings from buffer contents. */
2094 /* Return a Lisp_String containing the text of the current buffer from
2095 START to END. If text properties are in use and the current buffer
2096 has properties in the range specified, the resulting string will also
2097 have them, if PROPS is nonzero.
2099 We don't want to use plain old make_string here, because it calls
2100 make_uninit_string, which can cause the buffer arena to be
2101 compacted. make_string has no way of knowing that the data has
2102 been moved, and thus copies the wrong data into the string. This
2103 doesn't effect most of the other users of make_string, so it should
2104 be left as is. But we should use this function when conjuring
2105 buffer substrings. */
2108 make_buffer_string (start
, end
, props
)
2112 int start_byte
= CHAR_TO_BYTE (start
);
2113 int end_byte
= CHAR_TO_BYTE (end
);
2115 return make_buffer_string_both (start
, start_byte
, end
, end_byte
, props
);
2118 /* Return a Lisp_String containing the text of the current buffer from
2119 START / START_BYTE to END / END_BYTE.
2121 If text properties are in use and the current buffer
2122 has properties in the range specified, the resulting string will also
2123 have them, if PROPS is nonzero.
2125 We don't want to use plain old make_string here, because it calls
2126 make_uninit_string, which can cause the buffer arena to be
2127 compacted. make_string has no way of knowing that the data has
2128 been moved, and thus copies the wrong data into the string. This
2129 doesn't effect most of the other users of make_string, so it should
2130 be left as is. But we should use this function when conjuring
2131 buffer substrings. */
2134 make_buffer_string_both (start
, start_byte
, end
, end_byte
, props
)
2135 int start
, start_byte
, end
, end_byte
;
2138 Lisp_Object result
, tem
, tem1
;
2140 if (start
< GPT
&& GPT
< end
)
2143 if (! NILP (current_buffer
->enable_multibyte_characters
))
2144 result
= make_uninit_multibyte_string (end
- start
, end_byte
- start_byte
);
2146 result
= make_uninit_string (end
- start
);
2147 bcopy (BYTE_POS_ADDR (start_byte
), SDATA (result
),
2148 end_byte
- start_byte
);
2150 /* If desired, update and copy the text properties. */
2153 update_buffer_properties (start
, end
);
2155 tem
= Fnext_property_change (make_number (start
), Qnil
, make_number (end
));
2156 tem1
= Ftext_properties_at (make_number (start
), Qnil
);
2158 if (XINT (tem
) != end
|| !NILP (tem1
))
2159 copy_intervals_to_string (result
, current_buffer
, start
,
2166 /* Call Vbuffer_access_fontify_functions for the range START ... END
2167 in the current buffer, if necessary. */
2170 update_buffer_properties (start
, end
)
2173 /* If this buffer has some access functions,
2174 call them, specifying the range of the buffer being accessed. */
2175 if (!NILP (Vbuffer_access_fontify_functions
))
2177 Lisp_Object args
[3];
2180 args
[0] = Qbuffer_access_fontify_functions
;
2181 XSETINT (args
[1], start
);
2182 XSETINT (args
[2], end
);
2184 /* But don't call them if we can tell that the work
2185 has already been done. */
2186 if (!NILP (Vbuffer_access_fontified_property
))
2188 tem
= Ftext_property_any (args
[1], args
[2],
2189 Vbuffer_access_fontified_property
,
2192 Frun_hook_with_args (3, args
);
2195 Frun_hook_with_args (3, args
);
2199 DEFUN ("buffer-substring", Fbuffer_substring
, Sbuffer_substring
, 2, 2, 0,
2200 doc
: /* Return the contents of part of the current buffer as a string.
2201 The two arguments START and END are character positions;
2202 they can be in either order.
2203 The string returned is multibyte if the buffer is multibyte.
2205 This function copies the text properties of that part of the buffer
2206 into the result string; if you don't want the text properties,
2207 use `buffer-substring-no-properties' instead. */)
2209 Lisp_Object start
, end
;
2213 validate_region (&start
, &end
);
2217 return make_buffer_string (b
, e
, 1);
2220 DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties
,
2221 Sbuffer_substring_no_properties
, 2, 2, 0,
2222 doc
: /* Return the characters of part of the buffer, without the text properties.
2223 The two arguments START and END are character positions;
2224 they can be in either order. */)
2226 Lisp_Object start
, end
;
2230 validate_region (&start
, &end
);
2234 return make_buffer_string (b
, e
, 0);
2237 DEFUN ("buffer-string", Fbuffer_string
, Sbuffer_string
, 0, 0, 0,
2238 doc
: /* Return the contents of the current buffer as a string.
2239 If narrowing is in effect, this function returns only the visible part
2243 return make_buffer_string (BEGV
, ZV
, 1);
2246 DEFUN ("insert-buffer-substring", Finsert_buffer_substring
, Sinsert_buffer_substring
,
2248 doc
: /* Insert before point a substring of the contents of buffer BUFFER.
2249 BUFFER may be a buffer or a buffer name.
2250 Arguments START and END are character numbers specifying the substring.
2251 They default to the beginning and the end of BUFFER. */)
2253 Lisp_Object buf
, start
, end
;
2255 register int b
, e
, temp
;
2256 register struct buffer
*bp
, *obuf
;
2259 buffer
= Fget_buffer (buf
);
2262 bp
= XBUFFER (buffer
);
2263 if (NILP (bp
->name
))
2264 error ("Selecting deleted buffer");
2270 CHECK_NUMBER_COERCE_MARKER (start
);
2277 CHECK_NUMBER_COERCE_MARKER (end
);
2282 temp
= b
, b
= e
, e
= temp
;
2284 if (!(BUF_BEGV (bp
) <= b
&& e
<= BUF_ZV (bp
)))
2285 args_out_of_range (start
, end
);
2287 obuf
= current_buffer
;
2288 set_buffer_internal_1 (bp
);
2289 update_buffer_properties (b
, e
);
2290 set_buffer_internal_1 (obuf
);
2292 insert_from_buffer (bp
, b
, e
- b
, 0);
2296 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings
, Scompare_buffer_substrings
,
2298 doc
: /* Compare two substrings of two buffers; return result as number.
2299 the value is -N if first string is less after N-1 chars,
2300 +N if first string is greater after N-1 chars, or 0 if strings match.
2301 Each substring is represented as three arguments: BUFFER, START and END.
2302 That makes six args in all, three for each substring.
2304 The value of `case-fold-search' in the current buffer
2305 determines whether case is significant or ignored. */)
2306 (buffer1
, start1
, end1
, buffer2
, start2
, end2
)
2307 Lisp_Object buffer1
, start1
, end1
, buffer2
, start2
, end2
;
2309 register int begp1
, endp1
, begp2
, endp2
, temp
;
2310 register struct buffer
*bp1
, *bp2
;
2311 register Lisp_Object
*trt
2312 = (!NILP (current_buffer
->case_fold_search
)
2313 ? XCHAR_TABLE (current_buffer
->case_canon_table
)->contents
: 0);
2315 int i1
, i2
, i1_byte
, i2_byte
;
2317 /* Find the first buffer and its substring. */
2320 bp1
= current_buffer
;
2324 buf1
= Fget_buffer (buffer1
);
2327 bp1
= XBUFFER (buf1
);
2328 if (NILP (bp1
->name
))
2329 error ("Selecting deleted buffer");
2333 begp1
= BUF_BEGV (bp1
);
2336 CHECK_NUMBER_COERCE_MARKER (start1
);
2337 begp1
= XINT (start1
);
2340 endp1
= BUF_ZV (bp1
);
2343 CHECK_NUMBER_COERCE_MARKER (end1
);
2344 endp1
= XINT (end1
);
2348 temp
= begp1
, begp1
= endp1
, endp1
= temp
;
2350 if (!(BUF_BEGV (bp1
) <= begp1
2352 && endp1
<= BUF_ZV (bp1
)))
2353 args_out_of_range (start1
, end1
);
2355 /* Likewise for second substring. */
2358 bp2
= current_buffer
;
2362 buf2
= Fget_buffer (buffer2
);
2365 bp2
= XBUFFER (buf2
);
2366 if (NILP (bp2
->name
))
2367 error ("Selecting deleted buffer");
2371 begp2
= BUF_BEGV (bp2
);
2374 CHECK_NUMBER_COERCE_MARKER (start2
);
2375 begp2
= XINT (start2
);
2378 endp2
= BUF_ZV (bp2
);
2381 CHECK_NUMBER_COERCE_MARKER (end2
);
2382 endp2
= XINT (end2
);
2386 temp
= begp2
, begp2
= endp2
, endp2
= temp
;
2388 if (!(BUF_BEGV (bp2
) <= begp2
2390 && endp2
<= BUF_ZV (bp2
)))
2391 args_out_of_range (start2
, end2
);
2395 i1_byte
= buf_charpos_to_bytepos (bp1
, i1
);
2396 i2_byte
= buf_charpos_to_bytepos (bp2
, i2
);
2398 while (i1
< endp1
&& i2
< endp2
)
2400 /* When we find a mismatch, we must compare the
2401 characters, not just the bytes. */
2406 if (! NILP (bp1
->enable_multibyte_characters
))
2408 c1
= BUF_FETCH_MULTIBYTE_CHAR (bp1
, i1_byte
);
2409 BUF_INC_POS (bp1
, i1_byte
);
2414 c1
= BUF_FETCH_BYTE (bp1
, i1
);
2415 c1
= unibyte_char_to_multibyte (c1
);
2419 if (! NILP (bp2
->enable_multibyte_characters
))
2421 c2
= BUF_FETCH_MULTIBYTE_CHAR (bp2
, i2_byte
);
2422 BUF_INC_POS (bp2
, i2_byte
);
2427 c2
= BUF_FETCH_BYTE (bp2
, i2
);
2428 c2
= unibyte_char_to_multibyte (c2
);
2434 c1
= XINT (trt
[c1
]);
2435 c2
= XINT (trt
[c2
]);
2438 return make_number (- 1 - chars
);
2440 return make_number (chars
+ 1);
2445 /* The strings match as far as they go.
2446 If one is shorter, that one is less. */
2447 if (chars
< endp1
- begp1
)
2448 return make_number (chars
+ 1);
2449 else if (chars
< endp2
- begp2
)
2450 return make_number (- chars
- 1);
2452 /* Same length too => they are equal. */
2453 return make_number (0);
2457 subst_char_in_region_unwind (arg
)
2460 return current_buffer
->undo_list
= arg
;
2464 subst_char_in_region_unwind_1 (arg
)
2467 return current_buffer
->filename
= arg
;
2470 DEFUN ("subst-char-in-region", Fsubst_char_in_region
,
2471 Ssubst_char_in_region
, 4, 5, 0,
2472 doc
: /* From START to END, replace FROMCHAR with TOCHAR each time it occurs.
2473 If optional arg NOUNDO is non-nil, don't record this change for undo
2474 and don't mark the buffer as really changed.
2475 Both characters must have the same length of multi-byte form. */)
2476 (start
, end
, fromchar
, tochar
, noundo
)
2477 Lisp_Object start
, end
, fromchar
, tochar
, noundo
;
2479 register int pos
, pos_byte
, stop
, i
, len
, end_byte
;
2481 unsigned char fromstr
[MAX_MULTIBYTE_LENGTH
], tostr
[MAX_MULTIBYTE_LENGTH
];
2483 int count
= SPECPDL_INDEX ();
2484 #define COMBINING_NO 0
2485 #define COMBINING_BEFORE 1
2486 #define COMBINING_AFTER 2
2487 #define COMBINING_BOTH (COMBINING_BEFORE | COMBINING_AFTER)
2488 int maybe_byte_combining
= COMBINING_NO
;
2489 int last_changed
= 0;
2490 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
2492 validate_region (&start
, &end
);
2493 CHECK_NUMBER (fromchar
);
2494 CHECK_NUMBER (tochar
);
2498 len
= CHAR_STRING (XFASTINT (fromchar
), fromstr
);
2499 if (CHAR_STRING (XFASTINT (tochar
), tostr
) != len
)
2500 error ("Characters in subst-char-in-region have different byte-lengths");
2501 if (!ASCII_BYTE_P (*tostr
))
2503 /* If *TOSTR is in the range 0x80..0x9F and TOCHAR is not a
2504 complete multibyte character, it may be combined with the
2505 after bytes. If it is in the range 0xA0..0xFF, it may be
2506 combined with the before and after bytes. */
2507 if (!CHAR_HEAD_P (*tostr
))
2508 maybe_byte_combining
= COMBINING_BOTH
;
2509 else if (BYTES_BY_CHAR_HEAD (*tostr
) > len
)
2510 maybe_byte_combining
= COMBINING_AFTER
;
2516 fromstr
[0] = XFASTINT (fromchar
);
2517 tostr
[0] = XFASTINT (tochar
);
2521 pos_byte
= CHAR_TO_BYTE (pos
);
2522 stop
= CHAR_TO_BYTE (XINT (end
));
2525 /* If we don't want undo, turn off putting stuff on the list.
2526 That's faster than getting rid of things,
2527 and it prevents even the entry for a first change.
2528 Also inhibit locking the file. */
2531 record_unwind_protect (subst_char_in_region_unwind
,
2532 current_buffer
->undo_list
);
2533 current_buffer
->undo_list
= Qt
;
2534 /* Don't do file-locking. */
2535 record_unwind_protect (subst_char_in_region_unwind_1
,
2536 current_buffer
->filename
);
2537 current_buffer
->filename
= Qnil
;
2540 if (pos_byte
< GPT_BYTE
)
2541 stop
= min (stop
, GPT_BYTE
);
2544 int pos_byte_next
= pos_byte
;
2546 if (pos_byte
>= stop
)
2548 if (pos_byte
>= end_byte
) break;
2551 p
= BYTE_POS_ADDR (pos_byte
);
2553 INC_POS (pos_byte_next
);
2556 if (pos_byte_next
- pos_byte
== len
2557 && p
[0] == fromstr
[0]
2559 || (p
[1] == fromstr
[1]
2560 && (len
== 2 || (p
[2] == fromstr
[2]
2561 && (len
== 3 || p
[3] == fromstr
[3]))))))
2566 modify_region (current_buffer
, changed
, XINT (end
));
2568 if (! NILP (noundo
))
2570 if (MODIFF
- 1 == SAVE_MODIFF
)
2572 if (MODIFF
- 1 == current_buffer
->auto_save_modified
)
2573 current_buffer
->auto_save_modified
++;
2577 /* Take care of the case where the new character
2578 combines with neighboring bytes. */
2579 if (maybe_byte_combining
2580 && (maybe_byte_combining
== COMBINING_AFTER
2581 ? (pos_byte_next
< Z_BYTE
2582 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next
)))
2583 : ((pos_byte_next
< Z_BYTE
2584 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next
)))
2585 || (pos_byte
> BEG_BYTE
2586 && ! ASCII_BYTE_P (FETCH_BYTE (pos_byte
- 1))))))
2588 Lisp_Object tem
, string
;
2590 struct gcpro gcpro1
;
2592 tem
= current_buffer
->undo_list
;
2595 /* Make a multibyte string containing this single character. */
2596 string
= make_multibyte_string (tostr
, 1, len
);
2597 /* replace_range is less efficient, because it moves the gap,
2598 but it handles combining correctly. */
2599 replace_range (pos
, pos
+ 1, string
,
2601 pos_byte_next
= CHAR_TO_BYTE (pos
);
2602 if (pos_byte_next
> pos_byte
)
2603 /* Before combining happened. We should not increment
2604 POS. So, to cancel the later increment of POS,
2608 INC_POS (pos_byte_next
);
2610 if (! NILP (noundo
))
2611 current_buffer
->undo_list
= tem
;
2618 record_change (pos
, 1);
2619 for (i
= 0; i
< len
; i
++) *p
++ = tostr
[i
];
2621 last_changed
= pos
+ 1;
2623 pos_byte
= pos_byte_next
;
2629 signal_after_change (changed
,
2630 last_changed
- changed
, last_changed
- changed
);
2631 update_compositions (changed
, last_changed
, CHECK_ALL
);
2634 unbind_to (count
, Qnil
);
2638 DEFUN ("translate-region", Ftranslate_region
, Stranslate_region
, 3, 3, 0,
2639 doc
: /* From START to END, translate characters according to TABLE.
2640 TABLE is a string; the Nth character in it is the mapping
2641 for the character with code N.
2642 This function does not alter multibyte characters.
2643 It returns the number of characters changed. */)
2647 register Lisp_Object table
;
2649 register int pos_byte
, stop
; /* Limits of the region. */
2650 register unsigned char *tt
; /* Trans table. */
2651 register int nc
; /* New character. */
2652 int cnt
; /* Number of changes made. */
2653 int size
; /* Size of translate table. */
2655 int multibyte
= !NILP (current_buffer
->enable_multibyte_characters
);
2657 validate_region (&start
, &end
);
2658 CHECK_STRING (table
);
2660 size
= SBYTES (table
);
2663 pos_byte
= CHAR_TO_BYTE (XINT (start
));
2664 stop
= CHAR_TO_BYTE (XINT (end
));
2665 modify_region (current_buffer
, XINT (start
), XINT (end
));
2669 for (; pos_byte
< stop
; )
2671 register unsigned char *p
= BYTE_POS_ADDR (pos_byte
);
2677 oc
= STRING_CHAR_AND_LENGTH (p
, stop
- pos_byte
, len
);
2680 pos_byte_next
= pos_byte
+ len
;
2681 if (oc
< size
&& len
== 1)
2686 /* Take care of the case where the new character
2687 combines with neighboring bytes. */
2688 if (!ASCII_BYTE_P (nc
)
2689 && (CHAR_HEAD_P (nc
)
2690 ? ! CHAR_HEAD_P (FETCH_BYTE (pos_byte
+ 1))
2691 : (pos_byte
> BEG_BYTE
2692 && ! ASCII_BYTE_P (FETCH_BYTE (pos_byte
- 1)))))
2696 string
= make_multibyte_string (tt
+ oc
, 1, 1);
2697 /* This is less efficient, because it moves the gap,
2698 but it handles combining correctly. */
2699 replace_range (pos
, pos
+ 1, string
,
2701 pos_byte_next
= CHAR_TO_BYTE (pos
);
2702 if (pos_byte_next
> pos_byte
)
2703 /* Before combining happened. We should not
2704 increment POS. So, to cancel the later
2705 increment of POS, we decrease it now. */
2708 INC_POS (pos_byte_next
);
2712 record_change (pos
, 1);
2714 signal_after_change (pos
, 1, 1);
2715 update_compositions (pos
, pos
+ 1, CHECK_BORDER
);
2720 pos_byte
= pos_byte_next
;
2724 return make_number (cnt
);
2727 DEFUN ("delete-region", Fdelete_region
, Sdelete_region
, 2, 2, "r",
2728 doc
: /* Delete the text between point and mark.
2729 When called from a program, expects two arguments,
2730 positions (integers or markers) specifying the stretch to be deleted. */)
2732 Lisp_Object start
, end
;
2734 validate_region (&start
, &end
);
2735 del_range (XINT (start
), XINT (end
));
2739 DEFUN ("delete-and-extract-region", Fdelete_and_extract_region
,
2740 Sdelete_and_extract_region
, 2, 2, 0,
2741 doc
: /* Delete the text between START and END and return it. */)
2743 Lisp_Object start
, end
;
2745 validate_region (&start
, &end
);
2746 return del_range_1 (XINT (start
), XINT (end
), 1, 1);
2749 DEFUN ("widen", Fwiden
, Swiden
, 0, 0, "",
2750 doc
: /* Remove restrictions (narrowing) from current buffer.
2751 This allows the buffer's full text to be seen and edited. */)
2754 if (BEG
!= BEGV
|| Z
!= ZV
)
2755 current_buffer
->clip_changed
= 1;
2757 BEGV_BYTE
= BEG_BYTE
;
2758 SET_BUF_ZV_BOTH (current_buffer
, Z
, Z_BYTE
);
2759 /* Changing the buffer bounds invalidates any recorded current column. */
2760 invalidate_current_column ();
2764 DEFUN ("narrow-to-region", Fnarrow_to_region
, Snarrow_to_region
, 2, 2, "r",
2765 doc
: /* Restrict editing in this buffer to the current region.
2766 The rest of the text becomes temporarily invisible and untouchable
2767 but is not deleted; if you save the buffer in a file, the invisible
2768 text is included in the file. \\[widen] makes all visible again.
2769 See also `save-restriction'.
2771 When calling from a program, pass two arguments; positions (integers
2772 or markers) bounding the text that should remain visible. */)
2774 register Lisp_Object start
, end
;
2776 CHECK_NUMBER_COERCE_MARKER (start
);
2777 CHECK_NUMBER_COERCE_MARKER (end
);
2779 if (XINT (start
) > XINT (end
))
2782 tem
= start
; start
= end
; end
= tem
;
2785 if (!(BEG
<= XINT (start
) && XINT (start
) <= XINT (end
) && XINT (end
) <= Z
))
2786 args_out_of_range (start
, end
);
2788 if (BEGV
!= XFASTINT (start
) || ZV
!= XFASTINT (end
))
2789 current_buffer
->clip_changed
= 1;
2791 SET_BUF_BEGV (current_buffer
, XFASTINT (start
));
2792 SET_BUF_ZV (current_buffer
, XFASTINT (end
));
2793 if (PT
< XFASTINT (start
))
2794 SET_PT (XFASTINT (start
));
2795 if (PT
> XFASTINT (end
))
2796 SET_PT (XFASTINT (end
));
2797 /* Changing the buffer bounds invalidates any recorded current column. */
2798 invalidate_current_column ();
2803 save_restriction_save ()
2805 if (BEGV
== BEG
&& ZV
== Z
)
2806 /* The common case that the buffer isn't narrowed.
2807 We return just the buffer object, which save_restriction_restore
2808 recognizes as meaning `no restriction'. */
2809 return Fcurrent_buffer ();
2811 /* We have to save a restriction, so return a pair of markers, one
2812 for the beginning and one for the end. */
2814 Lisp_Object beg
, end
;
2816 beg
= buildmark (BEGV
, BEGV_BYTE
);
2817 end
= buildmark (ZV
, ZV_BYTE
);
2819 /* END must move forward if text is inserted at its exact location. */
2820 XMARKER(end
)->insertion_type
= 1;
2822 return Fcons (beg
, end
);
2827 save_restriction_restore (data
)
2831 /* A pair of marks bounding a saved restriction. */
2833 struct Lisp_Marker
*beg
= XMARKER (XCAR (data
));
2834 struct Lisp_Marker
*end
= XMARKER (XCDR (data
));
2835 struct buffer
*buf
= beg
->buffer
; /* END should have the same buffer. */
2837 if (beg
->charpos
!= BUF_BEGV(buf
) || end
->charpos
!= BUF_ZV(buf
))
2838 /* The restriction has changed from the saved one, so restore
2839 the saved restriction. */
2841 int pt
= BUF_PT (buf
);
2843 SET_BUF_BEGV_BOTH (buf
, beg
->charpos
, beg
->bytepos
);
2844 SET_BUF_ZV_BOTH (buf
, end
->charpos
, end
->bytepos
);
2846 if (pt
< beg
->charpos
|| pt
> end
->charpos
)
2847 /* The point is outside the new visible range, move it inside. */
2848 SET_BUF_PT_BOTH (buf
,
2849 clip_to_bounds (beg
->charpos
, pt
, end
->charpos
),
2850 clip_to_bounds (beg
->bytepos
, BUF_PT_BYTE(buf
),
2853 buf
->clip_changed
= 1; /* Remember that the narrowing changed. */
2857 /* A buffer, which means that there was no old restriction. */
2859 struct buffer
*buf
= XBUFFER (data
);
2861 if (BUF_BEGV(buf
) != BUF_BEG(buf
) || BUF_ZV(buf
) != BUF_Z(buf
))
2862 /* The buffer has been narrowed, get rid of the narrowing. */
2864 SET_BUF_BEGV_BOTH (buf
, BUF_BEG(buf
), BUF_BEG_BYTE(buf
));
2865 SET_BUF_ZV_BOTH (buf
, BUF_Z(buf
), BUF_Z_BYTE(buf
));
2867 buf
->clip_changed
= 1; /* Remember that the narrowing changed. */
2874 DEFUN ("save-restriction", Fsave_restriction
, Ssave_restriction
, 0, UNEVALLED
, 0,
2875 doc
: /* Execute BODY, saving and restoring current buffer's restrictions.
2876 The buffer's restrictions make parts of the beginning and end invisible.
2877 (They are set up with `narrow-to-region' and eliminated with `widen'.)
2878 This special form, `save-restriction', saves the current buffer's restrictions
2879 when it is entered, and restores them when it is exited.
2880 So any `narrow-to-region' within BODY lasts only until the end of the form.
2881 The old restrictions settings are restored
2882 even in case of abnormal exit (throw or error).
2884 The value returned is the value of the last form in BODY.
2886 Note: if you are using both `save-excursion' and `save-restriction',
2887 use `save-excursion' outermost:
2888 (save-excursion (save-restriction ...))
2890 usage: (save-restriction &rest BODY) */)
2894 register Lisp_Object val
;
2895 int count
= SPECPDL_INDEX ();
2897 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
2898 val
= Fprogn (body
);
2899 return unbind_to (count
, val
);
2902 /* Buffer for the most recent text displayed by Fmessage_box. */
2903 static char *message_text
;
2905 /* Allocated length of that buffer. */
2906 static int message_length
;
2908 DEFUN ("message", Fmessage
, Smessage
, 1, MANY
, 0,
2909 doc
: /* Print a one-line message at the bottom of the screen.
2910 The first argument is a format control string, and the rest are data
2911 to be formatted under control of the string. See `format' for details.
2913 If the first argument is nil, clear any existing message; let the
2914 minibuffer contents show.
2916 usage: (message STRING &rest ARGS) */)
2928 register Lisp_Object val
;
2929 val
= Fformat (nargs
, args
);
2930 message3 (val
, SBYTES (val
), STRING_MULTIBYTE (val
));
2935 DEFUN ("message-box", Fmessage_box
, Smessage_box
, 1, MANY
, 0,
2936 doc
: /* Display a message, in a dialog box if possible.
2937 If a dialog box is not available, use the echo area.
2938 The first argument is a format control string, and the rest are data
2939 to be formatted under control of the string. See `format' for details.
2941 If the first argument is nil, clear any existing message; let the
2942 minibuffer contents show.
2944 usage: (message-box STRING &rest ARGS) */)
2956 register Lisp_Object val
;
2957 val
= Fformat (nargs
, args
);
2959 /* The MS-DOS frames support popup menus even though they are
2960 not FRAME_WINDOW_P. */
2961 if (FRAME_WINDOW_P (XFRAME (selected_frame
))
2962 || FRAME_MSDOS_P (XFRAME (selected_frame
)))
2964 Lisp_Object pane
, menu
, obj
;
2965 struct gcpro gcpro1
;
2966 pane
= Fcons (Fcons (build_string ("OK"), Qt
), Qnil
);
2968 menu
= Fcons (val
, pane
);
2969 obj
= Fx_popup_dialog (Qt
, menu
);
2973 #endif /* HAVE_MENUS */
2974 /* Copy the data so that it won't move when we GC. */
2977 message_text
= (char *)xmalloc (80);
2978 message_length
= 80;
2980 if (SBYTES (val
) > message_length
)
2982 message_length
= SBYTES (val
);
2983 message_text
= (char *)xrealloc (message_text
, message_length
);
2985 bcopy (SDATA (val
), message_text
, SBYTES (val
));
2986 message2 (message_text
, SBYTES (val
),
2987 STRING_MULTIBYTE (val
));
2992 extern Lisp_Object last_nonmenu_event
;
2995 DEFUN ("message-or-box", Fmessage_or_box
, Smessage_or_box
, 1, MANY
, 0,
2996 doc
: /* Display a message in a dialog box or in the echo area.
2997 If this command was invoked with the mouse, use a dialog box if
2998 `use-dialog-box' is non-nil.
2999 Otherwise, use the echo area.
3000 The first argument is a format control string, and the rest are data
3001 to be formatted under control of the string. See `format' for details.
3003 If the first argument is nil, clear any existing message; let the
3004 minibuffer contents show.
3006 usage: (message-or-box STRING &rest ARGS) */)
3012 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
3014 return Fmessage_box (nargs
, args
);
3016 return Fmessage (nargs
, args
);
3019 DEFUN ("current-message", Fcurrent_message
, Scurrent_message
, 0, 0, 0,
3020 doc
: /* Return the string currently displayed in the echo area, or nil if none. */)
3023 return current_message ();
3027 DEFUN ("propertize", Fpropertize
, Spropertize
, 1, MANY
, 0,
3028 doc
: /* Return a copy of STRING with text properties added.
3029 First argument is the string to copy.
3030 Remaining arguments form a sequence of PROPERTY VALUE pairs for text
3031 properties to add to the result.
3032 usage: (propertize STRING &rest PROPERTIES) */)
3037 Lisp_Object properties
, string
;
3038 struct gcpro gcpro1
, gcpro2
;
3041 /* Number of args must be odd. */
3042 if ((nargs
& 1) == 0 || nargs
< 1)
3043 error ("Wrong number of arguments");
3045 properties
= string
= Qnil
;
3046 GCPRO2 (properties
, string
);
3048 /* First argument must be a string. */
3049 CHECK_STRING (args
[0]);
3050 string
= Fcopy_sequence (args
[0]);
3052 for (i
= 1; i
< nargs
; i
+= 2)
3054 CHECK_SYMBOL (args
[i
]);
3055 properties
= Fcons (args
[i
], Fcons (args
[i
+ 1], properties
));
3058 Fadd_text_properties (make_number (0),
3059 make_number (SCHARS (string
)),
3060 properties
, string
);
3061 RETURN_UNGCPRO (string
);
3065 /* Number of bytes that STRING will occupy when put into the result.
3066 MULTIBYTE is nonzero if the result should be multibyte. */
3068 #define CONVERTED_BYTE_SIZE(MULTIBYTE, STRING) \
3069 (((MULTIBYTE) && ! STRING_MULTIBYTE (STRING)) \
3070 ? count_size_as_multibyte (SDATA (STRING), SBYTES (STRING)) \
3073 DEFUN ("format", Fformat
, Sformat
, 1, MANY
, 0,
3074 doc
: /* Format a string out of a control-string and arguments.
3075 The first argument is a control string.
3076 The other arguments are substituted into it to make the result, a string.
3077 It may contain %-sequences meaning to substitute the next argument.
3078 %s means print a string argument. Actually, prints any object, with `princ'.
3079 %d means print as number in decimal (%o octal, %x hex).
3080 %X is like %x, but uses upper case.
3081 %e means print a number in exponential notation.
3082 %f means print a number in decimal-point notation.
3083 %g means print a number in exponential notation
3084 or decimal-point notation, whichever uses fewer characters.
3085 %c means print a number as a single character.
3086 %S means print any object as an s-expression (using `prin1').
3087 The argument used for %d, %o, %x, %e, %f, %g or %c must be a number.
3088 Use %% to put a single % into the output.
3090 usage: (format STRING &rest OBJECTS) */)
3093 register Lisp_Object
*args
;
3095 register int n
; /* The number of the next arg to substitute */
3096 register int total
; /* An estimate of the final length */
3098 register unsigned char *format
, *end
;
3100 /* Nonzero if the output should be a multibyte string,
3101 which is true if any of the inputs is one. */
3103 /* When we make a multibyte string, we must pay attention to the
3104 byte combining problem, i.e., a byte may be combined with a
3105 multibyte charcter of the previous string. This flag tells if we
3106 must consider such a situation or not. */
3107 int maybe_combine_byte
;
3108 unsigned char *this_format
;
3116 /* It should not be necessary to GCPRO ARGS, because
3117 the caller in the interpreter should take care of that. */
3119 /* Try to determine whether the result should be multibyte.
3120 This is not always right; sometimes the result needs to be multibyte
3121 because of an object that we will pass through prin1,
3122 and in that case, we won't know it here. */
3123 for (n
= 0; n
< nargs
; n
++)
3124 if (STRINGP (args
[n
]) && STRING_MULTIBYTE (args
[n
]))
3127 CHECK_STRING (args
[0]);
3129 /* If we start out planning a unibyte result,
3130 and later find it has to be multibyte, we jump back to retry. */
3133 format
= SDATA (args
[0]);
3134 end
= format
+ SBYTES (args
[0]);
3137 /* Make room in result for all the non-%-codes in the control string. */
3138 total
= 5 + CONVERTED_BYTE_SIZE (multibyte
, args
[0]);
3140 /* Add to TOTAL enough space to hold the converted arguments. */
3143 while (format
!= end
)
3144 if (*format
++ == '%')
3147 int actual_width
= 0;
3148 unsigned char *this_format_start
= format
- 1;
3149 int field_width
, precision
;
3151 /* General format specifications look like
3153 '%' [flags] [field-width] [precision] format
3158 field-width ::= [0-9]+
3159 precision ::= '.' [0-9]*
3161 If a field-width is specified, it specifies to which width
3162 the output should be padded with blanks, iff the output
3163 string is shorter than field-width.
3165 if precision is specified, it specifies the number of
3166 digits to print after the '.' for floats, or the max.
3167 number of chars to print from a string. */
3169 precision
= field_width
= 0;
3171 while (index ("-*# 0", *format
))
3174 if (*format
>= '0' && *format
<= '9')
3176 for (field_width
= 0; *format
>= '0' && *format
<= '9'; ++format
)
3177 field_width
= 10 * field_width
+ *format
- '0';
3183 for (precision
= 0; *format
>= '0' && *format
<= '9'; ++format
)
3184 precision
= 10 * precision
+ *format
- '0';
3187 if (format
- this_format_start
+ 1 > longest_format
)
3188 longest_format
= format
- this_format_start
+ 1;
3191 error ("Format string ends in middle of format specifier");
3194 else if (++n
>= nargs
)
3195 error ("Not enough arguments for format string");
3196 else if (*format
== 'S')
3198 /* For `S', prin1 the argument and then treat like a string. */
3199 register Lisp_Object tem
;
3200 tem
= Fprin1_to_string (args
[n
], Qnil
);
3201 if (STRING_MULTIBYTE (tem
) && ! multibyte
)
3209 else if (SYMBOLP (args
[n
]))
3211 args
[n
] = SYMBOL_NAME (args
[n
]);
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
= SBYTES (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
= SDATA (args
[0]);
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 (SREF (args
[n
], 0)))
3351 maybe_combine_byte
= 1;
3352 nbytes
= copy_text (SDATA (args
[n
]), p
,
3354 STRING_MULTIBYTE (args
[n
]), multibyte
);
3356 nchars
+= SCHARS (args
[n
]);
3360 while (padding
-- > 0)
3366 /* If this argument has text properties, record where
3367 in the result string it appears. */
3368 if (STRING_INTERVALS (args
[n
]))
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 (STRING_INTERVALS (args
[0]) || info
)
3449 Lisp_Object len
, new_len
, props
;
3450 struct gcpro gcpro1
;
3452 /* Add text properties from the format string. */
3453 len
= make_number (SCHARS (args
[0]));
3454 props
= text_property_list (args
[0], make_number (0), len
, Qnil
);
3459 new_len
= make_number (SCHARS (val
));
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 (SCHARS (args
[n
]));
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
);