76 |
static int lisp_time_argument P_ ((Lisp_Object, time_t *, int *)); |
static int lisp_time_argument P_ ((Lisp_Object, time_t *, int *)); |
77 |
static size_t emacs_memftimeu P_ ((char *, size_t, const char *, |
static size_t emacs_memftimeu P_ ((char *, size_t, const char *, |
78 |
size_t, const struct tm *, int)); |
size_t, const struct tm *, int)); |
79 |
static void general_insert_function P_ ((void (*) (unsigned char *, int), |
static void general_insert_function P_ ((void (*) (const unsigned char *, int), |
80 |
void (*) (Lisp_Object, int, int, int, |
void (*) (Lisp_Object, int, int, int, |
81 |
int, int), |
int, int), |
82 |
int, int, Lisp_Object *)); |
int, int, Lisp_Object *)); |
194 |
register Lisp_Object string; |
register Lisp_Object string; |
195 |
{ |
{ |
196 |
register Lisp_Object val; |
register Lisp_Object val; |
|
register struct Lisp_String *p; |
|
197 |
CHECK_STRING (string); |
CHECK_STRING (string); |
198 |
p = XSTRING (string); |
if (SCHARS (string)) |
|
if (p->size) |
|
199 |
{ |
{ |
200 |
if (STRING_MULTIBYTE (string)) |
if (STRING_MULTIBYTE (string)) |
201 |
XSETFASTINT (val, STRING_CHAR (p->data, STRING_BYTES (p))); |
XSETFASTINT (val, STRING_CHAR (SDATA (string), SBYTES (string))); |
202 |
else |
else |
203 |
XSETFASTINT (val, p->data[0]); |
XSETFASTINT (val, SREF (string, 0)); |
204 |
} |
} |
205 |
else |
else |
206 |
XSETFASTINT (val, 0); |
XSETFASTINT (val, 0); |
289 |
{ |
{ |
290 |
extern Lisp_Object Vmark_even_if_inactive; /* Defined in callint.c. */ |
extern Lisp_Object Vmark_even_if_inactive; /* Defined in callint.c. */ |
291 |
Lisp_Object m; |
Lisp_Object m; |
292 |
|
|
293 |
if (!NILP (Vtransient_mark_mode) |
if (!NILP (Vtransient_mark_mode) |
294 |
&& NILP (Vmark_even_if_inactive) |
&& NILP (Vmark_even_if_inactive) |
295 |
&& NILP (current_buffer->mark_active)) |
&& NILP (current_buffer->mark_active)) |
296 |
Fsignal (Qmark_inactive, Qnil); |
Fsignal (Qmark_inactive, Qnil); |
297 |
|
|
298 |
m = Fmarker_position (current_buffer->mark); |
m = Fmarker_position (current_buffer->mark); |
299 |
if (NILP (m)) |
if (NILP (m)) |
300 |
error ("The mark is not set now, so there is no region"); |
error ("The mark is not set now, so there is no region"); |
301 |
|
|
302 |
if ((PT < XFASTINT (m)) == beginningp) |
if ((PT < XFASTINT (m)) == beginningp) |
303 |
m = make_number (PT); |
m = make_number (PT); |
304 |
return m; |
return m; |
328 |
} |
} |
329 |
|
|
330 |
|
|
331 |
|
/* Find all the overlays in the current buffer that touch position POS. |
332 |
|
Return the number found, and store them in a vector in VEC |
333 |
|
of length LEN. */ |
334 |
|
|
335 |
|
static int |
336 |
|
overlays_around (pos, vec, len) |
337 |
|
int pos; |
338 |
|
Lisp_Object *vec; |
339 |
|
int len; |
340 |
|
{ |
341 |
|
Lisp_Object tail, overlay, start, end; |
342 |
|
int startpos, endpos; |
343 |
|
int idx = 0; |
344 |
|
|
345 |
|
for (tail = current_buffer->overlays_before; |
346 |
|
GC_CONSP (tail); |
347 |
|
tail = XCDR (tail)) |
348 |
|
{ |
349 |
|
overlay = XCAR (tail); |
350 |
|
|
351 |
|
end = OVERLAY_END (overlay); |
352 |
|
endpos = OVERLAY_POSITION (end); |
353 |
|
if (endpos < pos) |
354 |
|
break; |
355 |
|
start = OVERLAY_START (overlay); |
356 |
|
startpos = OVERLAY_POSITION (start); |
357 |
|
if (startpos <= pos) |
358 |
|
{ |
359 |
|
if (idx < len) |
360 |
|
vec[idx] = overlay; |
361 |
|
/* Keep counting overlays even if we can't return them all. */ |
362 |
|
idx++; |
363 |
|
} |
364 |
|
} |
365 |
|
|
366 |
|
for (tail = current_buffer->overlays_after; |
367 |
|
GC_CONSP (tail); |
368 |
|
tail = XCDR (tail)) |
369 |
|
{ |
370 |
|
overlay = XCAR (tail); |
371 |
|
|
372 |
|
start = OVERLAY_START (overlay); |
373 |
|
startpos = OVERLAY_POSITION (start); |
374 |
|
if (pos < startpos) |
375 |
|
break; |
376 |
|
end = OVERLAY_END (overlay); |
377 |
|
endpos = OVERLAY_POSITION (end); |
378 |
|
if (pos <= endpos) |
379 |
|
{ |
380 |
|
if (idx < len) |
381 |
|
vec[idx] = overlay; |
382 |
|
idx++; |
383 |
|
} |
384 |
|
} |
385 |
|
|
386 |
|
return idx; |
387 |
|
} |
388 |
|
|
389 |
|
/* Return the value of property PROP, in OBJECT at POSITION. |
390 |
|
It's the value of PROP that a char inserted at POSITION would get. |
391 |
|
OBJECT is optional and defaults to the current buffer. |
392 |
|
If OBJECT is a buffer, then overlay properties are considered as well as |
393 |
|
text properties. |
394 |
|
If OBJECT is a window, then that window's buffer is used, but |
395 |
|
window-specific overlays are considered only if they are associated |
396 |
|
with OBJECT. */ |
397 |
|
Lisp_Object |
398 |
|
get_pos_property (position, prop, object) |
399 |
|
Lisp_Object position, object; |
400 |
|
register Lisp_Object prop; |
401 |
|
{ |
402 |
|
struct window *w = 0; |
403 |
|
|
404 |
|
CHECK_NUMBER_COERCE_MARKER (position); |
405 |
|
|
406 |
|
if (NILP (object)) |
407 |
|
XSETBUFFER (object, current_buffer); |
408 |
|
|
409 |
|
if (WINDOWP (object)) |
410 |
|
{ |
411 |
|
w = XWINDOW (object); |
412 |
|
object = w->buffer; |
413 |
|
} |
414 |
|
if (BUFFERP (object)) |
415 |
|
{ |
416 |
|
int posn = XINT (position); |
417 |
|
int noverlays; |
418 |
|
Lisp_Object *overlay_vec, tem; |
419 |
|
struct buffer *obuf = current_buffer; |
420 |
|
|
421 |
|
set_buffer_temp (XBUFFER (object)); |
422 |
|
|
423 |
|
/* First try with room for 40 overlays. */ |
424 |
|
noverlays = 40; |
425 |
|
overlay_vec = (Lisp_Object *) alloca (noverlays * sizeof (Lisp_Object)); |
426 |
|
noverlays = overlays_around (posn, overlay_vec, noverlays); |
427 |
|
|
428 |
|
/* If there are more than 40, |
429 |
|
make enough space for all, and try again. */ |
430 |
|
if (noverlays > 40) |
431 |
|
{ |
432 |
|
overlay_vec = (Lisp_Object *) alloca (noverlays * sizeof (Lisp_Object)); |
433 |
|
noverlays = overlays_around (posn, overlay_vec, noverlays); |
434 |
|
} |
435 |
|
noverlays = sort_overlays (overlay_vec, noverlays, NULL); |
436 |
|
|
437 |
|
set_buffer_temp (obuf); |
438 |
|
|
439 |
|
/* Now check the overlays in order of decreasing priority. */ |
440 |
|
while (--noverlays >= 0) |
441 |
|
{ |
442 |
|
Lisp_Object ol = overlay_vec[noverlays]; |
443 |
|
tem = Foverlay_get (ol, prop); |
444 |
|
if (!NILP (tem)) |
445 |
|
{ |
446 |
|
/* Check the overlay is indeed active at point. */ |
447 |
|
Lisp_Object start = OVERLAY_START (ol), finish = OVERLAY_END (ol); |
448 |
|
if ((OVERLAY_POSITION (start) == posn |
449 |
|
&& XMARKER (start)->insertion_type == 1) |
450 |
|
|| (OVERLAY_POSITION (finish) == posn |
451 |
|
&& XMARKER (finish)->insertion_type == 0)) |
452 |
|
; /* The overlay will not cover a char inserted at point. */ |
453 |
|
else |
454 |
|
{ |
455 |
|
return tem; |
456 |
|
} |
457 |
|
} |
458 |
|
} |
459 |
|
|
460 |
|
} |
461 |
|
|
462 |
|
{ /* Now check the text-properties. */ |
463 |
|
int stickiness = text_property_stickiness (prop, position); |
464 |
|
if (stickiness > 0) |
465 |
|
return Fget_text_property (position, prop, Qnil); |
466 |
|
else if (stickiness < 0 && XINT (position) > BEGV) |
467 |
|
return Fget_text_property (make_number (XINT (position) - 1), |
468 |
|
prop, Qnil); |
469 |
|
else |
470 |
|
return Qnil; |
471 |
|
} |
472 |
|
} |
473 |
|
|
474 |
/* Find the field surrounding POS in *BEG and *END. If POS is nil, |
/* Find the field surrounding POS in *BEG and *END. If POS is nil, |
475 |
the value of point is used instead. If BEG or END null, |
the value of point is used instead. If BEG or END null, |
476 |
means don't store the beginning or end of the field. |
means don't store the beginning or end of the field. |
500 |
{ |
{ |
501 |
/* Fields right before and after the point. */ |
/* Fields right before and after the point. */ |
502 |
Lisp_Object before_field, after_field; |
Lisp_Object before_field, after_field; |
|
/* If the fields came from overlays, the associated overlays. |
|
|
Qnil means they came from text-properties. */ |
|
|
Lisp_Object before_overlay = Qnil, after_overlay = Qnil; |
|
503 |
/* 1 if POS counts as the start of a field. */ |
/* 1 if POS counts as the start of a field. */ |
504 |
int at_field_start = 0; |
int at_field_start = 0; |
505 |
/* 1 if POS counts as the end of a field. */ |
/* 1 if POS counts as the end of a field. */ |
511 |
CHECK_NUMBER_COERCE_MARKER (pos); |
CHECK_NUMBER_COERCE_MARKER (pos); |
512 |
|
|
513 |
after_field |
after_field |
514 |
= get_char_property_and_overlay (pos, Qfield, Qnil, &after_overlay); |
= get_char_property_and_overlay (pos, Qfield, Qnil, NULL); |
515 |
before_field |
before_field |
516 |
= (XFASTINT (pos) > BEGV |
= (XFASTINT (pos) > BEGV |
517 |
? get_char_property_and_overlay (make_number (XINT (pos) - 1), |
? get_char_property_and_overlay (make_number (XINT (pos) - 1), |
518 |
Qfield, Qnil, |
Qfield, Qnil, NULL) |
|
&before_overlay) |
|
519 |
: Qnil); |
: Qnil); |
520 |
|
|
521 |
/* See if we need to handle the case where MERGE_AT_BOUNDARY is nil |
/* See if we need to handle the case where MERGE_AT_BOUNDARY is nil |
524 |
MERGE_AT_BOUNDARY is non-nil (see function comment) is actually the |
MERGE_AT_BOUNDARY is non-nil (see function comment) is actually the |
525 |
more natural one; then we avoid treating the beginning of a field |
more natural one; then we avoid treating the beginning of a field |
526 |
specially. */ |
specially. */ |
527 |
if (NILP (merge_at_boundary) && !EQ (after_field, before_field)) |
if (NILP (merge_at_boundary)) |
528 |
/* We are at a boundary, see which direction is inclusive. We |
{ |
529 |
decide by seeing which field the `field' property sticks to. */ |
Lisp_Object field = get_pos_property (pos, Qfield, Qnil); |
530 |
{ |
if (!EQ (field, after_field)) |
|
/* -1 means insertions go into before_field, 1 means they go |
|
|
into after_field, 0 means neither. */ |
|
|
int stickiness; |
|
|
/* Whether the before/after_field come from overlays. */ |
|
|
int bop = !NILP (before_overlay); |
|
|
int aop = !NILP (after_overlay); |
|
|
|
|
|
if (bop && XMARKER (OVERLAY_END (before_overlay))->insertion_type == 1) |
|
|
/* before_field is from an overlay, which expands upon |
|
|
end-insertions. Note that it's possible for after_overlay to |
|
|
also eat insertions here, but then they will overlap, and |
|
|
there's not much we can do. */ |
|
|
stickiness = -1; |
|
|
else if (aop |
|
|
&& XMARKER (OVERLAY_START (after_overlay))->insertion_type == 0) |
|
|
/* after_field is from an overlay, which expand to contain |
|
|
start-insertions. */ |
|
|
stickiness = 1; |
|
|
else if (bop && aop) |
|
|
/* Both fields come from overlays, but neither will contain any |
|
|
insertion here. */ |
|
|
stickiness = 0; |
|
|
else if (bop) |
|
|
/* before_field is an overlay that won't eat any insertion, but |
|
|
after_field is from a text-property. Assume that the |
|
|
text-property continues underneath the overlay, and so will |
|
|
be inherited by any insertion, regardless of any stickiness |
|
|
settings. */ |
|
|
stickiness = 1; |
|
|
else if (aop) |
|
|
/* Similarly, when after_field is the overlay. */ |
|
|
stickiness = -1; |
|
|
else |
|
|
/* Both fields come from text-properties. Look for explicit |
|
|
stickiness properties. */ |
|
|
stickiness = text_property_stickiness (Qfield, pos); |
|
|
|
|
|
if (stickiness > 0) |
|
|
at_field_start = 1; |
|
|
else if (stickiness < 0) |
|
531 |
at_field_end = 1; |
at_field_end = 1; |
532 |
else |
if (!EQ (field, before_field)) |
533 |
/* STICKINESS == 0 means that any inserted text will get a |
at_field_start = 1; |
534 |
`field' char-property of nil, so check to see if that |
if (NILP (field) && at_field_start && at_field_end) |
535 |
matches either of the adjacent characters (this being a |
/* If an inserted char would have a nil field while the surrounding |
536 |
kind of "stickiness by default"). */ |
text is non-nil, we're probably not looking at a |
537 |
{ |
zero-length field, but instead at a non-nil field that's |
538 |
if (NILP (before_field)) |
not intended for editing (such as comint's prompts). */ |
539 |
at_field_end = 1; /* Sticks to the left. */ |
at_field_end = at_field_start = 0; |
|
else if (NILP (after_field)) |
|
|
at_field_start = 1; /* Sticks to the right. */ |
|
|
} |
|
540 |
} |
} |
541 |
|
|
542 |
/* Note about special `boundary' fields: |
/* Note about special `boundary' fields: |
570 |
else |
else |
571 |
/* Find the previous field boundary. */ |
/* Find the previous field boundary. */ |
572 |
{ |
{ |
573 |
|
Lisp_Object p = pos; |
574 |
if (!NILP (merge_at_boundary) && EQ (before_field, Qboundary)) |
if (!NILP (merge_at_boundary) && EQ (before_field, Qboundary)) |
575 |
/* Skip a `boundary' field. */ |
/* Skip a `boundary' field. */ |
576 |
pos = Fprevious_single_char_property_change (pos, Qfield, Qnil, |
p = Fprevious_single_char_property_change (p, Qfield, Qnil, |
|
beg_limit); |
|
|
|
|
|
pos = Fprevious_single_char_property_change (pos, Qfield, Qnil, |
|
577 |
beg_limit); |
beg_limit); |
578 |
*beg = NILP (pos) ? BEGV : XFASTINT (pos); |
|
579 |
|
p = Fprevious_single_char_property_change (p, Qfield, Qnil, |
580 |
|
beg_limit); |
581 |
|
*beg = NILP (p) ? BEGV : XFASTINT (p); |
582 |
} |
} |
583 |
} |
} |
584 |
|
|
881 |
/* visible */ |
/* visible */ |
882 |
info = XCDR (info); |
info = XCDR (info); |
883 |
visible_p = !NILP (XCAR (info)); |
visible_p = !NILP (XCAR (info)); |
884 |
|
|
885 |
#if 0 /* We used to make the current buffer visible in the selected window |
#if 0 /* We used to make the current buffer visible in the selected window |
886 |
if that was true previously. That avoids some anomalies. |
if that was true previously. That avoids some anomalies. |
887 |
But it creates others, and it wasn't documented, and it is simpler |
But it creates others, and it wasn't documented, and it is simpler |
946 |
Lisp_Object args; |
Lisp_Object args; |
947 |
{ |
{ |
948 |
register Lisp_Object val; |
register Lisp_Object val; |
949 |
int count = specpdl_ptr - specpdl; |
int count = SPECPDL_INDEX (); |
950 |
|
|
951 |
record_unwind_protect (save_excursion_restore, save_excursion_save ()); |
record_unwind_protect (save_excursion_restore, save_excursion_save ()); |
952 |
|
|
962 |
Lisp_Object args; |
Lisp_Object args; |
963 |
{ |
{ |
964 |
Lisp_Object val; |
Lisp_Object val; |
965 |
int count = specpdl_ptr - specpdl; |
int count = SPECPDL_INDEX (); |
966 |
|
|
967 |
record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ()); |
record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ()); |
968 |
|
|
1297 |
else if (NUMBERP (uid)) |
else if (NUMBERP (uid)) |
1298 |
pw = (struct passwd *) getpwuid ((uid_t) XFLOATINT (uid)); |
pw = (struct passwd *) getpwuid ((uid_t) XFLOATINT (uid)); |
1299 |
else if (STRINGP (uid)) |
else if (STRINGP (uid)) |
1300 |
pw = (struct passwd *) getpwnam (XSTRING (uid)->data); |
pw = (struct passwd *) getpwnam (SDATA (uid)); |
1301 |
else |
else |
1302 |
error ("Invalid UID specification"); |
error ("Invalid UID specification"); |
1303 |
|
|
1310 |
full = make_string (p, q ? q - p : strlen (p)); |
full = make_string (p, q ? q - p : strlen (p)); |
1311 |
|
|
1312 |
#ifdef AMPERSAND_FULL_NAME |
#ifdef AMPERSAND_FULL_NAME |
1313 |
p = XSTRING (full)->data; |
p = SDATA (full); |
1314 |
q = (unsigned char *) index (p, '&'); |
q = (unsigned char *) index (p, '&'); |
1315 |
/* Substitute the login name for the &, upcasing the first character. */ |
/* Substitute the login name for the &, upcasing the first character. */ |
1316 |
if (q) |
if (q) |
1319 |
Lisp_Object login; |
Lisp_Object login; |
1320 |
|
|
1321 |
login = Fuser_login_name (make_number (pw->pw_uid)); |
login = Fuser_login_name (make_number (pw->pw_uid)); |
1322 |
r = (unsigned char *) alloca (strlen (p) + XSTRING (login)->size + 1); |
r = (unsigned char *) alloca (strlen (p) + SCHARS (login) + 1); |
1323 |
bcopy (p, r, q - p); |
bcopy (p, r, q - p); |
1324 |
r[q - p] = 0; |
r[q - p] = 0; |
1325 |
strcat (r, XSTRING (login)->data); |
strcat (r, SDATA (login)); |
1326 |
r[q - p] = UPCASE (r[q - p]); |
r[q - p] = UPCASE (r[q - p]); |
1327 |
strcat (r, q + 1); |
strcat (r, q + 1); |
1328 |
full = build_string (r); |
full = build_string (r); |
1345 |
get_system_name () |
get_system_name () |
1346 |
{ |
{ |
1347 |
if (STRINGP (Vsystem_name)) |
if (STRINGP (Vsystem_name)) |
1348 |
return (char *) XSTRING (Vsystem_name)->data; |
return (char *) SDATA (Vsystem_name); |
1349 |
else |
else |
1350 |
return ""; |
return ""; |
1351 |
} |
} |
1547 |
Certain flags and modifiers are available with some format controls. |
Certain flags and modifiers are available with some format controls. |
1548 |
The flags are `_', `-', `^' and `#'. For certain characters X, |
The flags are `_', `-', `^' and `#'. For certain characters X, |
1549 |
%_X is like %X, but padded with blanks; %-X is like %X, |
%_X is like %X, but padded with blanks; %-X is like %X, |
1550 |
ut without padding. %^X is like %X but with all textual |
but without padding. %^X is like %X, but with all textual |
1551 |
characters up-cased; %#X is like %X but with letter-case of |
characters up-cased; %#X is like %X, but with letter-case of |
1552 |
all textual characters reversed. |
all textual characters reversed. |
1553 |
%NX (where N stands for an integer) is like %X, |
%NX (where N stands for an integer) is like %X, |
1554 |
but takes up at least N (a number) positions. |
but takes up at least N (a number) positions. |
1574 |
Vlocale_coding_system, 1); |
Vlocale_coding_system, 1); |
1575 |
|
|
1576 |
/* This is probably enough. */ |
/* This is probably enough. */ |
1577 |
size = STRING_BYTES (XSTRING (format_string)) * 6 + 50; |
size = SBYTES (format_string) * 6 + 50; |
1578 |
|
|
1579 |
tm = ut ? gmtime (&value) : localtime (&value); |
tm = ut ? gmtime (&value) : localtime (&value); |
1580 |
if (! tm) |
if (! tm) |
1588 |
int result; |
int result; |
1589 |
|
|
1590 |
buf[0] = '\1'; |
buf[0] = '\1'; |
1591 |
result = emacs_memftimeu (buf, size, XSTRING (format_string)->data, |
result = emacs_memftimeu (buf, size, SDATA (format_string), |
1592 |
STRING_BYTES (XSTRING (format_string)), |
SBYTES (format_string), |
1593 |
tm, ut); |
tm, ut); |
1594 |
if ((result > 0 && result < size) || (result == 0 && buf[0] == '\0')) |
if ((result > 0 && result < size) || (result == 0 && buf[0] == '\0')) |
1595 |
return code_convert_string_norecord (make_string (buf, result), |
return code_convert_string_norecord (make_string (buf, result), |
1597 |
|
|
1598 |
/* If buffer was too small, make it bigger and try again. */ |
/* If buffer was too small, make it bigger and try again. */ |
1599 |
result = emacs_memftimeu (NULL, (size_t) -1, |
result = emacs_memftimeu (NULL, (size_t) -1, |
1600 |
XSTRING (format_string)->data, |
SDATA (format_string), |
1601 |
STRING_BYTES (XSTRING (format_string)), |
SBYTES (format_string), |
1602 |
tm, ut); |
tm, ut); |
1603 |
size = result + 1; |
size = result + 1; |
1604 |
} |
} |
1705 |
if (EQ (zone, Qt)) |
if (EQ (zone, Qt)) |
1706 |
tzstring = "UTC0"; |
tzstring = "UTC0"; |
1707 |
else if (STRINGP (zone)) |
else if (STRINGP (zone)) |
1708 |
tzstring = (char *) XSTRING (zone)->data; |
tzstring = (char *) SDATA (zone); |
1709 |
else if (INTEGERP (zone)) |
else if (INTEGERP (zone)) |
1710 |
{ |
{ |
1711 |
int abszone = abs (XINT (zone)); |
int abszone = abs (XINT (zone)); |
1883 |
else |
else |
1884 |
{ |
{ |
1885 |
CHECK_STRING (tz); |
CHECK_STRING (tz); |
1886 |
tzstring = (char *) XSTRING (tz)->data; |
tzstring = (char *) SDATA (tz); |
1887 |
} |
} |
1888 |
|
|
1889 |
set_time_zone_rule (tzstring); |
set_time_zone_rule (tzstring); |
1998 |
static void |
static void |
1999 |
general_insert_function (insert_func, insert_from_string_func, |
general_insert_function (insert_func, insert_from_string_func, |
2000 |
inherit, nargs, args) |
inherit, nargs, args) |
2001 |
void (*insert_func) P_ ((unsigned char *, int)); |
void (*insert_func) P_ ((const unsigned char *, int)); |
2002 |
void (*insert_from_string_func) P_ ((Lisp_Object, int, int, int, int, int)); |
void (*insert_from_string_func) P_ ((Lisp_Object, int, int, int, int, int)); |
2003 |
int inherit, nargs; |
int inherit, nargs; |
2004 |
register Lisp_Object *args; |
register Lisp_Object *args; |
2029 |
else if (STRINGP (val)) |
else if (STRINGP (val)) |
2030 |
{ |
{ |
2031 |
(*insert_from_string_func) (val, 0, 0, |
(*insert_from_string_func) (val, 0, 0, |
2032 |
XSTRING (val)->size, |
SCHARS (val), |
2033 |
STRING_BYTES (XSTRING (val)), |
SBYTES (val), |
2034 |
inherit); |
inherit); |
2035 |
} |
} |
2036 |
else |
else |
2061 |
Any other markers at the point of insertion remain before the text. |
Any other markers at the point of insertion remain before the text. |
2062 |
|
|
2063 |
If the current buffer is multibyte, unibyte strings are converted |
If the current buffer is multibyte, unibyte strings are converted |
2064 |
to multibyte for insertion (see `unibyte-char-to-multibyte'). |
to multibyte for insertion (see `string-make-multibyte'). |
2065 |
If the current buffer is unibyte, multibyte strings are converted |
If the current buffer is unibyte, multibyte strings are converted |
2066 |
to unibyte for insertion. |
to unibyte for insertion (see `string-make-unibyte'). |
2067 |
|
|
2068 |
|
When operating on binary data, it may be necessary to preserve the |
2069 |
|
original bytes of a unibyte string when inserting it into a multibyte |
2070 |
|
buffer; to accomplish this, apply `string-as-multibyte' to the string |
2071 |
|
and insert the result. |
2072 |
|
|
2073 |
usage: (insert &rest ARGS) */) |
usage: (insert &rest ARGS) */) |
2074 |
(nargs, args) |
(nargs, args) |
2246 |
result = make_uninit_multibyte_string (end - start, end_byte - start_byte); |
result = make_uninit_multibyte_string (end - start, end_byte - start_byte); |
2247 |
else |
else |
2248 |
result = make_uninit_string (end - start); |
result = make_uninit_string (end - start); |
2249 |
bcopy (BYTE_POS_ADDR (start_byte), XSTRING (result)->data, |
bcopy (BYTE_POS_ADDR (start_byte), SDATA (result), |
2250 |
end_byte - start_byte); |
end_byte - start_byte); |
2251 |
|
|
2252 |
/* If desired, update and copy the text properties. */ |
/* If desired, update and copy the text properties. */ |
2582 |
int changed = 0; |
int changed = 0; |
2583 |
unsigned char fromstr[MAX_MULTIBYTE_LENGTH], tostr[MAX_MULTIBYTE_LENGTH]; |
unsigned char fromstr[MAX_MULTIBYTE_LENGTH], tostr[MAX_MULTIBYTE_LENGTH]; |
2584 |
unsigned char *p; |
unsigned char *p; |
2585 |
int count = specpdl_ptr - specpdl; |
int count = SPECPDL_INDEX (); |
2586 |
#define COMBINING_NO 0 |
#define COMBINING_NO 0 |
2587 |
#define COMBINING_BEFORE 1 |
#define COMBINING_BEFORE 1 |
2588 |
#define COMBINING_AFTER 2 |
#define COMBINING_AFTER 2 |
2759 |
validate_region (&start, &end); |
validate_region (&start, &end); |
2760 |
CHECK_STRING (table); |
CHECK_STRING (table); |
2761 |
|
|
2762 |
size = STRING_BYTES (XSTRING (table)); |
size = SBYTES (table); |
2763 |
tt = XSTRING (table)->data; |
tt = SDATA (table); |
2764 |
|
|
2765 |
pos_byte = CHAR_TO_BYTE (XINT (start)); |
pos_byte = CHAR_TO_BYTE (XINT (start)); |
2766 |
stop = CHAR_TO_BYTE (XINT (end)); |
stop = CHAR_TO_BYTE (XINT (end)); |
2936 |
struct Lisp_Marker *end = XMARKER (XCDR (data)); |
struct Lisp_Marker *end = XMARKER (XCDR (data)); |
2937 |
struct buffer *buf = beg->buffer; /* END should have the same buffer. */ |
struct buffer *buf = beg->buffer; /* END should have the same buffer. */ |
2938 |
|
|
2939 |
if (beg->charpos != BUF_BEGV(buf) || end->charpos != BUF_ZV(buf)) |
if (buf /* Verify marker still points to a buffer. */ |
2940 |
|
&& (beg->charpos != BUF_BEGV (buf) || end->charpos != BUF_ZV (buf))) |
2941 |
/* The restriction has changed from the saved one, so restore |
/* The restriction has changed from the saved one, so restore |
2942 |
the saved restriction. */ |
the saved restriction. */ |
2943 |
{ |
{ |
2950 |
/* The point is outside the new visible range, move it inside. */ |
/* The point is outside the new visible range, move it inside. */ |
2951 |
SET_BUF_PT_BOTH (buf, |
SET_BUF_PT_BOTH (buf, |
2952 |
clip_to_bounds (beg->charpos, pt, end->charpos), |
clip_to_bounds (beg->charpos, pt, end->charpos), |
2953 |
clip_to_bounds (beg->bytepos, BUF_PT_BYTE(buf), |
clip_to_bounds (beg->bytepos, BUF_PT_BYTE (buf), |
2954 |
end->bytepos)); |
end->bytepos)); |
2955 |
|
|
2956 |
buf->clip_changed = 1; /* Remember that the narrowing changed. */ |
buf->clip_changed = 1; /* Remember that the narrowing changed. */ |
2957 |
} |
} |
2958 |
} |
} |
2961 |
{ |
{ |
2962 |
struct buffer *buf = XBUFFER (data); |
struct buffer *buf = XBUFFER (data); |
2963 |
|
|
2964 |
if (BUF_BEGV(buf) != BUF_BEG(buf) || BUF_ZV(buf) != BUF_Z(buf)) |
if (buf /* Verify marker still points to a buffer. */ |
2965 |
|
&& (BUF_BEGV (buf) != BUF_BEG (buf) || BUF_ZV (buf) != BUF_Z (buf))) |
2966 |
/* The buffer has been narrowed, get rid of the narrowing. */ |
/* The buffer has been narrowed, get rid of the narrowing. */ |
2967 |
{ |
{ |
2968 |
SET_BUF_BEGV_BOTH (buf, BUF_BEG(buf), BUF_BEG_BYTE(buf)); |
SET_BUF_BEGV_BOTH (buf, BUF_BEG (buf), BUF_BEG_BYTE (buf)); |
2969 |
SET_BUF_ZV_BOTH (buf, BUF_Z(buf), BUF_Z_BYTE(buf)); |
SET_BUF_ZV_BOTH (buf, BUF_Z (buf), BUF_Z_BYTE (buf)); |
2970 |
|
|
2971 |
buf->clip_changed = 1; /* Remember that the narrowing changed. */ |
buf->clip_changed = 1; /* Remember that the narrowing changed. */ |
2972 |
} |
} |
2996 |
Lisp_Object body; |
Lisp_Object body; |
2997 |
{ |
{ |
2998 |
register Lisp_Object val; |
register Lisp_Object val; |
2999 |
int count = specpdl_ptr - specpdl; |
int count = SPECPDL_INDEX (); |
3000 |
|
|
3001 |
record_unwind_protect (save_restriction_restore, save_restriction_save ()); |
record_unwind_protect (save_restriction_restore, save_restriction_save ()); |
3002 |
val = Fprogn (body); |
val = Fprogn (body); |
3022 |
int nargs; |
int nargs; |
3023 |
Lisp_Object *args; |
Lisp_Object *args; |
3024 |
{ |
{ |
3025 |
if (NILP (args[0])) |
if (NILP (args[0]) |
3026 |
|
|| (STRINGP (args[0]) |
3027 |
|
&& SBYTES (args[0]) == 0)) |
3028 |
{ |
{ |
3029 |
message (0); |
message (0); |
3030 |
return Qnil; |
return Qnil; |
3033 |
{ |
{ |
3034 |
register Lisp_Object val; |
register Lisp_Object val; |
3035 |
val = Fformat (nargs, args); |
val = Fformat (nargs, args); |
3036 |
message3 (val, STRING_BYTES (XSTRING (val)), STRING_MULTIBYTE (val)); |
message3 (val, SBYTES (val), STRING_MULTIBYTE (val)); |
3037 |
return val; |
return val; |
3038 |
} |
} |
3039 |
} |
} |
3083 |
message_text = (char *)xmalloc (80); |
message_text = (char *)xmalloc (80); |
3084 |
message_length = 80; |
message_length = 80; |
3085 |
} |
} |
3086 |
if (STRING_BYTES (XSTRING (val)) > message_length) |
if (SBYTES (val) > message_length) |
3087 |
{ |
{ |
3088 |
message_length = STRING_BYTES (XSTRING (val)); |
message_length = SBYTES (val); |
3089 |
message_text = (char *)xrealloc (message_text, message_length); |
message_text = (char *)xrealloc (message_text, message_length); |
3090 |
} |
} |
3091 |
bcopy (XSTRING (val)->data, message_text, STRING_BYTES (XSTRING (val))); |
bcopy (SDATA (val), message_text, SBYTES (val)); |
3092 |
message2 (message_text, STRING_BYTES (XSTRING (val)), |
message2 (message_text, SBYTES (val), |
3093 |
STRING_MULTIBYTE (val)); |
STRING_MULTIBYTE (val)); |
3094 |
return val; |
return val; |
3095 |
} |
} |
3162 |
} |
} |
3163 |
|
|
3164 |
Fadd_text_properties (make_number (0), |
Fadd_text_properties (make_number (0), |
3165 |
make_number (XSTRING (string)->size), |
make_number (SCHARS (string)), |
3166 |
properties, string); |
properties, string); |
3167 |
RETURN_UNGCPRO (string); |
RETURN_UNGCPRO (string); |
3168 |
} |
} |
3173 |
|
|
3174 |
#define CONVERTED_BYTE_SIZE(MULTIBYTE, STRING) \ |
#define CONVERTED_BYTE_SIZE(MULTIBYTE, STRING) \ |
3175 |
(((MULTIBYTE) && ! STRING_MULTIBYTE (STRING)) \ |
(((MULTIBYTE) && ! STRING_MULTIBYTE (STRING)) \ |
3176 |
? count_size_as_multibyte (XSTRING (STRING)->data, \ |
? count_size_as_multibyte (SDATA (STRING), SBYTES (STRING)) \ |
3177 |
STRING_BYTES (XSTRING (STRING))) \ |
: SBYTES (STRING)) |
|
: STRING_BYTES (XSTRING (STRING))) |
|
3178 |
|
|
3179 |
DEFUN ("format", Fformat, Sformat, 1, MANY, 0, |
DEFUN ("format", Fformat, Sformat, 1, MANY, 0, |
3180 |
doc: /* Format a string out of a control-string and arguments. |
doc: /* Format a string out of a control-string and arguments. |
3212 |
must consider such a situation or not. */ |
must consider such a situation or not. */ |
3213 |
int maybe_combine_byte; |
int maybe_combine_byte; |
3214 |
unsigned char *this_format; |
unsigned char *this_format; |
3215 |
|
/* Precision for each spec, or -1, a flag value meaning no precision |
3216 |
|
was given in that spec. Element 0, corresonding to the format |
3217 |
|
string itself, will not be used. Element NARGS, corresponding to |
3218 |
|
no argument, *will* be assigned to in the case that a `%' and `.' |
3219 |
|
occur after the final format specifier. */ |
3220 |
|
int *precision = (int *) (alloca(nargs * sizeof (int))); |
3221 |
int longest_format; |
int longest_format; |
3222 |
Lisp_Object val; |
Lisp_Object val; |
3223 |
struct info |
struct info |
3232 |
This is not always right; sometimes the result needs to be multibyte |
This is not always right; sometimes the result needs to be multibyte |
3233 |
because of an object that we will pass through prin1, |
because of an object that we will pass through prin1, |
3234 |
and in that case, we won't know it here. */ |
and in that case, we won't know it here. */ |
3235 |
for (n = 0; n < nargs; n++) |
for (n = 0; n < nargs; n++) { |
3236 |
if (STRINGP (args[n]) && STRING_MULTIBYTE (args[n])) |
if (STRINGP (args[n]) && STRING_MULTIBYTE (args[n])) |
3237 |
multibyte = 1; |
multibyte = 1; |
3238 |
|
/* Piggyback on this loop to initialize precision[N]. */ |
3239 |
|
precision[n] = -1; |
3240 |
|
} |
3241 |
|
|
3242 |
CHECK_STRING (args[0]); |
CHECK_STRING (args[0]); |
3243 |
|
|
3245 |
and later find it has to be multibyte, we jump back to retry. */ |
and later find it has to be multibyte, we jump back to retry. */ |
3246 |
retry: |
retry: |
3247 |
|
|
3248 |
format = XSTRING (args[0])->data; |
format = SDATA (args[0]); |
3249 |
end = format + STRING_BYTES (XSTRING (args[0])); |
end = format + SBYTES (args[0]); |
3250 |
longest_format = 0; |
longest_format = 0; |
3251 |
|
|
3252 |
/* Make room in result for all the non-%-codes in the control string. */ |
/* Make room in result for all the non-%-codes in the control string. */ |
3261 |
int thissize = 0; |
int thissize = 0; |
3262 |
int actual_width = 0; |
int actual_width = 0; |
3263 |
unsigned char *this_format_start = format - 1; |
unsigned char *this_format_start = format - 1; |
3264 |
int field_width, precision; |
int field_width = 0; |
3265 |
|
|
3266 |
/* General format specifications look like |
/* General format specifications look like |
3267 |
|
|
3277 |
the output should be padded with blanks, iff the output |
the output should be padded with blanks, iff the output |
3278 |
string is shorter than field-width. |
string is shorter than field-width. |
3279 |
|
|
3280 |
if precision is specified, it specifies the number of |
If precision is specified, it specifies the number of |
3281 |
digits to print after the '.' for floats, or the max. |
digits to print after the '.' for floats, or the max. |
3282 |
number of chars to print from a string. */ |
number of chars to print from a string. */ |
3283 |
|
|
3284 |
precision = field_width = 0; |
/* NOTE the handling of specifiers here differs in some ways |
3285 |
|
from the libc model. There are bugs in this code that lead |
3286 |
|
to incorrect formatting when flags recognized by C but |
3287 |
|
neither parsed nor rejected here are used. Further |
3288 |
|
revisions will be made soon. */ |
3289 |
|
|
3290 |
|
/* incorrect list of flags to skip; will be fixed */ |
3291 |
while (index ("-*# 0", *format)) |
while (index ("-*# 0", *format)) |
3292 |
++format; |
++format; |
3293 |
|
|
3297 |
field_width = 10 * field_width + *format - '0'; |
field_width = 10 * field_width + *format - '0'; |
3298 |
} |
} |
3299 |
|
|
3300 |
|
/* N is not incremented for another few lines below, so refer to |
3301 |
|
element N+1 (which might be precision[NARGS]). */ |
3302 |
if (*format == '.') |
if (*format == '.') |
3303 |
{ |
{ |
3304 |
++format; |
++format; |
3305 |
for (precision = 0; *format >= '0' && *format <= '9'; ++format) |
for (precision[n+1] = 0; *format >= '0' && *format <= '9'; ++format) |
3306 |
precision = 10 * precision + *format - '0'; |
precision[n+1] = 10 * precision[n+1] + *format - '0'; |
3307 |
} |
} |
3308 |
|
|
3309 |
if (format - this_format_start + 1 > longest_format) |
if (format - this_format_start + 1 > longest_format) |
3330 |
} |
} |
3331 |
else if (SYMBOLP (args[n])) |
else if (SYMBOLP (args[n])) |
3332 |
{ |
{ |
3333 |
/* Use a temp var to avoid problems when ENABLE_CHECKING |
args[n] = SYMBOL_NAME (args[n]); |
|
is turned on. */ |
|
|
struct Lisp_String *t = XSTRING (SYMBOL_NAME (args[n])); |
|
|
XSETSTRING (args[n], t); |
|
3334 |
if (STRING_MULTIBYTE (args[n]) && ! multibyte) |
if (STRING_MULTIBYTE (args[n]) && ! multibyte) |
3335 |
{ |
{ |
3336 |
multibyte = 1; |
multibyte = 1; |
3343 |
string: |
string: |
3344 |
if (*format != 's' && *format != 'S') |
if (*format != 's' && *format != 'S') |
3345 |
error ("Format specifier doesn't match argument type"); |
error ("Format specifier doesn't match argument type"); |
3346 |
thissize = CONVERTED_BYTE_SIZE (multibyte, args[n]); |
/* In the case (PRECISION[N] > 0), THISSIZE may not need |
3347 |
|
to be as large as is calculated here. Easy check for |
3348 |
|
the case PRECISION = 0. */ |
3349 |
|
thissize = precision[n] ? CONVERTED_BYTE_SIZE (multibyte, args[n]) : 0; |
3350 |
actual_width = lisp_string_width (args[n], -1, NULL, NULL); |
actual_width = lisp_string_width (args[n], -1, NULL, NULL); |
3351 |
} |
} |
3352 |
/* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */ |
/* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */ |
3364 |
error ("Invalid format operation %%%c", *format); |
error ("Invalid format operation %%%c", *format); |
3365 |
|
|
3366 |
thissize = 30; |
thissize = 30; |
3367 |
if (*format == 'c' |
if (*format == 'c') |
|
&& (! SINGLE_BYTE_CHAR_P (XINT (args[n])) |
|
|
|| XINT (args[n]) == 0)) |
|
3368 |
{ |
{ |
3369 |
if (! multibyte) |
if (! SINGLE_BYTE_CHAR_P (XINT (args[n])) |
3370 |
|
/* Note: No one can remeber why we have to treat |
3371 |
|
the character 0 as a multibyte character here. |
3372 |
|
But, until it causes a real problem, let's |
3373 |
|
don't change it. */ |
3374 |
|
|| XINT (args[n]) == 0) |
3375 |
|
{ |
3376 |
|
if (! multibyte) |
3377 |
|
{ |
3378 |
|
multibyte = 1; |
3379 |
|
goto retry; |
3380 |
|
} |
3381 |
|
args[n] = Fchar_to_string (args[n]); |
3382 |
|
thissize = SBYTES (args[n]); |
3383 |
|
} |
3384 |
|
else if (! ASCII_BYTE_P (XINT (args[n])) && multibyte) |
3385 |
{ |
{ |
3386 |
multibyte = 1; |
args[n] |
3387 |
goto retry; |
= Fchar_to_string (Funibyte_char_to_multibyte (args[n])); |
3388 |
|
thissize = SBYTES (args[n]); |
3389 |
} |
} |
|
args[n] = Fchar_to_string (args[n]); |
|
|
thissize = STRING_BYTES (XSTRING (args[n])); |
|
3390 |
} |
} |
3391 |
} |
} |
3392 |
else if (FLOATP (args[n]) && *format != 's') |
else if (FLOATP (args[n]) && *format != 's') |
3393 |
{ |
{ |
3394 |
if (! (*format == 'e' || *format == 'f' || *format == 'g')) |
if (! (*format == 'e' || *format == 'f' || *format == 'g')) |
3395 |
args[n] = Ftruncate (args[n], Qnil); |
{ |
3396 |
|
if (*format != 'd' && *format != 'o' && *format != 'x' |
3397 |
|
&& *format != 'i' && *format != 'X' && *format != 'c') |
3398 |
|
error ("Invalid format operation %%%c", *format); |
3399 |
|
args[n] = Ftruncate (args[n], Qnil); |
3400 |
|
} |
3401 |
|
|
3402 |
/* Note that we're using sprintf to print floats, |
/* Note that we're using sprintf to print floats, |
3403 |
so we have to take into account what that function |
so we have to take into account what that function |
3404 |
prints. */ |
prints. */ |
3405 |
thissize = MAX_10_EXP + 100 + precision; |
/* Filter out flag value of -1. */ |
3406 |
|
thissize = (MAX_10_EXP + 100 |
3407 |
|
+ (precision[n] > 0 ? precision[n] : 0)); |
3408 |
} |
} |
3409 |
else |
else |
3410 |
{ |
{ |
3441 |
n = 0; |
n = 0; |
3442 |
|
|
3443 |
/* Scan the format and store result in BUF. */ |
/* Scan the format and store result in BUF. */ |
3444 |
format = XSTRING (args[0])->data; |
format = SDATA (args[0]); |
3445 |
maybe_combine_byte = 0; |
maybe_combine_byte = 0; |
3446 |
while (format != end) |
while (format != end) |
3447 |
{ |
{ |
3454 |
format++; |
format++; |
3455 |
|
|
3456 |
/* Process a numeric arg and skip it. */ |
/* Process a numeric arg and skip it. */ |
3457 |
|
/* NOTE atoi is the wrong thing to use here; will be fixed */ |
3458 |
minlen = atoi (format); |
minlen = atoi (format); |
3459 |
if (minlen < 0) |
if (minlen < 0) |
3460 |
minlen = - minlen, negative = 1; |
minlen = - minlen, negative = 1; |
3461 |
|
|
3462 |
|
/* NOTE the parsing here is not consistent with the first |
3463 |
|
pass, and neither attempt is what we want to do. Will be |
3464 |
|
fixed. */ |
3465 |
while ((*format >= '0' && *format <= '9') |
while ((*format >= '0' && *format <= '9') |
3466 |
|| *format == '-' || *format == ' ' || *format == '.') |
|| *format == '-' || *format == ' ' || *format == '.') |
3467 |
format++; |
format++; |
3477 |
|
|
3478 |
if (STRINGP (args[n])) |
if (STRINGP (args[n])) |
3479 |
{ |
{ |
3480 |
int padding, nbytes, start, end; |
/* handle case (precision[n] >= 0) */ |
3481 |
int width = lisp_string_width (args[n], -1, NULL, NULL); |
|
3482 |
|
int width, padding; |
3483 |
|
int nbytes, start, end; |
3484 |
|
int nchars_string; |
3485 |
|
|
3486 |
|
/* lisp_string_width ignores a precision of 0, but GNU |
3487 |
|
libc functions print 0 characters when the precision |
3488 |
|
is 0. Imitate libc behavior here. Changing |
3489 |
|
lisp_string_width is the right thing, and will be |
3490 |
|
done, but meanwhile we work with it. */ |
3491 |
|
|
3492 |
|
if (precision[n] == 0) |
3493 |
|
width = nchars_string = nbytes = 0; |
3494 |
|
else if (precision[n] > 0) |
3495 |
|
width = lisp_string_width (args[n], precision[n], &nchars_string, &nbytes); |
3496 |
|
else |
3497 |
|
{ /* no precision spec given for this argument */ |
3498 |
|
width = lisp_string_width (args[n], -1, NULL, NULL); |
3499 |
|
nbytes = SBYTES (args[n]); |
3500 |
|
nchars_string = SCHARS (args[n]); |
3501 |
|
} |
3502 |
|
|
3503 |
/* If spec requires it, pad on right with spaces. */ |
/* If spec requires it, pad on right with spaces. */ |
3504 |
padding = minlen - width; |
padding = minlen - width; |
3510 |
} |
} |
3511 |
|
|
3512 |
start = nchars; |
start = nchars; |
3513 |
|
nchars += nchars_string; |
3514 |
|
end = nchars; |
3515 |
|
|
3516 |
if (p > buf |
if (p > buf |
3517 |
&& multibyte |
&& multibyte |
3518 |
&& !ASCII_BYTE_P (*((unsigned char *) p - 1)) |
&& !ASCII_BYTE_P (*((unsigned char *) p - 1)) |
3519 |
&& STRING_MULTIBYTE (args[n]) |
&& STRING_MULTIBYTE (args[n]) |
3520 |
&& !CHAR_HEAD_P (XSTRING (args[n])->data[0])) |
&& !CHAR_HEAD_P (SREF (args[n], 0))) |
3521 |
maybe_combine_byte = 1; |
maybe_combine_byte = 1; |
3522 |
nbytes = copy_text (XSTRING (args[n])->data, p, |
|
3523 |
STRING_BYTES (XSTRING (args[n])), |
p += copy_text (SDATA (args[n]), p, |
3524 |
STRING_MULTIBYTE (args[n]), multibyte); |
nbytes, |
3525 |
p += nbytes; |
STRING_MULTIBYTE (args[n]), multibyte); |
|
nchars += XSTRING (args[n])->size; |
|
|
end = nchars; |
|
3526 |
|
|
3527 |
if (negative) |
if (negative) |
3528 |
while (padding-- > 0) |
while (padding-- > 0) |
3533 |
|
|
3534 |
/* If this argument has text properties, record where |
/* If this argument has text properties, record where |
3535 |
in the result string it appears. */ |
in the result string it appears. */ |
3536 |
if (XSTRING (args[n])->intervals) |
if (STRING_INTERVALS (args[n])) |
3537 |
{ |
{ |
3538 |
if (!info) |
if (!info) |
3539 |
{ |
{ |
3612 |
arguments has text properties, set up text properties of the |
arguments has text properties, set up text properties of the |
3613 |
result string. */ |
result string. */ |
3614 |
|
|
3615 |
if (XSTRING (args[0])->intervals || info) |
if (STRING_INTERVALS (args[0]) || info) |
3616 |
{ |
{ |
3617 |
Lisp_Object len, new_len, props; |
Lisp_Object len, new_len, props; |
3618 |
struct gcpro gcpro1; |
struct gcpro gcpro1; |
3619 |
|
|
3620 |
/* Add text properties from the format string. */ |
/* Add text properties from the format string. */ |
3621 |
len = make_number (XSTRING (args[0])->size); |
len = make_number (SCHARS (args[0])); |
3622 |
props = text_property_list (args[0], make_number (0), len, Qnil); |
props = text_property_list (args[0], make_number (0), len, Qnil); |
3623 |
GCPRO1 (props); |
GCPRO1 (props); |
3624 |
|
|
3625 |
if (CONSP (props)) |
if (CONSP (props)) |
3626 |
{ |
{ |
3627 |
new_len = make_number (XSTRING (val)->size); |
new_len = make_number (SCHARS (val)); |
3628 |
extend_property_ranges (props, len, new_len); |
extend_property_ranges (props, len, new_len); |
3629 |
add_text_properties_from_list (val, props, make_number (0)); |
add_text_properties_from_list (val, props, make_number (0)); |
3630 |
} |
} |
3634 |
for (n = 1; n < nargs; ++n) |
for (n = 1; n < nargs; ++n) |
3635 |
if (info[n].end) |
if (info[n].end) |
3636 |
{ |
{ |
3637 |
len = make_number (XSTRING (args[n])->size); |
len = make_number (SCHARS (args[n])); |
3638 |
new_len = make_number (info[n].end - info[n].start); |
new_len = make_number (info[n].end - info[n].start); |
3639 |
props = text_property_list (args[n], make_number (0), len, Qnil); |
props = text_property_list (args[n], make_number (0), len, Qnil); |
3640 |
extend_property_ranges (props, len, new_len); |
extend_property_ranges (props, len, new_len); |
3652 |
return val; |
return val; |
3653 |
} |
} |
3654 |
|
|
|
|
|
|
/* VARARGS 1 */ |
|
3655 |
Lisp_Object |
Lisp_Object |
3656 |
#ifdef NO_ARG_ARRAY |
format2 (string1, arg0, arg1) |
|
format1 (string1, arg0, arg1, arg2, arg3, arg4) |
|
|
EMACS_INT arg0, arg1, arg2, arg3, arg4; |
|
|
#else |
|
|
format1 (string1) |
|
|
#endif |
|
3657 |
char *string1; |
char *string1; |
3658 |
|
Lisp_Object arg0, arg1; |
3659 |
{ |
{ |
3660 |
char buf[100]; |
Lisp_Object args[3]; |
3661 |
#ifdef NO_ARG_ARRAY |
int numargs; |
3662 |
EMACS_INT args[5]; |
args[0] = build_string (string1); |
3663 |
args[0] = arg0; |
args[1] = arg0; |
3664 |
args[1] = arg1; |
args[2] = arg1; |
3665 |
args[2] = arg2; |
return Fformat (3, args); |
|
args[3] = arg3; |
|
|
args[4] = arg4; |
|
|
doprnt (buf, sizeof buf, string1, (char *)0, 5, (char **) args); |
|
|
#else |
|
|
doprnt (buf, sizeof buf, string1, (char *)0, 5, &string1 + 1); |
|
|
#endif |
|
|
return build_string (buf); |
|
3666 |
} |
} |
3667 |
|
|
3668 |
DEFUN ("char-equal", Fchar_equal, Schar_equal, 2, 2, 0, |
DEFUN ("char-equal", Fchar_equal, Schar_equal, 2, 2, 0, |