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 1, or (at your option)
+the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Emacs is distributed in the hope that it will be useful,
/* Some static data, and a function to initialize it for each run */
Lisp_Object Vsystem_name;
-Lisp_Object Vuser_real_name; /* login name of current user ID */
-Lisp_Object Vuser_full_name; /* full name of current user */
-Lisp_Object Vuser_name; /* user name from LOGNAME or USER */
+Lisp_Object Vuser_real_login_name; /* login name of current user ID */
+Lisp_Object Vuser_full_name; /* full name of current user */
+Lisp_Object Vuser_login_name; /* user name from LOGNAME or USER */
void
init_editfns ()
/* We let the real user name default to "root" because that's quite
accurate on MSDOG and because it lets Emacs find the init file.
(The DVX libraries override the Djgpp libraries here.) */
- Vuser_real_name = build_string (pw ? pw->pw_name : "root");
+ Vuser_real_login_name = build_string (pw ? pw->pw_name : "root");
#else
- Vuser_real_name = build_string (pw ? pw->pw_name : "unknown");
+ Vuser_real_login_name = build_string (pw ? pw->pw_name : "unknown");
#endif
/* Get the effective user name, by consulting environment variables,
pw = (struct passwd *) getpwuid (geteuid ());
user_name = (char *) (pw ? pw->pw_name : "unknown");
}
- Vuser_name = build_string (user_name);
+ Vuser_login_name = build_string (user_name);
/* If the user name claimed in the environment vars differs from
the real uid, use the claimed name to find the full name. */
- tem = Fstring_equal (Vuser_name, Vuser_real_name);
+ tem = Fstring_equal (Vuser_login_name, Vuser_real_login_name);
if (NILP (tem))
- pw = (struct passwd *) getpwnam (XSTRING (Vuser_name)->data);
+ pw = (struct passwd *) getpwnam (XSTRING (Vuser_login_name)->data);
p = (unsigned char *) (pw ? USER_FULL_NAME : "unknown");
q = (unsigned char *) index (p, ',');
#ifdef AMPERSAND_FULL_NAME
p = XSTRING (Vuser_full_name)->data;
- q = (char *) index (p, '&');
+ q = (unsigned char *) index (p, '&');
/* Substitute the login name for the &, upcasing the first character. */
if (q)
{
- r = (char *) alloca (strlen (p) + XSTRING (Vuser_name)->size + 1);
+ r = (unsigned char *) alloca (strlen (p)
+ + XSTRING (Vuser_login_name)->size + 1);
bcopy (p, r, q - p);
r[q - p] = 0;
- strcat (r, XSTRING (Vuser_name)->data);
+ strcat (r, XSTRING (Vuser_login_name)->data);
r[q - p] = UPCASE (r[q - p]);
strcat (r, q + 1);
Vuser_full_name = build_string (r);
}
#endif /* AMPERSAND_FULL_NAME */
- p = getenv ("NAME");
+ p = (unsigned char *) getenv ("NAME");
if (p)
Vuser_full_name = build_string (p);
}
return (region_limit (0));
}
-#if 0 /* now in lisp code */
-DEFUN ("mark", Fmark, Smark, 0, 0, 0,
- "Return this buffer's mark value as integer, or nil if no mark.\n\
-If you are using this in an editing command, you are most likely making\n\
-a mistake; see the documentation of `set-mark'.")
- ()
-{
- return Fmarker_position (current_buffer->mark);
-}
-#endif /* commented out code */
-
DEFUN ("mark-marker", Fmark_marker, Smark_marker, 0, 0, 0,
"Return this buffer's mark, as a marker object.\n\
Watch out! Moving this marker changes the mark position.\n\
return current_buffer->mark;
}
-#if 0 /* this is now in lisp code */
-DEFUN ("set-mark", Fset_mark, Sset_mark, 1, 1, 0,
- "Set this buffer's mark to POS. Don't use this function!\n\
-That is to say, don't use this function unless you want\n\
-the user to see that the mark has moved, and you want the previous\n\
-mark position to be lost.\n\
-\n\
-Normally, when a new mark is set, the old one should go on the stack.\n\
-This is why most applications should use push-mark, not set-mark.\n\
-\n\
-Novice programmers often try to use the mark for the wrong purposes.\n\
-The mark saves a location for the user's convenience.\n\
-Most editing commands should not alter the mark.\n\
-To remember a location for internal use in the Lisp program,\n\
-store it in a Lisp variable. Example:\n\
-\n\
- (let ((beg (point))) (forward-line 1) (delete-region beg (point))).")
- (pos)
- Lisp_Object pos;
-{
- if (NILP (pos))
- {
- current_buffer->mark = Qnil;
- return Qnil;
- }
- CHECK_NUMBER_COERCE_MARKER (pos, 0);
-
- if (NILP (current_buffer->mark))
- current_buffer->mark = Fmake_marker ();
-
- Fset_marker (current_buffer->mark, pos, Qnil);
- return pos;
-}
-#endif /* commented-out code */
-
Lisp_Object
save_excursion_save ()
{
== current_buffer);
return Fcons (Fpoint_marker (),
- Fcons (Fcopy_marker (current_buffer->mark),
+ Fcons (Fcopy_marker (current_buffer->mark, Qnil),
Fcons (visible ? Qt : Qnil,
current_buffer->mark_active)));
}
/* Set up the user name info if we didn't do it before.
(That can happen if Emacs is dumpable
but you decide to run `temacs -l loadup' and not dump. */
- if (INTEGERP (Vuser_name))
+ if (INTEGERP (Vuser_login_name))
init_editfns ();
if (NILP (uid))
- return Vuser_name;
+ return Vuser_login_name;
CHECK_NUMBER (uid, 0);
pw = (struct passwd *) getpwuid (XINT (uid));
/* Set up the user name info if we didn't do it before.
(That can happen if Emacs is dumpable
but you decide to run `temacs -l loadup' and not dump. */
- if (INTEGERP (Vuser_name))
+ if (INTEGERP (Vuser_login_name))
init_editfns ();
- return Vuser_real_name;
+ return Vuser_real_login_name;
}
DEFUN ("user-uid", Fuser_uid, Suser_uid, 0, 0, 0,
The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED)\n\
or (HIGH . LOW), as from `current-time' and `file-attributes', or `nil'\n\
to use the current time. The list has the following nine members:\n\
-SEC is an integer between 0 and 59. MINUTE is an integer between 0 and 59.\n\
+SEC is an integer between 0 and 60; SEC is 60 for a leap second, which\n\
+only some operating systems support. MINUTE is an integer between 0 and 59.\n\
HOUR is an integer between 0 and 23. DAY is an integer between 1 and 31.\n\
MONTH is an integer between 1 and 12. YEAR is an integer indicating the\n\
four-digit year. DOW is the day of week, an integer between 0 and 6, where\n\
0 is Sunday. DST is t if daylight savings time is effect, otherwise nil.\n\
ZONE is an integer indicating the number of seconds east of Greenwich.\n\
-(Note that Common Lisp has different meanings for DOW and ZONE.)")
+\(Note that Common Lisp has different meanings for DOW and ZONE.)")
(specified_time)
Lisp_Object specified_time;
{
return Flist (9, list_args);
}
+static char days_per_month[11]
+ = { 31, 30, 31, 30, 31, 31, 30, 31, 30, 31, 31 };
+
DEFUN ("encode-time", Fencode_time, Sencode_time, 6, 7, 0,
- "Convert SEC, MIN, HOUR, DAY, MONTH, YEAR and ZONE to internal time.\n\
-This is the reverse operation of `decode-time', which see. ZONE defaults
-to the current time zone and daylight savings time if not specified; if
-specified, it can be either a list (as from `current-time-zone') or an
-integer (as from `decode-time'), and is applied without consideration for
-daylight savings time. If YEAR is less than 100, values in the range 0 to
-37 are interpreted as in the 21st century, all other values arein the 20th
-century.")
- (sec, min, hour, day, month, year, zone)
- Lisp_Object sec, min, hour, day, month, year, zone;
-{
- double universal;
- int fullyear, mon;
- static char days[11] = { 31, 30, 31, 30, 31, 31, 30, 31, 30, 31, 31 };
+ "Convert SEC, 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 and daylight savings time if not specified; if\n\
+specified, it can be either a list (as from `current-time-zone') or an\n\
+integer (as from `decode-time'), and is applied without consideration for\n\
+daylight savings time.\n\
+Year numbers less than 100 are treated just like other year numbers.\n\
+If you want them to stand for years above 1900, you must do that yourself.")
+ (sec, minute, hour, day, month, year, zone)
+ Lisp_Object sec, minute, hour, day, month, year, zone;
+{
+ time_t time;
+ int fullyear, mon, days, seconds, tz = 0;
CHECK_NATNUM (sec, 0);
- CHECK_NATNUM (min, 1);
+ CHECK_NATNUM (minute, 1);
CHECK_NATNUM (hour, 2);
CHECK_NATNUM (day, 3);
CHECK_NATNUM (month, 4);
CHECK_NATNUM (year, 5);
fullyear = XINT (year);
- if (fullyear < 100)
- {
- if (fullyear < 38) /* end of time: 2038-01-19 03:14:08 */
- fullyear += 2000;
- else
- fullyear += 1900;
- }
- if (NILP (zone))
- zone = Fcurrent_time_zone (Qnil);
- if (CONSP (zone))
- zone = Fcar (zone);
-
- CHECK_NUMBER (zone, 6);
-
- /* all of these should evaluate to compile-time constants. */
-#define MIN 60.0 /* 60 */
-#define HOUR (60*MIN) /* 3600 */
-#define DAY (24*HOUR) /* 86400 */
-#define YEAR (365*DAY) /* 31536000 */
-#define YEAR4 (4*YEAR+DAY) /* 126230400 */
-#define YEAR100 (25*YEAR4-DAY) /* 3155673600 */
-#define YEAR400 (4*YEAR100+DAY) /* 12622780800 */
-#define YEAR1900 (4*YEAR400+3*YEAR100) /* 59958144000 */
-#define YEAR1970 (YEAR1900+17*YEAR4+2*YEAR) /* 62167132800 */
-#define LEAPBIAS (59*DAY) /* 5097600 */
-
- mon = XINT (month) - 1;
- fullyear--;
- mon += 10;
- fullyear += mon/12;
+ /* Adjust incoming datespec to epoch = March 1, year 0.
+ The "date" March 1, year 0, is an abstraction used purely for its
+ computational convenience; year 0 never existed. */
+ mon = XINT (month) - 1 + 10;
+ fullyear += mon/12 - 1;
mon %= 12;
- universal = XINT (sec) + XINT (min) * MIN + XINT (hour) * HOUR;
- while (mon-- > 0)
- universal += days[mon] * DAY;
- universal += (XINT (day) - 1) * DAY;
- universal += YEAR400 * (fullyear/400);
+ days = XINT (day) - 1; /* day of month */
+ while (mon-- > 0) /* day of year */
+ days += days_per_month[mon];
+ days += 146097 * (fullyear/400); /* 400 years = 146097 days */
fullyear %= 400;
- universal += YEAR100 * (fullyear/100);
+ days += 36524 * (fullyear/100); /* 100 years = 36524 days */
fullyear %= 100;
- universal += YEAR4 * (fullyear/4);
+ days += 1461 * (fullyear/4); /* 4 years = 1461 days */
fullyear %= 4;
- universal += YEAR * fullyear;
- universal -= YEAR1970 - LEAPBIAS;
+ days += 365 * fullyear; /* 1 year = 365 days */
+
+ /* Adjust computed datespec to epoch = January 1, 1970. */
+ days += 59; /* March 1 is 59th day. */
+ days -= 719527; /* 1970 years = 719527 days */
+
+ seconds = XINT (sec) + 60 * XINT (minute) + 3600 * XINT (hour);
+
+ if (sizeof (time_t) == 4
+ && ((days+(seconds/86400) > 24854) || (days+(seconds/86400) < -24854)))
+ error ("the specified time is outside the representable range");
- return make_time ((int)(universal - XINT (zone)));
+ time = days * 86400 + seconds;
-#undef MIN
-#undef HOUR
-#undef DAY
-#undef YEAR
-#undef YEAR4
-#undef YEAR100
-#undef YEAR400
-#undef YEAR1900
-#undef YEAR1970
-#undef LEAPBIAS
+ /* We have the correct value for UTC. Adjust for timezones. */
+ if (NILP (zone))
+ {
+ struct tm gmt, *t;
+ time_t adjusted_time;
+ int adjusted_tz;
+ /* If the system does not use timezones, gmtime returns 0, and we
+ already have the correct value, by definition. */
+ if ((t = gmtime (&time)) != 0)
+ {
+ gmt = *t;
+ t = localtime (&time);
+ tz = difftm (t, &gmt);
+ /* The timezone returned is that at the specified Universal Time,
+ not the local time, which is what we want. Adjust, repeat. */
+ adjusted_time = time - tz;
+ gmt = *gmtime (&adjusted_time); /* this is safe now */
+ t = localtime (&adjusted_time);
+ adjusted_tz = difftm (t, &gmt);
+ /* In case of discrepancy, adjust again for extra accuracy. */
+ if (adjusted_tz != tz)
+ {
+ adjusted_time = time - adjusted_tz;
+ gmt = *gmtime (&adjusted_time);
+ t = localtime (&adjusted_time);
+ adjusted_tz = difftm (t, &gmt);
+ }
+ tz = adjusted_tz;
+ }
+ }
+ else
+ {
+ if (CONSP (zone))
+ zone = Fcar (zone);
+ CHECK_NUMBER (zone, 6);
+ tz = XINT (zone);
+ }
+
+ return make_time (time - tz);
}
DEFUN ("current-time-string", Fcurrent_time_string, Scurrent_time_string, 0, 1, 0,
return current_buffer->undo_list = arg;
}
+static Lisp_Object
+subst_char_in_region_unwind_1 (arg)
+ Lisp_Object arg;
+{
+ return current_buffer->filename = arg;
+}
+
DEFUN ("subst-char-in-region", Fsubst_char_in_region,
Ssubst_char_in_region, 4, 5, 0,
"From START to END, replace FROMCHAR with TOCHAR each time it occurs.\n\
/* If we don't want undo, turn off putting stuff on the list.
That's faster than getting rid of things,
- and it prevents even the entry for a first change. */
+ and it prevents even the entry for a first change.
+ Also inhibit locking the file. */
if (!NILP (noundo))
{
record_unwind_protect (subst_char_in_region_unwind,
current_buffer->undo_list);
current_buffer->undo_list = Qt;
+ /* Don't do file-locking. */
+ record_unwind_protect (subst_char_in_region_unwind_1,
+ current_buffer->filename);
+ current_buffer->filename = Qnil;
}
while (pos < stop)
{
BEGV = BEG;
SET_BUF_ZV (current_buffer, Z);
- clip_changed = 1;
+ current_buffer->clip_changed = 1;
/* Changing the buffer bounds invalidates any recorded current column. */
invalidate_current_column ();
return Qnil;
SET_PT (XFASTINT (b));
if (point > XFASTINT (e))
SET_PT (XFASTINT (e));
- clip_changed = 1;
+ current_buffer->clip_changed = 1;
/* Changing the buffer bounds invalidates any recorded current column. */
invalidate_current_column ();
return Qnil;
}
BUF_BEGV (buf) = BUF_BEG (buf) + newhead;
SET_BUF_ZV (buf, BUF_Z (buf) - newtail);
- clip_changed = 1;
+ current_buffer->clip_changed = 1;
/* If point is outside the new visible range, move it inside. */
SET_BUF_PT (buf,
DEFUN ("message", Fmessage, Smessage, 1, MANY, 0,
"Print a one-line message at the bottom of the screen.\n\
-The first argument is a control string.\n\
-It may contain %s or %d or %c to print successive following arguments.\n\
-%s means print an argument as a string, %d means print as number in decimal,\n\
-%c means print a number as a single character.\n\
-The argument used by %s must be a string or a symbol;\n\
-the argument used by %d or %c must be a number.\n\
+The first argument is a format control string, and the rest are data\n\
+to be formatted under control of the string. See `format' for details.\n\
+\n\
If the first argument is nil, clear any existing message; let the\n\
minibuffer contents show.")
(nargs, args)
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\
+%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\
+ or decimal-point notation, whichever uses fewer characters.\n\
%c means print a number as a single character.\n\
%S means print any object as an s-expression (using prin1).\n\
- The argument used for %d, %o, %x or %c must be a number.\n\
+ The argument used for %d, %o, %x, %e, %f, %g or %c must be a number.\n\
Use %% to put a single % into the output.")
(nargs, args)
int nargs;
/* Process a numeric arg and skip it. */
minlen = atoi (format);
- if (minlen > 0)
- total += minlen;
- else
- total -= minlen;
+ if (minlen < 0)
+ minlen = - minlen;
+
while ((*format >= '0' && *format <= '9')
|| *format == '-' || *format == ' ' || *format == '.')
format++;
if (*format == '%')
format++;
else if (++n >= nargs)
- error ("not enough arguments for format string");
+ error ("Not enough arguments for format string");
else if (*format == 'S')
{
/* For `S', prin1 the argument and then treat like a string. */
if (*format != 's' && *format != 'S')
error ("format specifier doesn't match argument type");
total += XSTRING (args[n])->size;
+ /* We have to put an arbitrary limit on minlen
+ since otherwise it could make alloca fail. */
+ if (minlen < XSTRING (args[n])->size + 1000)
+ total += minlen;
}
/* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */
else if (INTEGERP (args[n]) && *format != 's')
if (*format == 'e' || *format == 'f' || *format == 'g')
args[n] = Ffloat (args[n]);
#endif
- total += 10;
+ total += 30;
+ /* We have to put an arbitrary limit on minlen
+ since otherwise it could make alloca fail. */
+ if (minlen < 1000)
+ total += minlen;
}
#ifdef LISP_FLOAT_TYPE
else if (FLOATP (args[n]) && *format != 's')
{
if (! (*format == 'e' || *format == 'f' || *format == 'g'))
args[n] = Ftruncate (args[n]);
- total += 20;
+ total += 30;
+ /* We have to put an arbitrary limit on minlen
+ since otherwise it could make alloca fail. */
+ if (minlen < 1000)
+ total += minlen;
}
#endif
else
#ifdef LISP_FLOAT_TYPE
else if (FLOATP (args[n]))
{
- union { double d; int half[2]; } u;
+ union { double d; char *half[2]; } u;
u.d = XFLOAT (args[n])->data;
- strings[i++] = (unsigned char *) (EMACS_INT) u.half[0];
- strings[i++] = (unsigned char *) (EMACS_INT) u.half[1];
+ strings[i++] = (unsigned char *) u.half[0];
+ strings[i++] = (unsigned char *) u.half[1];
}
#endif
else
strings[i++] = XSTRING (args[n])->data;
}
+ /* Make room in result for all the non-%-codes in the control string. */
+ total += XSTRING (args[0])->size;
+
/* Format it in bigger and bigger buf's until it all fits. */
while (1)
{
args[2] = arg2;
args[3] = arg3;
args[4] = arg4;
- doprnt (buf, sizeof buf, string1, 0, 5, args);
+ doprnt (buf, sizeof buf, string1, (char *)0, 5, args);
#else
- doprnt (buf, sizeof buf, string1, 0, 5, &string1 + 1);
+ doprnt (buf, sizeof buf, string1, (char *)0, 5, &string1 + 1);
#endif
return build_string (buf);
}
DEFVAR_LISP ("user-full-name", &Vuser_full_name,
"The full name of the user logged in.");
- DEFVAR_LISP ("user-name", &Vuser_name,
+ DEFVAR_LISP ("user-login-name", &Vuser_login_name,
"The user's name, taken from environment variables if possible.");
- DEFVAR_LISP ("user-real-name", &Vuser_real_name,
+ DEFVAR_LISP ("user-real-login-name", &Vuser_real_login_name,
"The user's name, based upon the real uid only.");
defsubr (&Schar_equal);
HCoop / bpt / emacs.git / blobdiff