-/* Lisp functions pertaining to editing.
+/* Lisp functions pertaining to editing. -*- coding: utf-8 -*-
-Copyright (C) 1985-1987, 1989, 1993-2015 Free Software Foundation, Inc.
+Copyright (C) 1985-1987, 1989, 1993-2016 Free Software Foundation, Inc.
This file is part of GNU Emacs.
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation, either version 3 of the License, or
-(at your option) any later version.
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
#include <strftime.h>
#include <verify.h>
+#include "composite.h"
#include "intervals.h"
#include "character.h"
#include "buffer.h"
#include "coding.h"
-#include "frame.h"
#include "window.h"
#include "blockinput.h"
static long int tm_gmtoff (struct tm *);
static int tm_diff (struct tm *, struct tm *);
static void update_buffer_properties (ptrdiff_t, ptrdiff_t);
+static Lisp_Object styled_format (ptrdiff_t, Lisp_Object *, bool);
#ifndef HAVE_TM_GMTOFF
# define HAVE_TM_GMTOFF false
static timezone_t
tzlookup (Lisp_Object zone, bool settz)
{
- static char const tzbuf_format[] = "XXX%s%"pI"d:%02d:%02d";
- char tzbuf[sizeof tzbuf_format + INT_STRLEN_BOUND (EMACS_INT)];
char const *zone_string;
timezone_t new_tz;
}
else
{
+ static char const tzbuf_format[] = "<%+.*"pI"d>%s%"pI"d:%02d:%02d";
+ char const *trailing_tzbuf_format = tzbuf_format + sizeof "<%+.*"pI"d" - 1;
+ char tzbuf[sizeof tzbuf_format + 2 * INT_STRLEN_BOUND (EMACS_INT)];
+ bool plain_integer = INTEGERP (zone);
+
if (EQ (zone, Qwall))
zone_string = 0;
else if (STRINGP (zone))
- zone_string = SSDATA (zone);
- else if (INTEGERP (zone))
+ zone_string = SSDATA (ENCODE_SYSTEM (zone));
+ else if (plain_integer || (CONSP (zone) && INTEGERP (XCAR (zone))
+ && CONSP (XCDR (zone))))
{
+ Lisp_Object abbr;
+ if (!plain_integer)
+ {
+ abbr = XCAR (XCDR (zone));
+ zone = XCAR (zone);
+ }
+
EMACS_INT abszone = eabs (XINT (zone)), hour = abszone / (60 * 60);
- int min = (abszone / 60) % 60, sec = abszone % 60;
- sprintf (tzbuf, tzbuf_format, &"-"[XINT (zone) < 0], hour, min, sec);
- zone_string = tzbuf;
+ int hour_remainder = abszone % (60 * 60);
+ int min = hour_remainder / 60, sec = hour_remainder % 60;
+
+ if (plain_integer)
+ {
+ int prec = 2;
+ EMACS_INT numzone = hour;
+ if (hour_remainder != 0)
+ {
+ prec += 2, numzone = 100 * numzone + min;
+ if (sec != 0)
+ prec += 2, numzone = 100 * numzone + sec;
+ }
+ sprintf (tzbuf, tzbuf_format, prec, numzone,
+ &"-"[XINT (zone) < 0], hour, min, sec);
+ zone_string = tzbuf;
+ }
+ else
+ {
+ AUTO_STRING (leading, "<");
+ AUTO_STRING_WITH_LEN (trailing, tzbuf,
+ sprintf (tzbuf, trailing_tzbuf_format,
+ &"-"[XINT (zone) < 0],
+ hour, min, sec));
+ zone_string = SSDATA (concat3 (leading, ENCODE_SYSTEM (abbr),
+ trailing));
+ }
}
else
xsignal2 (Qerror, build_string ("Invalid time zone specification"),
{
block_input ();
emacs_setenv_TZ (zone_string);
+ tzset ();
timezone_t old_tz = local_tz;
local_tz = new_tz;
tzfree (old_tz);
save_excursion_restore (Lisp_Object info)
{
Lisp_Object tem, tem1;
- struct gcpro gcpro1;
tem = Fmarker_buffer (XSAVE_OBJECT (info, 0));
/* If we're unwinding to top level, saved buffer may be deleted. This
if (NILP (tem))
goto out;
- GCPRO1 (info);
-
Fset_buffer (tem);
/* Point marker. */
&& XBUFFER (tem1) == current_buffer)))
Fset_window_point (tem, make_number (PT));
- UNGCPRO;
-
out:
free_misc (info);
error ("Specified time is not representable");
}
-static void
+static _Noreturn void
invalid_time (void)
{
error ("Invalid time specification");
Lisp_Object high, low, usec, psec;
struct lisp_time t;
int len = disassemble_lisp_time (specified_time, &high, &low, &usec, &psec);
- int val = len ? decode_time_components (high, low, usec, psec, &t, 0) : 0;
+ if (!len)
+ invalid_time ();
+ int val = decode_time_components (high, low, usec, psec, &t, 0);
check_time_validity (val);
*plen = len;
return t;
doc: /* Return the current time, as a float number of seconds since the epoch.
If SPECIFIED-TIME is given, it is the time to convert to float
instead of the current time. The argument should have the form
-(HIGH LOW) or (HIGH LOW USEC) or (HIGH LOW USEC PSEC). Thus,
+\(HIGH LOW) or (HIGH LOW USEC) or (HIGH LOW USEC PSEC). Thus,
you can use times from `current-time' and from `file-attributes'.
SPECIFIED-TIME can also have the form (HIGH . LOW), but this is
considered obsolete.
TIME is specified as (HIGH LOW USEC PSEC), as returned by
`current-time' or `file-attributes'. The obsolete form (HIGH . LOW)
is also still accepted.
+
The optional ZONE is omitted or nil for Emacs local time, t for
Universal Time, `wall' for system wall clock time, or a string as in
-`set-time-zone-rule' for a time zone rule.
+the TZ environment variable. It can also be a list (as from
+`current-time-zone') or an integer (as from `decode-time') applied
+without consideration for daylight saving time.
+
The value is a copy of FORMAT-STRING, but with certain constructs replaced
by text that describes the specified date and time in TIME:
char *buf = buffer;
ptrdiff_t size = sizeof buffer;
size_t len;
- Lisp_Object bufstring;
int ns = t.tv_nsec;
USE_SAFE_ALLOCA;
}
xtzfree (tz);
- bufstring = make_unibyte_string (buf, len);
+ AUTO_STRING_WITH_LEN (bufstring, buf, len);
+ Lisp_Object result = code_convert_string_norecord (bufstring,
+ Vlocale_coding_system, 0);
SAFE_FREE ();
- return code_convert_string_norecord (bufstring, Vlocale_coding_system, 0);
+ return result;
}
DEFUN ("decode-time", Fdecode_time, Sdecode_time, 0, 2, 0,
The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED),
as from `current-time' and `file-attributes', or nil to use the
current time. The obsolete form (HIGH . LOW) is also still accepted.
+
The optional ZONE is omitted or nil for Emacs local time, t for
Universal Time, `wall' for system wall clock time, or a string as in
-`set-time-zone-rule' for a time zone rule.
+the TZ environment variable. It can also be a list (as from
+`current-time-zone') or an integer (as from `decode-time') applied
+without consideration for daylight saving time.
The list has the following nine members: SEC is an integer between 0
and 60; SEC is 60 for a leap second, which only some operating systems
}
/* Return OBJ - OFFSET, checking that OBJ is a valid fixnum and that
- the result is representable as an int. Assume OFFSET is small and
- nonnegative. */
+ the result is representable as an int. */
static int
check_tm_member (Lisp_Object obj, int offset)
{
- EMACS_INT n;
CHECK_NUMBER (obj);
- n = XINT (obj);
- if (! (INT_MIN + offset <= n && n - offset <= INT_MAX))
+ EMACS_INT n = XINT (obj);
+ int result;
+ if (INT_SUBTRACT_WRAPV (n, offset, &result))
time_overflow ();
- return n - offset;
+ return result;
}
DEFUN ("encode-time", Fencode_time, Sencode_time, 6, MANY, 0,
doc: /* Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
This is the reverse operation of `decode-time', which see.
+
The optional ZONE is omitted or nil for Emacs local time, t for
Universal Time, `wall' for system wall clock time, or a string as in
-`set-time-zone-rule' for a time zone rule. It can also be a list (as
-from `current-time-zone') or an integer (as from `decode-time')
-applied without consideration for daylight saving time.
+the TZ environment variable. It can also be a list (as from
+`current-time-zone') or an integer (as from `decode-time') applied
+without consideration for daylight saving time.
You can pass more than 7 arguments; then the first six arguments
are used as SECOND through YEAR, and the *last* argument is used as ZONE.
The intervening arguments are ignored.
-This feature lets (apply 'encode-time (decode-time ...)) work.
+This feature lets (apply \\='encode-time (decode-time ...)) work.
Out-of-range values for SECOND, MINUTE, HOUR, DAY, or MONTH are allowed;
for example, a DAY of 0 means the day preceding the given month.
tm.tm_year = check_tm_member (args[5], TM_YEAR_BASE);
tm.tm_isdst = -1;
- if (CONSP (zone))
- zone = XCAR (zone);
timezone_t tz = tzlookup (zone, false);
value = emacs_mktime_z (tz, &tm);
xtzfree (tz);
The optional ZONE is omitted or nil for Emacs local time, t for
Universal Time, `wall' for system wall clock time, or a string as in
-`set-time-zone-rule' for a time zone rule. */)
+the TZ environment variable. It can also be a list (as from
+`current-time-zone') or an integer (as from `decode-time') applied
+without consideration for daylight saving time. */)
(Lisp_Object specified_time, Lisp_Object zone)
{
time_t value = lisp_seconds_argument (specified_time);
NAME is a string giving the name of the time zone.
If SPECIFIED-TIME is given, the time zone offset is determined from it
instead of using the current time. The argument should have the form
-(HIGH LOW . IGNORED). Thus, you can use times obtained from
+\(HIGH LOW . IGNORED). Thus, you can use times obtained from
`current-time' and from `file-attributes'. SPECIFIED-TIME can also
have the form (HIGH . LOW), but this is considered obsolete.
-Optional second arg ZONE is omitted or nil for the local time zone, or
-a string as in `set-time-zone-rule'.
+
+The optional ZONE is omitted or nil for Emacs local time, t for
+Universal Time, `wall' for system wall clock time, or a string as in
+the TZ environment variable. It can also be a list (as from
+`current-time-zone') or an integer (as from `decode-time') applied
+without consideration for daylight saving time.
Some operating systems cannot provide all this information to Emacs;
in this case, `current-time-zone' returns a list containing nil for
zone_offset = make_number (offset);
if (SCHARS (zone_name) == 0)
{
- /* No local time zone name is available; use "+-NNNN" instead. */
- long int m = offset / 60;
- long int am = offset < 0 ? - m : m;
- long int hour = am / 60;
- int min = am % 60;
- char buf[sizeof "+00" + INT_STRLEN_BOUND (long int)];
- zone_name = make_formatted_string (buf, "%c%02ld%02d",
+ /* No local time zone name is available; use numeric zone instead. */
+ long int hour = offset / 3600;
+ int min_sec = offset % 3600;
+ int amin_sec = min_sec < 0 ? - min_sec : min_sec;
+ int min = amin_sec / 60;
+ int sec = amin_sec % 60;
+ int min_prec = min_sec ? 2 : 0;
+ int sec_prec = sec ? 2 : 0;
+ char buf[sizeof "+0000" + INT_STRLEN_BOUND (long int)];
+ zone_name = make_formatted_string (buf, "%c%.2ld%.*d%.*d",
(offset < 0 ? '-' : '+'),
- hour, min);
+ hour, min_prec, min, sec_prec, sec);
}
}
DEFUN ("set-time-zone-rule", Fset_time_zone_rule, Sset_time_zone_rule, 1, 1, 0,
doc: /* Set the Emacs local time zone using TZ, a string specifying a time zone rule.
-If TZ is nil or `wall', use system wall clock time. If TZ is t, use
-Universal Time. If TZ is an integer, treat it as in `encode-time'.
+If TZ is nil or `wall', use system wall clock time; this differs from
+the usual Emacs convention where nil means current local time. If TZ
+is t, use Universal Time. If TZ is a list (as from
+`current-time-zone') or an integer (as from `decode-time'), use the
+specified time zone without consideration for daylight saving time.
Instead of calling this function, you typically want something else.
To temporarily use a different time zone rule for just one invocation
tzval[tzeqlen] = 0;
}
- if (new_tzvalbuf
-#ifdef WINDOWSNT
- /* MS-Windows implementation of 'putenv' copies the argument
- string into a block it allocates, so modifying tzval string
- does not change the environment. OTOH, the other threads run
- by Emacs on MS-Windows never call 'xputenv' or 'putenv' or
- 'unsetenv', so the original cause for the dicey in-place
- modification technique doesn't exist there in the first
- place. */
- || 1
+
+#ifndef WINDOWSNT
+ /* Modifying *TZVAL merely requires calling tzset (which is the
+ caller's responsibility). However, modifying TZVAL requires
+ calling putenv; although this is not thread-safe, in practice this
+ runs only on startup when there is only one thread. */
+ bool need_putenv = new_tzvalbuf;
+#else
+ /* MS-Windows 'putenv' copies the argument string into a block it
+ allocates, so modifying *TZVAL will not change the environment.
+ However, the other threads run by Emacs on MS-Windows never call
+ 'xputenv' or 'putenv' or 'unsetenv', so the original cause for the
+ dicey in-place modification technique doesn't exist there in the
+ first place. */
+ bool need_putenv = true;
#endif
- )
- {
- /* Although this is not thread-safe, in practice this runs only
- on startup when there is only one thread. */
- xputenv (tzval);
- }
+ if (need_putenv)
+ xputenv (tzval);
return 0;
}
}
-/* Callers passing one argument to Finsert need not gcpro the
- argument "array", since the only element of the array will
- not be used after calling insert or insert_from_string, so
- we don't care if it gets trashed. */
-
DEFUN ("insert", Finsert, Sinsert, 0, MANY, 0,
doc: /* Insert the arguments, either strings or characters, at point.
-Point and before-insertion markers move forward to end up
+Point and after-insertion markers move forward to end up
after the inserted text.
Any other markers at the point of insertion remain before the text.
DEFUN ("insert-and-inherit", Finsert_and_inherit, Sinsert_and_inherit,
0, MANY, 0,
doc: /* Insert the arguments at point, inheriting properties from adjoining text.
-Point and before-insertion markers move forward to end up
+Point and after-insertion markers move forward to end up
after the inserted text.
Any other markers at the point of insertion remain before the text.
6, 6, 0,
doc: /* Compare two substrings of two buffers; return result as number.
Return -N if first string is less after N-1 chars, +N if first string is
-greater after N-1 chars, or 0 if strings match. Each substring is
-represented as three arguments: BUFFER, START and END. That makes six
-args in all, three for each substring.
-
+greater after N-1 chars, or 0 if strings match.
+The first substring is in BUFFER1 from START1 to END1 and the second
+is in BUFFER2 from START2 to END2.
The value of `case-fold-search' in the current buffer
determines whether case is significant or ignored. */)
(Lisp_Object buffer1, Lisp_Object start1, Lisp_Object end1, Lisp_Object buffer2, Lisp_Object start2, Lisp_Object end2)
{
Lisp_Object tem, string;
- struct gcpro gcpro1;
-
tem = BVAR (current_buffer, undo_list);
- GCPRO1 (tem);
/* Make a multibyte string containing this single character. */
string = make_multibyte_string ((char *) tostr, 1, len);
if (! NILP (noundo))
bset_undo_list (current_buffer, tem);
-
- UNGCPRO;
}
else
{
ptrdiff_t size; /* Size of translate table. */
ptrdiff_t pos, pos_byte, end_pos;
bool multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
- bool string_multibyte IF_LINT (= 0);
+ bool string_multibyte UNINIT;
validate_region (&start, &end);
if (CHAR_TABLE_P (table))
followed by a newline.
The first argument is a format control string, and the rest are data
-to be formatted under control of the string. See `format' for details.
+to be formatted under control of the string. See `format-message' for
+details.
-Note: Use (message "%s" VALUE) to print the value of expressions and
-variables to avoid accidentally interpreting `%' as format specifiers.
+Note: (message "%s" VALUE) displays the string VALUE without
+interpreting format characters like `%', `\\=`', and `\\=''.
If the first argument is nil or the empty string, the function clears
any existing message; this lets the minibuffer contents show. See
}
else
{
- register Lisp_Object val;
- val = Fformat (nargs, args);
+ Lisp_Object val = Fformat_message (nargs, args);
message3 (val);
return val;
}
doc: /* Display a message, in a dialog box if possible.
If a dialog box is not available, use the echo area.
The first argument is a format control string, and the rest are data
-to be formatted under control of the string. See `format' for details.
+to be formatted under control of the string. See `format-message' for
+details.
If the first argument is nil or the empty string, clear any existing
message; let the minibuffer contents show.
}
else
{
- Lisp_Object val = Fformat (nargs, args);
+ Lisp_Object val = Fformat_message (nargs, args);
Lisp_Object pane, menu;
- struct gcpro gcpro1;
pane = list1 (Fcons (build_string ("OK"), Qt));
- GCPRO1 (pane);
menu = Fcons (val, pane);
Fx_popup_dialog (Qt, menu, Qt);
- UNGCPRO;
return val;
}
}
`use-dialog-box' is non-nil.
Otherwise, use the echo area.
The first argument is a format control string, and the rest are data
-to be formatted under control of the string. See `format' for details.
+to be formatted under control of the string. See `format-message' for
+details.
If the first argument is nil or the empty string, clear any existing
message; let the minibuffer contents show.
(ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object properties, string;
- struct gcpro gcpro1, gcpro2;
ptrdiff_t i;
/* Number of args must be odd. */
error ("Wrong number of arguments");
properties = string = Qnil;
- GCPRO2 (properties, string);
/* First argument must be a string. */
CHECK_STRING (args[0]);
Fadd_text_properties (make_number (0),
make_number (SCHARS (string)),
properties, string);
- RETURN_UNGCPRO (string);
+ return string;
}
DEFUN ("format", Fformat, Sformat, 1, MANY, 0,
The first argument is a format control string.
The other arguments are substituted into it to make the result, a string.
-The format control string may contain ordinary characters,
-%-sequences meaning to substitute the next available argument,
-and curved single quotation marks meaning to substitute quotes.
+The format control string may contain %-sequences meaning to substitute
+the next available argument:
%s means print a string argument. Actually, prints any object, with `princ'.
%d means print as number in decimal (%o octal, %x hex).
decimal point itself is omitted. For %s and %S, the precision
specifier truncates the string to the given width.
-\\=‘ and \\=’ means print left and right quotes as per
-‘text-quoting-style’.
-
-Return the first argument if it contains no format directives.
-Otherwise, return a new string.
+Text properties, if any, are copied from the format-string to the
+produced text.
usage: (format STRING &rest OBJECTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
+{
+ return styled_format (nargs, args, false);
+}
+
+DEFUN ("format-message", Fformat_message, Sformat_message, 1, MANY, 0,
+ doc: /* Format a string out of a format-string and arguments.
+The first argument is a format control string.
+The other arguments are substituted into it to make the result, a string.
+
+This acts like `format', except it also replaces each left single
+quotation mark (\\=‘) and grave accent (\\=`) by a left quote, and each
+right single quotation mark (\\=’) and apostrophe (\\=') by a right quote.
+The left and right quote replacement characters are specified by
+`text-quoting-style'.
+
+usage: (format-message STRING &rest OBJECTS) */)
+ (ptrdiff_t nargs, Lisp_Object *args)
+{
+ return styled_format (nargs, args, true);
+}
+
+/* Implement ‘format-message’ if MESSAGE is true, ‘format’ otherwise. */
+
+static Lisp_Object
+styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
{
ptrdiff_t n; /* The number of the next arg to substitute. */
char initial_buffer[4000];
ptrdiff_t bufsize = sizeof initial_buffer;
ptrdiff_t max_bufsize = STRING_BYTES_BOUND + 1;
char *p;
- ptrdiff_t buf_save_value_index IF_LINT (= 0);
- char *format, *end, *format_start;
- ptrdiff_t formatlen, nchars;
- bool changed = false;
- /* True if the format is multibyte. */
- bool multibyte_format = 0;
- /* True if the output should be a multibyte string,
- which is true if any of the inputs is one. */
- bool multibyte = 0;
+ ptrdiff_t buf_save_value_index UNINIT;
+ char *format, *end;
+ ptrdiff_t nchars;
/* When we make a multibyte string, we must pay attention to the
byte combining problem, i.e., a byte may be combined with a
multibyte character of the previous string. This flag tells if we
must consider such a situation or not. */
bool maybe_combine_byte;
- Lisp_Object val;
- bool arg_intervals = 0;
+ bool arg_intervals = false;
USE_SAFE_ALLOCA;
- /* discarded[I] is 1 if byte I of the format
- string was not copied into the output.
- It is 2 if byte I was not the first byte of its character. */
- char *discarded;
-
/* Each element records, for one argument,
the start and end bytepos in the output string,
whether the argument has been converted to string (e.g., due to "%S"),
- and whether the argument is a string with intervals.
- info[0] is unused. Unused elements have -1 for start. */
+ and whether the argument is a string with intervals. */
struct info
{
ptrdiff_t start, end;
bool_bf converted_to_string : 1;
bool_bf intervals : 1;
- } *info = 0;
-
- /* It should not be necessary to GCPRO ARGS, because
- the caller in the interpreter should take care of that. */
+ } *info;
CHECK_STRING (args[0]);
- format_start = SSDATA (args[0]);
- formatlen = SBYTES (args[0]);
+ char *format_start = SSDATA (args[0]);
+ ptrdiff_t formatlen = SBYTES (args[0]);
/* Allocate the info and discarded tables. */
- {
- ptrdiff_t i;
- if ((SIZE_MAX - formatlen) / sizeof (struct info) <= nargs)
- memory_full (SIZE_MAX);
- info = SAFE_ALLOCA ((nargs + 1) * sizeof *info + formatlen);
- discarded = (char *) &info[nargs + 1];
- for (i = 0; i < nargs + 1; i++)
- {
- info[i].start = -1;
- info[i].intervals = info[i].converted_to_string = 0;
- }
- memset (discarded, 0, formatlen);
- }
+ ptrdiff_t alloca_size;
+ if (INT_MULTIPLY_WRAPV (nargs, sizeof *info, &alloca_size)
+ || INT_ADD_WRAPV (sizeof *info, alloca_size, &alloca_size)
+ || INT_ADD_WRAPV (formatlen, alloca_size, &alloca_size)
+ || SIZE_MAX < alloca_size)
+ memory_full (SIZE_MAX);
+ /* info[0] is unused. Unused elements have -1 for start. */
+ info = SAFE_ALLOCA (alloca_size);
+ memset (info, 0, alloca_size);
+ for (ptrdiff_t i = 0; i < nargs + 1; i++)
+ info[i].start = -1;
+ /* discarded[I] is 1 if byte I of the format
+ string was not copied into the output.
+ It is 2 if byte I was not the first byte of its character. */
+ char *discarded = (char *) &info[nargs + 1];
/* Try to determine whether the result should be multibyte.
This is not always right; sometimes the result needs to be multibyte
- because of an object that we will pass through prin1,
+ because of an object that we will pass through prin1.
+ or because a grave accent or apostrophe is requoted,
and in that case, we won't know it here. */
- multibyte_format = STRING_MULTIBYTE (args[0]);
- multibyte = multibyte_format;
- for (n = 1; !multibyte && n < nargs; n++)
- if (STRINGP (args[n]) && STRING_MULTIBYTE (args[n]))
- multibyte = 1;
- enum text_quoting_style quoting_style = text_quoting_style ();
+ /* True if the format is multibyte. */
+ bool multibyte_format = STRING_MULTIBYTE (args[0]);
+ /* True if the output should be a multibyte string,
+ which is true if any of the inputs is one. */
+ bool multibyte = multibyte_format;
+ for (ptrdiff_t i = 1; !multibyte && i < nargs; i++)
+ if (STRINGP (args[i]) && STRING_MULTIBYTE (args[i]))
+ multibyte = true;
+
+ int quoting_style = message ? text_quoting_style () : -1;
/* If we start out planning a unibyte result,
then discover it has to be multibyte, we jump back to retry. */
/* Scan the format and store result in BUF. */
format = format_start;
end = format + formatlen;
- maybe_combine_byte = 0;
+ maybe_combine_byte = false;
while (format != end)
{
/* The values of N and FORMAT when the loop body is entered. */
ptrdiff_t n0 = n;
char *format0 = format;
+ char const *convsrc = format;
+ unsigned char format_char = *format++;
/* Bytes needed to represent the output of this conversion. */
- ptrdiff_t convbytes;
+ ptrdiff_t convbytes = 1;
- if (*format == '%')
+ if (format_char == '%')
{
/* General format specifications look like
digits to print after the '.' for floats, or the max.
number of chars to print from a string. */
- bool minus_flag = 0;
- bool plus_flag = 0;
- bool space_flag = 0;
- bool sharp_flag = 0;
- bool zero_flag = 0;
- ptrdiff_t field_width;
- bool precision_given;
- uintmax_t precision = UINTMAX_MAX;
- char *num_end;
- char conversion;
+ bool minus_flag = false;
+ bool plus_flag = false;
+ bool space_flag = false;
+ bool sharp_flag = false;
+ bool zero_flag = false;
- while (1)
+ for (; ; format++)
{
- switch (*++format)
+ switch (*format)
{
- case '-': minus_flag = 1; continue;
- case '+': plus_flag = 1; continue;
- case ' ': space_flag = 1; continue;
- case '#': sharp_flag = 1; continue;
- case '0': zero_flag = 1; continue;
+ case '-': minus_flag = true; continue;
+ case '+': plus_flag = true; continue;
+ case ' ': space_flag = true; continue;
+ case '#': sharp_flag = true; continue;
+ case '0': zero_flag = true; continue;
}
break;
}
space_flag &= ~ plus_flag;
zero_flag &= ~ minus_flag;
- {
- uintmax_t w = strtoumax (format, &num_end, 10);
- if (max_bufsize <= w)
- string_overflow ();
- field_width = w;
- }
- precision_given = *num_end == '.';
- if (precision_given)
- precision = strtoumax (num_end + 1, &num_end, 10);
+ char *num_end;
+ uintmax_t raw_field_width = strtoumax (format, &num_end, 10);
+ if (max_bufsize <= raw_field_width)
+ string_overflow ();
+ ptrdiff_t field_width = raw_field_width;
+
+ bool precision_given = *num_end == '.';
+ uintmax_t precision = (precision_given
+ ? strtoumax (num_end + 1, &num_end, 10)
+ : UINTMAX_MAX);
format = num_end;
if (format == end)
error ("Format string ends in middle of format specifier");
- changed = true;
- memset (&discarded[format0 - format_start], 1, format - format0);
- conversion = *format;
+ char conversion = *format++;
+ memset (&discarded[format0 - format_start], 1,
+ format - format0 - (conversion == '%'));
if (conversion == '%')
goto copy_char;
- discarded[format - format_start] = 1;
- format++;
++n;
if (! (n < nargs))
{
Lisp_Object noescape = conversion == 'S' ? Qnil : Qt;
args[n] = Fprin1_to_string (args[n], noescape);
- info[n].converted_to_string = 1;
+ info[n].converted_to_string = true;
if (STRING_MULTIBYTE (args[n]) && ! multibyte)
{
- multibyte = 1;
+ multibyte = true;
goto retry;
}
}
{
if (!multibyte)
{
- multibyte = 1;
+ multibyte = true;
goto retry;
}
args[n] = Fchar_to_string (args[n]);
- info[n].converted_to_string = 1;
+ info[n].converted_to_string = true;
}
if (info[n].converted_to_string)
conversion = 's';
- zero_flag = 0;
+ zero_flag = false;
}
if (SYMBOLP (args[n]))
args[n] = SYMBOL_NAME (args[n]);
if (STRING_MULTIBYTE (args[n]) && ! multibyte)
{
- multibyte = 1;
+ multibyte = true;
goto retry;
}
}
{
/* handle case (precision[n] >= 0) */
- ptrdiff_t width, padding, nbytes;
- ptrdiff_t nchars_string;
-
ptrdiff_t prec = -1;
if (precision_given && precision <= TYPE_MAXIMUM (ptrdiff_t))
prec = precision;
lisp_string_width is the right thing, and will be
done, but meanwhile we work with it. */
+ ptrdiff_t width, nbytes;
+ ptrdiff_t nchars_string;
if (prec == 0)
width = nchars_string = nbytes = 0;
else
if (convbytes && multibyte && ! STRING_MULTIBYTE (args[n]))
convbytes = count_size_as_multibyte (SDATA (args[n]), nbytes);
- padding = width < field_width ? field_width - width : 0;
+ ptrdiff_t padding
+ = width < field_width ? field_width - width : 0;
if (max_bufsize - padding <= convbytes)
string_overflow ();
p += padding;
nchars += padding;
}
+ info[n].start = nchars;
if (p > buf
&& multibyte
&& !ASCII_CHAR_P (*((unsigned char *) p - 1))
&& STRING_MULTIBYTE (args[n])
&& !CHAR_HEAD_P (SREF (args[n], 0)))
- maybe_combine_byte = 1;
+ maybe_combine_byte = true;
p += copy_text (SDATA (args[n]), (unsigned char *) p,
nbytes,
STRING_MULTIBYTE (args[n]), multibyte);
- info[n].start = nchars;
nchars += nchars_string;
- info[n].end = nchars;
if (minus_flag)
{
p += padding;
nchars += padding;
}
+ info[n].end = nchars;
/* If this argument has text properties, record where
in the result string it appears. */
if (string_intervals (args[n]))
- info[n].intervals = arg_intervals = 1;
+ info[n].intervals = arg_intervals = true;
continue;
}
|| conversion == 'X'))
error ("Invalid format operation %%%c",
STRING_CHAR ((unsigned char *) format - 1));
- else if (! (INTEGERP (args[n]) || FLOATP (args[n])))
+ else if (! NUMBERP (args[n]))
error ("Format specifier doesn't match argument type");
else
{
};
verify (USEFUL_PRECISION_MAX > 0);
- int prec;
- ptrdiff_t padding, sprintf_bytes;
- uintmax_t excess_precision, numwidth;
- uintmax_t leading_zeros = 0, trailing_zeros = 0;
-
- char sprintf_buf[SPRINTF_BUFSIZE];
-
- /* Copy of conversion specification, modified somewhat.
- At most three flags F can be specified at once. */
- char convspec[sizeof "%FFF.*d" + pMlen];
-
/* Avoid undefined behavior in underlying sprintf. */
if (conversion == 'd' || conversion == 'i')
- sharp_flag = 0;
+ sharp_flag = false;
/* Create the copy of the conversion specification, with
any width and precision removed, with ".*" inserted,
- and with pM inserted for integer formats. */
+ and with pM inserted for integer formats.
+ At most three flags F can be specified at once. */
+ char convspec[sizeof "%FFF.*d" + pMlen];
{
char *f = convspec;
*f++ = '%';
*f = '\0';
}
- prec = -1;
+ int prec = -1;
if (precision_given)
prec = min (precision, USEFUL_PRECISION_MAX);
careful about integer overflow, NaNs, infinities, and
conversions; for example, the min and max macros are
not suitable here. */
+ char sprintf_buf[SPRINTF_BUFSIZE];
+ ptrdiff_t sprintf_bytes;
if (conversion == 'e' || conversion == 'f' || conversion == 'g')
{
double x = (INTEGERP (args[n])
padding and excess precision. Deal with excess precision
first. This happens only when the format specifies
ridiculously large precision. */
- excess_precision = precision - prec;
+ uintmax_t excess_precision = precision - prec;
+ uintmax_t leading_zeros = 0, trailing_zeros = 0;
if (excess_precision)
{
if (conversion == 'e' || conversion == 'f'
/* Compute the total bytes needed for this item, including
excess precision and padding. */
- numwidth = sprintf_bytes + excess_precision;
- padding = numwidth < field_width ? field_width - numwidth : 0;
+ uintmax_t numwidth = sprintf_bytes + excess_precision;
+ ptrdiff_t padding
+ = numwidth < field_width ? field_width - numwidth : 0;
if (max_bufsize - sprintf_bytes <= excess_precision
|| max_bufsize - padding <= numwidth)
string_overflow ();
char src0 = src[0];
int exponent_bytes = 0;
bool signedp = src0 == '-' || src0 == '+' || src0 == ' ';
- int significand_bytes;
if (zero_flag
&& ((src[signedp] >= '0' && src[signedp] <= '9')
|| (src[signedp] >= 'a' && src[signedp] <= 'f')
exponent_bytes = src + sprintf_bytes - e;
}
+ info[n].start = nchars;
if (! minus_flag)
{
memset (p, ' ', padding);
p += signedp;
memset (p, '0', leading_zeros);
p += leading_zeros;
- significand_bytes = sprintf_bytes - signedp - exponent_bytes;
+ int significand_bytes
+ = sprintf_bytes - signedp - exponent_bytes;
memcpy (p, src, significand_bytes);
p += significand_bytes;
src += significand_bytes;
memcpy (p, src, exponent_bytes);
p += exponent_bytes;
- info[n].start = nchars;
nchars += leading_zeros + sprintf_bytes + trailing_zeros;
- info[n].end = nchars;
if (minus_flag)
{
p += padding;
nchars += padding;
}
+ info[n].end = nchars;
continue;
}
}
}
else
- copy_char:
{
- /* Copy a single character from format to buf. */
-
- char *src = format;
unsigned char str[MAX_MULTIBYTE_LENGTH];
- if (multibyte_format)
+ if ((format_char == '`' || format_char == '\'')
+ && quoting_style == CURVE_QUOTING_STYLE)
{
- /* Copy a whole multibyte character. */
- if (p > buf
- && !ASCII_CHAR_P (*((unsigned char *) p - 1))
- && !CHAR_HEAD_P (*format))
- maybe_combine_byte = 1;
-
- do
- format++;
- while (! CHAR_HEAD_P (*format));
-
- convbytes = format - src;
- memset (&discarded[src + 1 - format_start], 2, convbytes - 1);
-
- if (quoting_style != CURVE_QUOTING_STYLE && convbytes == 3
- && (unsigned char) src[0] == uLSQM0
- && (unsigned char) src[1] == uLSQM1
- && ((unsigned char) src[2] == uLSQM2
- || (unsigned char) src[2] == uRSQM2))
+ if (! multibyte)
{
- convbytes = 1;
- str[0] = (((unsigned char) src[2] == uLSQM2
- && quoting_style == GRAVE_QUOTING_STYLE)
- ? '`' : '\'');
- src = (char *) str;
- changed = true;
+ multibyte = true;
+ goto retry;
}
+ convsrc = format_char == '`' ? uLSQM : uRSQM;
+ convbytes = 3;
}
+ else if (format_char == '`' && quoting_style == STRAIGHT_QUOTING_STYLE)
+ convsrc = "'";
else
{
- unsigned char uc = *format++;
- if (! multibyte || ASCII_CHAR_P (uc))
- convbytes = 1;
- else
+ /* Copy a single character from format to buf. */
+ if (multibyte_format)
+ {
+ /* Copy a whole multibyte character. */
+ if (p > buf
+ && !ASCII_CHAR_P (*((unsigned char *) p - 1))
+ && !CHAR_HEAD_P (format_char))
+ maybe_combine_byte = true;
+
+ while (! CHAR_HEAD_P (*format))
+ format++;
+
+ convbytes = format - format0;
+ memset (&discarded[format0 + 1 - format_start], 2,
+ convbytes - 1);
+ }
+ else if (multibyte && !ASCII_CHAR_P (format_char))
{
- int c = BYTE8_TO_CHAR (uc);
+ int c = BYTE8_TO_CHAR (format_char);
convbytes = CHAR_STRING (c, str);
- src = (char *) str;
- changed = true;
+ convsrc = (char *) str;
}
}
+ copy_char:
if (convbytes <= buf + bufsize - p)
{
- memcpy (p, src, convbytes);
+ memcpy (p, convsrc, convbytes);
p += convbytes;
nchars++;
continue;
/* There wasn't enough room to store this conversion or single
character. CONVBYTES says how much room is needed. Allocate
enough room (and then some) and do it again. */
- {
- ptrdiff_t used = p - buf;
- if (max_bufsize - used < convbytes)
- string_overflow ();
- bufsize = used + convbytes;
- bufsize = bufsize < max_bufsize / 2 ? bufsize * 2 : max_bufsize;
-
- if (buf == initial_buffer)
- {
- buf = xmalloc (bufsize);
- sa_must_free = true;
- buf_save_value_index = SPECPDL_INDEX ();
- record_unwind_protect_ptr (xfree, buf);
- memcpy (buf, initial_buffer, used);
- }
- else
- {
- buf = xrealloc (buf, bufsize);
- set_unwind_protect_ptr (buf_save_value_index, xfree, buf);
- }
+ ptrdiff_t used = p - buf;
+ if (max_bufsize - used < convbytes)
+ string_overflow ();
+ bufsize = used + convbytes;
+ bufsize = bufsize < max_bufsize / 2 ? bufsize * 2 : max_bufsize;
- p = buf + used;
- }
+ if (buf == initial_buffer)
+ {
+ buf = xmalloc (bufsize);
+ sa_must_free = true;
+ buf_save_value_index = SPECPDL_INDEX ();
+ record_unwind_protect_ptr (xfree, buf);
+ memcpy (buf, initial_buffer, used);
+ }
+ else
+ {
+ buf = xrealloc (buf, bufsize);
+ set_unwind_protect_ptr (buf_save_value_index, xfree, buf);
+ }
+ p = buf + used;
format = format0;
n = n0;
}
if (bufsize < p - buf)
emacs_abort ();
- if (!changed)
- val = args[0];
- else
- {
- if (maybe_combine_byte)
- nchars = multibyte_chars_in_text ((unsigned char *) buf, p - buf);
- val = make_specified_string (buf, nchars, p - buf, multibyte);
+ if (maybe_combine_byte)
+ nchars = multibyte_chars_in_text ((unsigned char *) buf, p - buf);
+ Lisp_Object val = make_specified_string (buf, nchars, p - buf, multibyte);
- /* If the format string has text properties, or any of the string
- arguments has text properties, set up text properties of the
- result string. */
+ /* If the format string has text properties, or any of the string
+ arguments has text properties, set up text properties of the
+ result string. */
- if (string_intervals (args[0]) || arg_intervals)
+ if (string_intervals (args[0]) || arg_intervals)
+ {
+ /* Add text properties from the format string. */
+ Lisp_Object len = make_number (SCHARS (args[0]));
+ Lisp_Object props = text_property_list (args[0], make_number (0),
+ len, Qnil);
+ if (CONSP (props))
{
- Lisp_Object len, new_len, props;
- struct gcpro gcpro1;
-
- /* Add text properties from the format string. */
- len = make_number (SCHARS (args[0]));
- props = text_property_list (args[0], make_number (0), len, Qnil);
- GCPRO1 (props);
-
- if (CONSP (props))
+ ptrdiff_t bytepos = 0, position = 0, translated = 0;
+ ptrdiff_t argn = 1;
+
+ /* Adjust the bounds of each text property
+ to the proper start and end in the output string. */
+
+ /* Put the positions in PROPS in increasing order, so that
+ we can do (effectively) one scan through the position
+ space of the format string. */
+ props = Fnreverse (props);
+
+ /* BYTEPOS is the byte position in the format string,
+ POSITION is the untranslated char position in it,
+ TRANSLATED is the translated char position in BUF,
+ and ARGN is the number of the next arg we will come to. */
+ for (Lisp_Object list = props; CONSP (list); list = XCDR (list))
{
- ptrdiff_t bytepos = 0, position = 0, translated = 0;
- ptrdiff_t argn = 1;
- Lisp_Object list;
-
- /* Adjust the bounds of each text property
- to the proper start and end in the output string. */
-
- /* Put the positions in PROPS in increasing order, so that
- we can do (effectively) one scan through the position
- space of the format string. */
- props = Fnreverse (props);
-
- /* BYTEPOS is the byte position in the format string,
- POSITION is the untranslated char position in it,
- TRANSLATED is the translated char position in BUF,
- and ARGN is the number of the next arg we will come to. */
- for (list = props; CONSP (list); list = XCDR (list))
- {
- Lisp_Object item;
- ptrdiff_t pos;
-
- item = XCAR (list);
+ Lisp_Object item = XCAR (list);
- /* First adjust the property start position. */
- pos = XINT (XCAR (item));
+ /* First adjust the property start position. */
+ ptrdiff_t pos = XINT (XCAR (item));
- /* Advance BYTEPOS, POSITION, TRANSLATED and ARGN
- up to this position. */
- for (; position < pos; bytepos++)
+ /* Advance BYTEPOS, POSITION, TRANSLATED and ARGN
+ up to this position. */
+ for (; position < pos; bytepos++)
+ {
+ if (! discarded[bytepos])
+ position++, translated++;
+ else if (discarded[bytepos] == 1)
{
- if (! discarded[bytepos])
- position++, translated++;
- else if (discarded[bytepos] == 1)
+ position++;
+ if (translated == info[argn].start)
{
- position++;
- if (translated == info[argn].start)
- {
- translated += info[argn].end - info[argn].start;
- argn++;
- }
+ translated += info[argn].end - info[argn].start;
+ argn++;
}
}
+ }
- XSETCAR (item, make_number (translated));
+ XSETCAR (item, make_number (translated));
- /* Likewise adjust the property end position. */
- pos = XINT (XCAR (XCDR (item)));
+ /* Likewise adjust the property end position. */
+ pos = XINT (XCAR (XCDR (item)));
- for (; position < pos; bytepos++)
+ for (; position < pos; bytepos++)
+ {
+ if (! discarded[bytepos])
+ position++, translated++;
+ else if (discarded[bytepos] == 1)
{
- if (! discarded[bytepos])
- position++, translated++;
- else if (discarded[bytepos] == 1)
+ position++;
+ if (translated == info[argn].start)
{
- position++;
- if (translated == info[argn].start)
- {
- translated += info[argn].end - info[argn].start;
- argn++;
- }
+ translated += info[argn].end - info[argn].start;
+ argn++;
}
}
-
- XSETCAR (XCDR (item), make_number (translated));
}
- add_text_properties_from_list (val, props, make_number (0));
+ XSETCAR (XCDR (item), make_number (translated));
}
- /* Add text properties from arguments. */
- if (arg_intervals)
- for (n = 1; n < nargs; ++n)
- if (info[n].intervals)
- {
- len = make_number (SCHARS (args[n]));
- new_len = make_number (info[n].end - info[n].start);
- props = text_property_list (args[n], make_number (0),
- len, Qnil);
- props = extend_property_ranges (props, new_len);
- /* If successive arguments have properties, be sure that
- the value of `composition' property be the copy. */
- if (n > 1 && info[n - 1].end)
- make_composition_value_copy (props);
- add_text_properties_from_list (val, props,
- make_number (info[n].start));
- }
-
- UNGCPRO;
+ add_text_properties_from_list (val, props, make_number (0));
}
+
+ /* Add text properties from arguments. */
+ if (arg_intervals)
+ for (ptrdiff_t i = 1; i < nargs; i++)
+ if (info[i].intervals)
+ {
+ len = make_number (SCHARS (args[i]));
+ Lisp_Object new_len = make_number (info[i].end - info[i].start);
+ props = text_property_list (args[i], make_number (0), len, Qnil);
+ props = extend_property_ranges (props, len, new_len);
+ /* If successive arguments have properties, be sure that
+ the value of `composition' property be the copy. */
+ if (1 < i && info[i - 1].end)
+ make_composition_value_copy (props);
+ add_text_properties_from_list (val, props,
+ make_number (info[i].start));
+ }
}
/* If we allocated BUF or INFO with malloc, free it too. */
start2_addr = BYTE_POS_ADDR (start2_byte);
memcpy (temp, start1_addr, len1_byte);
memcpy (start1_addr, start2_addr, len2_byte);
- memcpy (start1_addr + len2_byte, start1_addr + len1_byte, len_mid);
+ memmove (start1_addr + len2_byte, start1_addr + len1_byte, len_mid);
memcpy (start1_addr + len2_byte + len_mid, temp, len1_byte);
SAFE_FREE ();
start2_byte, start2_byte + len2_byte);
fix_start_end_in_overlays (start1, end2);
}
+ else
+ {
+ /* The character positions of the markers remain intact, but we
+ still need to update their byte positions, because the
+ transposed regions might include multibyte sequences which
+ make some original byte positions of the markers invalid. */
+ adjust_markers_bytepos (start1, start1_byte, end2, end2_byte, 0);
+ }
signal_after_change (start1, end2 - start1, end2 - start1);
return Qnil;
defsubr (&Smessage_or_box);
defsubr (&Scurrent_message);
defsubr (&Sformat);
+ defsubr (&Sformat_message);
defsubr (&Sinsert_buffer_substring);
defsubr (&Scompare_buffer_substrings);