You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
#include <sys/types.h>
extern char **environ;
extern Lisp_Object make_time ();
extern void insert_from_buffer ();
-static long difftm ();
+static int tm_diff ();
static void update_buffer_properties ();
void set_time_zone_rule ();
()
{
Lisp_Object temp;
- XSETFASTINT (temp, point);
+ XSETFASTINT (temp, PT);
return temp;
}
"Return value of point, as a marker object.")
()
{
- return buildmark (point);
+ return buildmark (PT);
}
int
Fsignal (Qmark_inactive, Qnil);
m = Fmarker_position (current_buffer->mark);
if (NILP (m)) error ("There is no region now");
- if ((point < XFASTINT (m)) == beginningp)
- return (make_number (point));
+ if ((PT < XFASTINT (m)) == beginningp)
+ return (make_number (PT));
else
return (m);
}
Lisp_Object
save_excursion_restore (info)
- register Lisp_Object info;
+ Lisp_Object info;
{
- register Lisp_Object tem, tem1, omark, nmark;
+ Lisp_Object tem, tem1, omark, nmark;
+ struct gcpro gcpro1, gcpro2, gcpro3;
tem = Fmarker_buffer (Fcar (info));
/* If buffer being returned to is now deleted, avoid error */
/* In that case, Fmarker_buffer returns nil now. */
if (NILP (tem))
return Qnil;
+
+ omark = nmark = Qnil;
+ GCPRO3 (info, omark, nmark);
+
Fset_buffer (tem);
tem = Fcar (info);
Fgoto_char (tem);
else if (! NILP (tem1))
call1 (Vrun_hooks, intern ("deactivate-mark-hook"));
}
+ UNGCPRO;
return Qnil;
}
int count = specpdl_ptr - specpdl;
record_unwind_protect (save_excursion_restore, save_excursion_save ());
-
+
+ val = Fprogn (args);
+ return unbind_to (count, val);
+}
+
+DEFUN ("save-current-buffer", Fsave_current_buffer, Ssave_current_buffer, 0, UNEVALLED, 0,
+ "Save the current buffer; execute BODY; restore the current buffer.\n\
+Executes BODY just like `progn'.")
+ (args)
+ Lisp_Object args;
+{
+ register Lisp_Object val;
+ int count = specpdl_ptr - specpdl;
+
+ record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+
val = Fprogn (args);
return unbind_to (count, val);
}
()
{
Lisp_Object temp;
- if (point >= ZV)
+ if (PT >= ZV)
XSETFASTINT (temp, 0);
else
- XSETFASTINT (temp, FETCH_CHAR (point));
+ XSETFASTINT (temp, FETCH_CHAR (PT));
return temp;
}
()
{
Lisp_Object temp;
- if (point <= BEGV)
+ if (PT <= BEGV)
XSETFASTINT (temp, 0);
else
- XSETFASTINT (temp, FETCH_CHAR (point - 1));
+ XSETFASTINT (temp, FETCH_CHAR (PT - 1));
return temp;
}
If the buffer is narrowed, this means the beginning of the narrowed part.")
()
{
- if (point == BEGV)
+ if (PT == BEGV)
return Qt;
return Qnil;
}
If the buffer is narrowed, this means the end of the narrowed part.")
()
{
- if (point == ZV)
+ if (PT == ZV)
return Qt;
return Qnil;
}
"Return T if point is at the beginning of a line.")
()
{
- if (point == BEGV || FETCH_CHAR (point - 1) == '\n')
+ if (PT == BEGV || FETCH_CHAR (PT - 1) == '\n')
return Qt;
return Qnil;
}
`End of a line' includes point being at the end of the buffer.")
()
{
- if (point == ZV || FETCH_CHAR (point) == '\n')
+ if (PT == ZV || FETCH_CHAR (PT) == '\n')
return Qt;
return Qnil;
}
%A is replaced by the full name of the day of week.\n\
%b is replaced by the abbreviated name of the month.\n\
%B is replaced by the full name of the month.\n\
-%c is a synonym for \"%x %X\".\n\
-%C is a locale-specific synonym, which defaults to \"%A, %B %e, %Y\" in the C locale.\n\
+%c stands for the preferred date/time format of the C locale.\n\
%d is replaced by the day of month, zero-padded.\n\
%D is a synonym for \"%m/%d/%y\".\n\
%e is replaced by the day of month, blank-padded.\n\
%k is replaced by the hour (0-23), blank padded.\n\
%l is replaced by the hour (1-12), blank padded.\n\
%m is replaced by the month (01-12).\n\
-%M is replaced by the minut (00-59).\n\
+%M is replaced by the minute (00-59).\n\
%n is a synonym for \"\\n\".\n\
%p is replaced by AM or PM, as appropriate.\n\
%r is a synonym for \"%I:%M:%S %p\".\n\
%R is a synonym for \"%H:%M\".\n\
-%S is replaced by the seconds (00-60).\n\
+%S is replaced by the second (00-60).\n\
%t is a synonym for \"\\t\".\n\
%T is a synonym for \"%H:%M:%S\".\n\
-%U is replaced by the week of the year (01-52), first day of week is Sunday.\n\
+%U is replaced by the week of the year (00-53), first day of week is Sunday.\n\
%w is replaced by the day of week (0-6), Sunday is day 0.\n\
-%W is replaced by the week of the year (01-52), first day of week is Monday.\n\
+%W is replaced by the week of the year (00-53), first day of week is Monday.\n\
%x is a locale-specific synonym, which defaults to \"%D\" in the C locale.\n\
%X is a locale-specific synonym, which defaults to \"%T\" in the C locale.\n\
%y is replaced by the year without century (00-99).\n\
while (1)
{
char *buf = (char *) alloca (size);
+ *buf = 1;
if (emacs_strftime (buf, size, XSTRING (format_string)->data,
- localtime (&value)))
+ localtime (&value))
+ || !*buf)
return build_string (buf);
/* If buffer was too small, make it bigger. */
size *= 2;
XSETFASTINT (list_args[2], decoded_time->tm_hour);
XSETFASTINT (list_args[3], decoded_time->tm_mday);
XSETFASTINT (list_args[4], decoded_time->tm_mon + 1);
- XSETFASTINT (list_args[5], decoded_time->tm_year + 1900);
+ XSETINT (list_args[5], decoded_time->tm_year + 1900);
XSETFASTINT (list_args[6], decoded_time->tm_wday);
list_args[7] = (decoded_time->tm_isdst)? Qt : Qnil;
if (decoded_time == 0)
list_args[8] = Qnil;
else
- XSETINT (list_args[8], difftm (&save_tm, decoded_time));
+ XSETINT (list_args[8], tm_diff (&save_tm, decoded_time));
return Flist (9, list_args);
}
-DEFUN ("encode-time", Fencode_time, Sencode_time, 6, 7, 0,
+DEFUN ("encode-time", Fencode_time, Sencode_time, 6, MANY, 0,
"Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.\n\
-This is the reverse operation of `decode-time', which see. ZONE defaults\n\
-to the current time zone rule if not specified; if specified, it can\n\
-be a string (as from `set-time-zone-rule'), or it can be a list\n\
+This is the reverse operation of `decode-time', which see.\n\
+ZONE defaults to the current time zone rule. This can\n\
+be a string or t (as from `set-time-zone-rule'), or it can be a list\n\
(as from `current-time-zone') or an integer (as from `decode-time')\n\
applied without consideration for daylight savings time.\n\
+\n\
+You can pass more than 7 arguments; then the first six arguments\n\
+are used as SECOND through YEAR, and the *last* argument is used as ZONE.\n\
+The intervening arguments are ignored.\n\
+This feature lets (apply 'encode-time (decode-time ...)) work.\n\
+\n\
Out-of-range values for SEC, MINUTE, HOUR, DAY, or MONTH are allowed;\n\
for example, a DAY of 0 means the day preceding the given month.\n\
Year numbers less than 100 are treated just like other year numbers.\n\
If you want them to stand for years in this century, you must do that yourself.")
- (second, minute, hour, day, month, year, zone)
- Lisp_Object second, minute, hour, day, month, year, zone;
+ (nargs, args)
+ int nargs;
+ register Lisp_Object *args;
{
time_t time;
struct tm tm;
-
- CHECK_NUMBER (second, 0);
- CHECK_NUMBER (minute, 1);
- CHECK_NUMBER (hour, 2);
- CHECK_NUMBER (day, 3);
- CHECK_NUMBER (month, 4);
- CHECK_NUMBER (year, 5);
-
- tm.tm_sec = XINT (second);
- tm.tm_min = XINT (minute);
- tm.tm_hour = XINT (hour);
- tm.tm_mday = XINT (day);
- tm.tm_mon = XINT (month) - 1;
- tm.tm_year = XINT (year) - 1900;
+ Lisp_Object zone = (nargs > 6)? args[nargs - 1] : Qnil;
+
+ CHECK_NUMBER (args[0], 0); /* second */
+ CHECK_NUMBER (args[1], 1); /* minute */
+ CHECK_NUMBER (args[2], 2); /* hour */
+ CHECK_NUMBER (args[3], 3); /* day */
+ CHECK_NUMBER (args[4], 4); /* month */
+ CHECK_NUMBER (args[5], 5); /* year */
+
+ tm.tm_sec = XINT (args[0]);
+ tm.tm_min = XINT (args[1]);
+ tm.tm_hour = XINT (args[2]);
+ tm.tm_mday = XINT (args[3]);
+ tm.tm_mon = XINT (args[4]) - 1;
+ tm.tm_year = XINT (args[5]) - 1900;
tm.tm_isdst = -1;
if (CONSP (zone))
char *tzstring;
char **oldenv = environ, **newenv;
- if (STRINGP (zone))
+ if (zone == Qt)
+ tzstring = "UTC0";
+ else if (STRINGP (zone))
tzstring = (char *) XSTRING (zone)->data;
else if (INTEGERP (zone))
{
return build_string (buf);
}
-#define TM_YEAR_ORIGIN 1900
+#define TM_YEAR_BASE 1900
-/* Yield A - B, measured in seconds. */
-static long
-difftm (a, b)
+/* Yield A - B, measured in seconds.
+ This function is copied from the GNU C Library. */
+static int
+tm_diff (a, b)
struct tm *a, *b;
{
- int ay = a->tm_year + (TM_YEAR_ORIGIN - 1);
- int by = b->tm_year + (TM_YEAR_ORIGIN - 1);
- /* Some compilers can't handle this as a single return statement. */
- long days = (
- /* difference in day of year */
- a->tm_yday - b->tm_yday
- /* + intervening leap days */
- + ((ay >> 2) - (by >> 2))
- - (ay/100 - by/100)
- + ((ay/100 >> 2) - (by/100 >> 2))
- /* + difference in years * 365 */
- + (long)(ay-by) * 365
- );
- return (60*(60*(24*days + (a->tm_hour - b->tm_hour))
- + (a->tm_min - b->tm_min))
+ /* Compute intervening leap days correctly even if year is negative.
+ Take care to avoid int overflow in leap day calculations,
+ but it's OK to assume that A and B are close to each other. */
+ int a4 = (a->tm_year >> 2) + (TM_YEAR_BASE >> 2) - ! (a->tm_year & 3);
+ int b4 = (b->tm_year >> 2) + (TM_YEAR_BASE >> 2) - ! (b->tm_year & 3);
+ int a100 = a4 / 25 - (a4 % 25 < 0);
+ int b100 = b4 / 25 - (b4 % 25 < 0);
+ int a400 = a100 >> 2;
+ int b400 = b100 >> 2;
+ int intervening_leap_days = (a4 - b4) - (a100 - b100) + (a400 - b400);
+ int years = a->tm_year - b->tm_year;
+ int days = (365 * years + intervening_leap_days
+ + (a->tm_yday - b->tm_yday));
+ return (60 * (60 * (24 * days + (a->tm_hour - b->tm_hour))
+ + (a->tm_min - b->tm_min))
+ (a->tm_sec - b->tm_sec));
}
&& (t = gmtime (&value)) != 0)
{
struct tm gmt;
- long offset;
+ int offset;
char *s, buf[6];
gmt = *t; /* Make a copy, in case localtime modifies *t. */
t = localtime (&value);
- offset = difftm (t, &gmt);
+ offset = tm_diff (t, &gmt);
s = 0;
#ifdef HAVE_TM_ZONE
if (t->tm_zone)
DEFUN ("set-time-zone-rule", Fset_time_zone_rule, Sset_time_zone_rule, 1, 1, 0,
"Set the local time zone using TZ, a string specifying a time zone rule.\n\
-If TZ is nil, use implementation-defined default time zone information.")
+If TZ is nil, use implementation-defined default time zone information.\n\
+If TZ is t, use Universal Time.")
(tz)
Lisp_Object tz;
{
if (NILP (tz))
tzstring = 0;
+ else if (tz == Qt)
+ tzstring = "UTC0";
else
{
CHECK_STRING (tz, 0);
return Qnil;
}
+/* These two values are known to load tz files in buggy implementations.
+ Their values shouldn't matter in non-buggy implementations.
+ We don't use string literals for these strings,
+ since if a string in the environment is in readonly
+ storage, it runs afoul of bugs in SVR4 and Solaris 2.3.
+ See Sun bugs 1113095 and 1114114, ``Timezone routines
+ improperly modify environment''. */
+
+static char set_time_zone_rule_tz1[] = "TZ=GMT0";
+static char set_time_zone_rule_tz2[] = "TZ=GMT1";
+
/* Set the local time zone rule to TZSTRING.
This allocates memory into `environ', which it is the caller's
responsibility to free. */
int envptrs;
char **from, **to, **newenv;
+ /* Make the ENVIRON vector longer with room for TZSTRING. */
for (from = environ; *from; from++)
continue;
envptrs = from - environ + 2;
newenv = to = (char **) xmalloc (envptrs * sizeof (char *)
+ (tzstring ? strlen (tzstring) + 4 : 0));
+
+ /* Add TZSTRING to the end of environ, as a value for TZ. */
if (tzstring)
{
char *t = (char *) (to + envptrs);
*to++ = t;
}
+ /* Copy the old environ vector elements into NEWENV,
+ but don't copy the TZ variable.
+ So we have only one definition of TZ, which came from TZSTRING. */
for (from = environ; *from; from++)
if (strncmp (*from, "TZ=", 3) != 0)
*to++ = *from;
environ = newenv;
+ /* If we do have a TZSTRING, NEWENV points to the vector slot where
+ the TZ variable is stored. If we do not have a TZSTRING,
+ TO points to the vector slot which has the terminating null. */
+
#ifdef LOCALTIME_CACHE
+ {
+ /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like
+ "US/Pacific" that loads a tz file, then changes to a value like
+ "XXX0" that does not load a tz file, and then changes back to
+ its original value, the last change is (incorrectly) ignored.
+ Also, if TZ changes twice in succession to values that do
+ not load a tz file, tzset can dump core (see Sun bug#1225179).
+ The following code works around these bugs. */
+
+ if (tzstring)
+ {
+ /* Temporarily set TZ to a value that loads a tz file
+ and that differs from tzstring. */
+ char *tz = *newenv;
+ *newenv = (strcmp (tzstring, set_time_zone_rule_tz1 + 3) == 0
+ ? set_time_zone_rule_tz2 : set_time_zone_rule_tz1);
+ tzset ();
+ *newenv = tz;
+ }
+ else
+ {
+ /* The implied tzstring is unknown, so temporarily set TZ to
+ two different values that each load a tz file. */
+ *to = set_time_zone_rule_tz1;
+ to[1] = 0;
+ tzset ();
+ *to = set_time_zone_rule_tz2;
+ tzset ();
+ *to = 0;
+ }
+
+ /* Now TZ has the desired value, and tzset can be invoked safely. */
+ }
+
tzset ();
#endif
}
return Qnil;
}
-DEFUN ("insert-before-markers-and-inherit",
- Finsert_and_inherit_before_markers, Sinsert_and_inherit_before_markers,
- 0, MANY, 0,
+DEFUN ("insert-before-markers-and-inherit", Finsert_and_inherit_before_markers,
+ Sinsert_and_inherit_before_markers, 0, MANY, 0,
"Insert text at point, relocating markers and inheriting properties.\n\
Point moves forward so that it ends up after the inserted text.\n\
Any other markers at the point of insertion also end up after the text.")
if (NILP (buffer))
nsberror (buf);
bp = XBUFFER (buffer);
+ if (NILP (bp->name))
+ error ("Selecting deleted buffer");
if (NILP (start))
b = BUF_BEGV (bp);
{
register int begp1, endp1, begp2, endp2, temp, len1, len2, length, i;
register struct buffer *bp1, *bp2;
- register unsigned char *trt
+ register Lisp_Object *trt
= (!NILP (current_buffer->case_fold_search)
- ? XSTRING (current_buffer->case_canon_table)->data : 0);
+ ? XCHAR_TABLE (current_buffer->case_canon_table)->contents : 0);
/* Find the first buffer and its substring. */
if (NILP (buf1))
nsberror (buffer1);
bp1 = XBUFFER (buf1);
+ if (NILP (bp1->name))
+ error ("Selecting deleted buffer");
}
if (NILP (start1))
buf2 = Fget_buffer (buffer2);
if (NILP (buf2))
nsberror (buffer2);
- bp2 = XBUFFER (buffer2);
+ bp2 = XBUFFER (buf2);
+ if (NILP (bp2->name))
+ error ("Selecting deleted buffer");
}
if (NILP (start2))
BEGV = XFASTINT (start);
SET_BUF_ZV (current_buffer, XFASTINT (end));
- if (point < XFASTINT (start))
+ if (PT < XFASTINT (start))
SET_PT (XFASTINT (start));
- if (point > XFASTINT (end))
+ if (PT > XFASTINT (end))
SET_PT (XFASTINT (end));
current_buffer->clip_changed = 1;
/* Changing the buffer bounds invalidates any recorded current column. */
because it is the format string. */
strings[i++] = XSTRING (args[n])->data;
else
- strings[i++] = (unsigned char *) XFASTINT (args[n]);
+ strings[i++] = (unsigned char *) XSTRING (args[n]);
}
/* Make room in result for all the non-%-codes in the control string. */
of the buffer being accessed.");
Vbuffer_access_fontify_functions = Qnil;
+ {
+ Lisp_Object obuf;
+ extern Lisp_Object Vprin1_to_string_buffer;
+ obuf = Fcurrent_buffer ();
+ /* Do this here, because init_buffer_once is too early--it won't work. */
+ Fset_buffer (Vprin1_to_string_buffer);
+ /* Make sure buffer-access-fontify-functions is nil in this buffer. */
+ Fset (Fmake_local_variable (intern ("buffer-access-fontify-functions")),
+ Qnil);
+ Fset_buffer (obuf);
+ }
+
DEFVAR_LISP ("buffer-access-fontified-property",
&Vbuffer_access_fontified_property,
"Property which (if non-nil) indicates text has been fontified.\n\
/* defsubr (&Smark); */
/* defsubr (&Sset_mark); */
defsubr (&Ssave_excursion);
+ defsubr (&Ssave_current_buffer);
defsubr (&Sbufsize);
defsubr (&Spoint_max);
HCoop / bpt / emacs.git / blobdiff