/* Lisp functions pertaining to editing.
- Copyright (C) 1985,86,87,89,93,94,95,96,97,98, 1999, 2000
+ Copyright (C) 1985,86,87,89,93,94,95,96,97,98, 1999, 2000, 2001
Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "buffer.h"
#include "charset.h"
#include "coding.h"
+#include "frame.h"
#include "window.h"
#include "systime.h"
+#ifdef STDC_HEADERS
+#include <float.h>
+#define MAX_10_EXP DBL_MAX_10_EXP
+#else
+#define MAX_10_EXP 310
+#endif
+
#define min(a, b) ((a) < (b) ? (a) : (b))
#define max(a, b) ((a) > (b) ? (a) : (b))
CHECK_NUMBER (character, 0);
- len = CHAR_STRING (XFASTINT (character), str);
+ len = (SINGLE_BYTE_CHAR_P (XFASTINT (character))
+ ? (*str = (unsigned char)(XFASTINT (character)), 1)
+ : char_to_string (XFASTINT (character), str));
return make_string_from_bytes (str, 1, len);
}
}
\f
+#if 0 /* Not used. */
+
/* Return nonzero if POS1 and POS2 have the same value
for the text property PROP. */
return EQ (pval1, pval2);
}
-/* Return the direction from which the char-property PROP would be
+#endif /* 0 */
+
+/* Return the direction from which the text-property PROP would be
inherited by any new text inserted at POS: 1 if it would be
inherited from the char after POS, -1 if it would be inherited from
the char before POS, and 0 if from neither. */
static int
-char_property_stickiness (prop, pos)
+text_property_stickiness (prop, pos)
Lisp_Object prop;
Lisp_Object pos;
{
Lisp_Object prev_pos, rear_non_sticky;
prev_pos = make_number (XINT (pos) - 1);
- rear_non_sticky = Fget_char_property (prev_pos, Qrear_nonsticky, Qnil);
+ rear_non_sticky = Fget_text_property (prev_pos, Qrear_nonsticky, Qnil);
if (EQ (rear_non_sticky, Qnil)
|| (CONSP (rear_non_sticky)
}
/* Consider following character. */
- front_sticky = Fget_char_property (pos, Qfront_sticky, Qnil);
+ front_sticky = Fget_text_property (pos, Qfront_sticky, Qnil);
if (EQ (front_sticky, Qt)
|| (CONSP (front_sticky)
{
/* Fields right before and after the point. */
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;
/* 1 if POS counts as the start of a field. */
int at_field_start = 0;
/* 1 if POS counts as the end of a field. */
CHECK_NUMBER_COERCE_MARKER (pos, 0);
after_field
- = Fget_char_property (pos, Qfield, Qnil);
+ = get_char_property_and_overlay (pos, Qfield, Qnil, &after_overlay);
before_field
= (XFASTINT (pos) > BEGV
- ? Fget_char_property (make_number (XINT (pos) - 1), Qfield, Qnil)
+ ? get_char_property_and_overlay (make_number (XINT (pos) - 1),
+ Qfield, Qnil,
+ &before_overlay)
: Qnil);
/* See if we need to handle the case where MERGE_AT_BOUNDARY is nil
/* We are at a boundary, see which direction is inclusive. We
decide by seeing which field the `field' property sticks to. */
{
- int stickiness = char_property_stickiness (Qfield, pos);
+ /* -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;
\n\
A field is a region of text with the same `field' property.\n\
If NEW-POS is nil, then the current point is used instead, and set to the\n\
-constrained position if that is is different.\n\
+constrained position if that is different.\n\
\n\
If OLD-POS is at the boundary of two fields, then the allowable\n\
positions for NEW-POS depends on the value of the optional argument\n\
}
/* If buffer was visible in a window, and a different window was
- selected, and the old selected window is still live, restore
- point in that window. */
+ selected, and the old selected window is still showing this
+ buffer, restore point in that window. */
tem = XCDR (info);
if (visible_p
&& !EQ (tem, selected_window)
- && !NILP (Fwindow_live_p (tem)))
+ && (tem1 = XWINDOW (tem)->buffer,
+ (/* Window is live... */
+ BUFFERP (tem1)
+ /* ...and it shows the current buffer. */
+ && XBUFFER (tem1) == current_buffer)))
Fset_window_point (tem, make_number (PT));
UNGCPRO;
instead of the current time. The argument should have the forms:\n\
(HIGH . LOW) or (HIGH LOW USEC) or (HIGH LOW . USEC).\n\
Thus, you can use times obtained from `current-time'\n\
-and from `file-attributes'.")
+and from `file-attributes'.\n\
+\n\
+WARNING: Since the result is floating point, it may not be exact.\n\
+Do not use this function if precise time stamps are required.")
(specified_time)
Lisp_Object specified_time;
{
if (! lisp_time_argument (specified_time, &sec, &usec))
error ("Invalid time specification");
- return make_float (sec + usec * 0.0000001);
+ return make_float ((sec * 1e6 + usec) / 1e6);
}
/* Write information into buffer S of size MAXSIZE, according to the
Finally, %n is a newline, %t is a tab, %% is a literal %.\n\
\n\
Certain flags and modifiers are available with some format controls.\n\
-The flags are `_' and `-'. For certain characters X, %_X is like %X,\n\
-but padded with blanks; %-X is like %X, but without padding.\n\
+The flags are `_', `-', `^' and `#'. For certain characters X,\n\
+%_X is like %X, but padded with blanks; %-X is like %X,\n\
+ut without padding. %^X is like %X but with all textual\n\
+characters up-cased; %#X is like %X but with letter-case of\n\
+all textual characters reversed.\n\
%NX (where N stands for an integer) is like %X,\n\
but takes up at least N (a number) positions.\n\
The modifiers are `E' and `O'. For certain characters X,\n\
s = tzname[t->tm_isdst];
#endif
#endif /* not HAVE_TM_ZONE */
+
+#if defined HAVE_TM_ZONE || defined HAVE_TZNAME
+ if (s)
+ {
+ /* On Japanese w32, we can get a Japanese string as time
+ zone name. Don't accept that. */
+ char *p;
+ for (p = s; *p && (isalnum (*p) || *p == ' '); ++p)
+ ;
+ if (p == s || *p)
+ s = NULL;
+ }
+#endif
+
if (!s)
{
/* No local time zone name is available; use "+-NNNN" instead. */
"Return the contents of part of the current buffer as a string.\n\
The two arguments START and END are character positions;\n\
they can be in either order.\n\
-The string returned is multibyte if the buffer is multibyte.")
+The string returned is multibyte if the buffer is multibyte.\n\
+\n\
+This function copies the text properties of that part of the buffer\n\
+into the result string; if you don't want the text properties,\n\
+use `buffer-substring-no-properties' instead.")
(start, end)
Lisp_Object start, end;
{
return unbind_to (count, val);
}
\f
-#ifndef HAVE_MENUS
-
-/* Buffer for the most recent text displayed by Fmessage. */
+/* Buffer for the most recent text displayed by Fmessage_box. */
static char *message_text;
/* Allocated length of that buffer. */
static int message_length;
-#endif /* not HAVE_MENUS */
-
DEFUN ("message", Fmessage, Smessage, 1, MANY, 0,
"Print a one-line message at the bottom of the screen.\n\
The first argument is a format control string, and the rest are data\n\
register Lisp_Object val;
val = Fformat (nargs, args);
#ifdef HAVE_MENUS
+ /* The MS-DOS frames support popup menus even though they are
+ not FRAME_WINDOW_P. */
+ if (FRAME_WINDOW_P (XFRAME (selected_frame))
+ || FRAME_MSDOS_P (XFRAME (selected_frame)))
{
Lisp_Object pane, menu, obj;
struct gcpro gcpro1;
UNGCPRO;
return val;
}
-#else /* not HAVE_MENUS */
+#endif /* HAVE_MENUS */
/* Copy the data so that it won't move when we GC. */
if (! message_text)
{
message2 (message_text, STRING_BYTES (XSTRING (val)),
STRING_MULTIBYTE (val));
return val;
-#endif /* not HAVE_MENUS */
}
}
#ifdef HAVE_MENUS
It may contain %-sequences meaning to substitute the next argument.\n\
%s means print a string argument. Actually, prints any object, with `princ'.\n\
%d means print as number in decimal (%o octal, %x hex).\n\
+%X is like %x, but uses upper case.\n\
%e means print a number in exponential notation.\n\
%f means print a number in decimal-point notation.\n\
%g means print a number in exponential notation\n\
while (format != end)
if (*format++ == '%')
{
- int minlen, thissize = 0;
+ int thissize = 0;
unsigned char *this_format_start = format - 1;
+ int field_width, precision;
- /* Process a numeric arg and skip it. */
- minlen = atoi (format);
- if (minlen < 0)
- minlen = - minlen;
+ /* General format specifications look like
- while ((*format >= '0' && *format <= '9')
- || *format == '-' || *format == ' ' || *format == '.')
- format++;
+ '%' [flags] [field-width] [precision] format
+
+ where
+
+ flags ::= [#-* 0]+
+ field-width ::= [0-9]+
+ precision ::= '.' [0-9]*
+
+ If a field-width is specified, it specifies to which width
+ the output should be padded with blanks, iff the output
+ string is shorter than field-width.
+
+ if precision is specified, it specifies the number of
+ digits to print after the '.' for floats, or the max.
+ number of chars to print from a string. */
+
+ precision = field_width = 0;
+
+ while (index ("-*# 0", *format))
+ ++format;
+
+ if (*format >= '0' && *format <= '9')
+ {
+ for (field_width = 0; *format >= '0' && *format <= '9'; ++format)
+ field_width = 10 * field_width + *format - '0';
+ }
+
+ if (*format == '.')
+ {
+ ++format;
+ for (precision = 0; *format >= '0' && *format <= '9'; ++format)
+ precision = 10 * precision + *format - '0';
+ }
if (format - this_format_start + 1 > longest_format)
longest_format = format - this_format_start + 1;
{
if (! (*format == 'e' || *format == 'f' || *format == 'g'))
args[n] = Ftruncate (args[n], Qnil);
- thissize = 200;
+
+ /* Note that we're using sprintf to print floats,
+ so we have to take into account what that function
+ prints. */
+ thissize = MAX_10_EXP + 100 + precision;
}
else
{
goto string;
}
- if (thissize < minlen)
- thissize = minlen;
-
+ thissize = max (field_width, thissize);
total += thissize + 4;
}
if (STRINGP (args[n]))
{
- int padding, nbytes;
- int width = strwidth (XSTRING (args[n])->data,
- STRING_BYTES (XSTRING (args[n])));
- int start = nchars;
+ int padding, nbytes, start, end;
+ int width = lisp_string_width (args[n], -1, NULL, NULL);
/* If spec requires it, pad on right with spaces. */
padding = minlen - width;
while (padding-- > 0)
{
*p++ = ' ';
- nchars++;
+ ++nchars;
}
+ start = nchars;
+
if (p > buf
&& multibyte
&& !ASCII_BYTE_P (*((unsigned char *) p - 1))
STRING_MULTIBYTE (args[n]), multibyte);
p += nbytes;
nchars += XSTRING (args[n])->size;
+ end = nchars;
if (negative)
while (padding-- > 0)
}
info[n].start = start;
- info[n].end = nchars;
+ info[n].end = end;
}
}
else if (INTEGERP (args[n]) || FLOATP (args[n]))
*p++ = *format++, nchars++;
}
+ if (p > buf + total + 1)
+ abort ();
+
if (maybe_combine_byte)
nchars = multibyte_chars_in_text (buf, p - buf);
val = make_specified_string (buf, nchars, p - buf, multibyte);
int start1_byte, start2_byte, len1_byte, len2_byte;
int gap, len1, len_mid, len2;
unsigned char *start1_addr, *start2_addr, *temp;
- struct gcpro gcpro1, gcpro2;
INTERVAL cur_intv, tmp_interval1, tmp_interval_mid, tmp_interval2;
cur_intv = BUF_INTERVALS (current_buffer);
HCoop / bpt / emacs.git / blobdiff