/* Random utility Lisp functions.
- Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1986, 1987, 1993 Free Software Foundation, Inc.
This file is part of GNU Emacs.
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
-#include "config.h"
-
-#ifdef LOAD_AVE_TYPE
-#ifdef BSD
-/* It appears param.h defines BSD and BSD4_3 in 4.3
- and is not considerate enough to avoid bombing out
- if they are already defined. */
-#undef BSD
-#ifdef BSD4_3
-#undef BSD4_3
-#define XBSD4_3 /* XBSD4_3 says BSD4_3 is supposed to be defined. */
-#endif
-#include <sys/param.h>
-/* Now if BSD or BSD4_3 was defined and is no longer,
- define it again. */
-#ifndef BSD
-#define BSD
-#endif
-#ifdef XBSD4_3
-#ifndef BSD4_3
-#define BSD4_3
-#endif
-#endif /* XBSD4_3 */
-#endif /* BSD */
-#ifndef VMS
-#ifndef NLIST_STRUCT
-#include <a.out.h>
-#else /* NLIST_STRUCT */
-#include <nlist.h>
-#endif /* NLIST_STRUCT */
-#endif /* not VMS */
-#endif /* LOAD_AVE_TYPE */
-
-#ifdef DGUX
-#include <sys/dg_sys_info.h> /* for load average info - DJB */
-#endif
+#include <config.h>
/* Note on some machines this defines `vector' as a typedef,
so make sure we don't use that name in this file. */
#undef vector
#define vector *****
-#ifdef NULL
-#undef NULL
-#endif
#include "lisp.h"
#include "commands.h"
-#ifdef MULTI_SCREEN
-#include "screen.h"
-#endif
-
#include "buffer.h"
+#include "keyboard.h"
+#include "intervals.h"
-Lisp_Object Qstring_lessp;
+Lisp_Object Qstring_lessp, Qprovide, Qrequire;
+Lisp_Object Qyes_or_no_p_history;
static Lisp_Object internal_equal ();
\f
This is 24 bits' worth.\n\
With argument N, return random number in interval [0,N).\n\
With argument t, set the random number seed from the current time and pid.")
- (arg)
- Lisp_Object arg;
+ (limit)
+ Lisp_Object limit;
{
int val;
extern long random ();
extern srandom ();
extern long time ();
- if (EQ (arg, Qt))
+ if (EQ (limit, Qt))
srandom (getpid () + time (0));
val = random ();
- if (XTYPE (arg) == Lisp_Int && XINT (arg) != 0)
+ if (XTYPE (limit) == Lisp_Int && XINT (limit) != 0)
{
/* Try to take our random number from the higher bits of VAL,
not the lower, since (says Gentzel) the low bits of `random'
are less random than the higher ones. */
val &= 0xfffffff; /* Ensure positive. */
val >>= 5;
- if (XINT (arg) < 10000)
+ if (XINT (limit) < 10000)
val >>= 6;
- val %= XINT (arg);
+ val %= XINT (limit);
}
return make_number (val);
}
return Farray_length (obj);
else if (CONSP (obj))
{
- for (i = 0, tail = obj; !NULL(tail); i++)
+ for (i = 0, tail = obj; !NILP(tail); i++)
{
QUIT;
tail = Fcdr (tail);
XFASTINT (val) = i;
return val;
}
- else if (NULL(obj))
+ else if (NILP(obj))
{
XFASTINT (val) = 0;
return val;
"Concatenate all the arguments and make the result a list.\n\
The result is a list whose elements are the elements of all the arguments.\n\
Each argument may be a list, vector or string.\n\
-The last argument is not copied if it is a list.")
+The last argument is not copied, just used as the tail of the new list.")
(nargs, args)
int nargs;
Lisp_Object *args;
DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0,
"Concatenate all the arguments and make the result a string.\n\
The result is a string whose elements are the elements of all the arguments.\n\
-Each argument may be a string, a list of numbers, or a vector of numbers.")
+Each argument may be a string, a list of characters (integers),\n\
+or a vector of characters (integers).")
(nargs, args)
int nargs;
Lisp_Object *args;
(arg)
Lisp_Object arg;
{
- if (NULL (arg)) return arg;
+ if (NILP (arg)) return arg;
if (!CONSP (arg) && XTYPE (arg) != Lisp_Vector && XTYPE (arg) != Lisp_String)
arg = wrong_type_argument (Qsequencep, arg);
return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0);
for (argnum = 0; argnum < nargs; argnum++)
{
this = args[argnum];
- if (!(CONSP (this) || NULL (this)
+ if (!(CONSP (this) || NILP (this)
|| XTYPE (this) == Lisp_Vector || XTYPE (this) == Lisp_String
|| XTYPE (this) == Lisp_Compiled))
{
if (XTYPE (this) == Lisp_Int)
- args[argnum] = Fint_to_string (this);
+ args[argnum] = Fnumber_to_string (this);
else
args[argnum] = wrong_type_argument (Qsequencep, this);
}
if (!CONSP (this))
thislen = Flength (this), thisleni = XINT (thislen);
+ if (XTYPE (this) == Lisp_String && XTYPE (val) == Lisp_String
+ && ! NULL_INTERVAL_P (XSTRING (this)->intervals))
+ {
+ copy_text_properties (make_number (0), thislen, this,
+ make_number (toindex), val, Qnil);
+ }
+
while (1)
{
register Lisp_Object elt;
- /* Fetch next element of `this' arg into `elt', or break if `this' is exhausted. */
- if (NULL (this)) break;
+ /* Fetch next element of `this' arg into `elt', or break if
+ `this' is exhausted. */
+ if (NILP (this)) break;
if (CONSP (this))
elt = Fcar (this), this = Fcdr (this);
else
}
}
}
- if (!NULL (prev))
+ if (!NILP (prev))
XCONS (prev)->cdr = last_tail;
return val;
register Lisp_Object tem;
CHECK_LIST (alist, 0);
- if (NULL (alist))
+ if (NILP (alist))
return alist;
alist = concat (1, &alist, Lisp_Cons, 0);
for (tem = alist; CONSP (tem); tem = XCONS (tem)->cdr)
Lisp_Object string;
register Lisp_Object from, to;
{
+ Lisp_Object res;
+
CHECK_STRING (string, 0);
CHECK_NUMBER (from, 1);
- if (NULL (to))
+ if (NILP (to))
to = Flength (string);
else
CHECK_NUMBER (to, 2);
&& XINT (to) <= XSTRING (string)->size))
args_out_of_range_3 (string, from, to);
- return make_string (XSTRING (string)->data + XINT (from),
- XINT (to) - XINT (from));
+ res = make_string (XSTRING (string)->data + XINT (from),
+ XINT (to) - XINT (from));
+ copy_text_properties (from, to, string, make_number (0), res, Qnil);
+ return res;
}
\f
DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
register int i, num;
CHECK_NUMBER (n, 0);
num = XINT (n);
- for (i = 0; i < num && !NULL (list); i++)
+ for (i = 0; i < num && !NILP (list); i++)
{
QUIT;
list = Fcdr (list);
CHECK_NUMBER (n, 0);
while (1)
{
- if (XTYPE (seq) == Lisp_Cons || NULL (seq))
+ if (XTYPE (seq) == Lisp_Cons || NILP (seq))
return Fcar (Fnthcdr (n, seq));
else if (XTYPE (seq) == Lisp_String
|| XTYPE (seq) == Lisp_Vector)
Lisp_Object list;
{
register Lisp_Object tail;
- for (tail = list; !NULL (tail); tail = Fcdr (tail))
+ for (tail = list; !NILP (tail); tail = Fcdr (tail))
{
register Lisp_Object tem;
tem = Fcar (tail);
- if (! NULL (Fequal (elt, tem)))
+ if (! NILP (Fequal (elt, tem)))
return tail;
QUIT;
}
Lisp_Object list;
{
register Lisp_Object tail;
- for (tail = list; !NULL (tail); tail = Fcdr (tail))
+ for (tail = list; !NILP (tail); tail = Fcdr (tail))
{
register Lisp_Object tem;
tem = Fcar (tail);
}
DEFUN ("assq", Fassq, Sassq, 2, 2, 0,
- "Return non-nil if ELT is `eq' to the car of an element of LIST.\n\
-The value is actually the element of LIST whose car is ELT.\n\
+ "Return non-nil if KEY is `eq' to the car of an element of LIST.\n\
+The value is actually the element of LIST whose car is KEY.\n\
Elements of LIST that are not conses are ignored.")
(key, list)
register Lisp_Object key;
Lisp_Object list;
{
register Lisp_Object tail;
- for (tail = list; !NULL (tail); tail = Fcdr (tail))
+ for (tail = list; !NILP (tail); tail = Fcdr (tail))
{
register Lisp_Object elt, tem;
elt = Fcar (tail);
}
DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
- "Return non-nil if ELT is `equal' to the car of an element of LIST.\n\
-The value is actually the element of LIST whose car is ELT.")
+ "Return non-nil if KEY is `equal' to the car of an element of LIST.\n\
+The value is actually the element of LIST whose car is KEY.")
(key, list)
register Lisp_Object key;
Lisp_Object list;
{
register Lisp_Object tail;
- for (tail = list; !NULL (tail); tail = Fcdr (tail))
+ for (tail = list; !NILP (tail); tail = Fcdr (tail))
{
register Lisp_Object elt, tem;
elt = Fcar (tail);
if (!CONSP (elt)) continue;
tem = Fequal (Fcar (elt), key);
- if (!NULL (tem)) return elt;
+ if (!NILP (tem)) return elt;
QUIT;
}
return Qnil;
Lisp_Object list;
{
register Lisp_Object tail;
- for (tail = list; !NULL (tail); tail = Fcdr (tail))
+ for (tail = list; !NILP (tail); tail = Fcdr (tail))
{
register Lisp_Object elt, tem;
elt = Fcar (tail);
tail = list;
prev = Qnil;
- while (!NULL (tail))
+ while (!NILP (tail))
{
tem = Fcar (tail);
if (EQ (elt, tem))
{
- if (NULL (prev))
+ if (NILP (prev))
list = Fcdr (tail);
else
Fsetcdr (prev, Fcdr (tail));
return list;
}
-DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0,
+DEFUN ("delete", Fdelete, Sdelete, 2, 2, 0,
"Delete by side effect any occurrences of ELT as a member of LIST.\n\
The modified LIST is returned. Comparison is done with `equal'.\n\
If the first member of LIST is ELT, there is no way to remove it by side effect;\n\
tail = list;
prev = Qnil;
- while (!NULL (tail))
+ while (!NILP (tail))
{
tem = Fcar (tail);
- if (Fequal (elt, tem))
+ if (! NILP (Fequal (elt, tem)))
{
- if (NULL (prev))
+ if (NILP (prev))
list = Fcdr (tail);
else
Fsetcdr (prev, Fcdr (tail));
{
register Lisp_Object prev, tail, next;
- if (NULL (list)) return list;
+ if (NILP (list)) return list;
prev = Qnil;
tail = list;
- while (!NULL (tail))
+ while (!NILP (tail))
{
QUIT;
next = Fcdr (tail);
while (1)
{
- if (NULL (l1))
+ if (NILP (l1))
{
UNGCPRO;
- if (NULL (tail))
+ if (NILP (tail))
return l2;
Fsetcdr (tail, l2);
return value;
}
- if (NULL (l2))
+ if (NILP (l2))
{
UNGCPRO;
- if (NULL (tail))
+ if (NILP (tail))
return l1;
Fsetcdr (tail, l1);
return value;
}
tem = call2 (pred, Fcar (l2), Fcar (l1));
- if (NULL (tem))
+ if (NILP (tem))
{
tem = l1;
l1 = Fcdr (l1);
l2 = Fcdr (l2);
org_l2 = l2;
}
- if (NULL (tail))
+ if (NILP (tail))
value = tem;
else
Fsetcdr (tail, tem);
register Lisp_Object prop;
{
register Lisp_Object tail;
- for (tail = Fsymbol_plist (sym); !NULL (tail); tail = Fcdr (Fcdr (tail)))
+ for (tail = Fsymbol_plist (sym); !NILP (tail); tail = Fcdr (Fcdr (tail)))
{
register Lisp_Object tem;
tem = Fcar (tail);
register Lisp_Object tail, prev;
Lisp_Object newcell;
prev = Qnil;
- for (tail = Fsymbol_plist (sym); !NULL (tail); tail = Fcdr (Fcdr (tail)))
+ for (tail = Fsymbol_plist (sym); !NILP (tail); tail = Fcdr (Fcdr (tail)))
{
register Lisp_Object tem;
tem = Fcar (tail);
prev = tail;
}
newcell = Fcons (prop, Fcons (val, Qnil));
- if (NULL (prev))
+ if (NILP (prev))
Fsetplist (sym, newcell);
else
Fsetcdr (Fcdr (prev), newcell);
They must have the same data type.\n\
Conses are compared by comparing the cars and the cdrs.\n\
Vectors and strings are compared element by element.\n\
-Numbers are compared by value. Symbols must match exactly.")
+Numbers are compared by value, but integers cannot equal floats.\n\
+ (Use `=' if you want integers and floats to be able to be equal.)\n\
+Symbols must match exactly.")
(o1, o2)
register Lisp_Object o1, o2;
{
error ("Stack overflow in equal");
do_cdr:
QUIT;
+ if (EQ (o1, o2)) return Qt;
+#ifdef LISP_FLOAT_TYPE
+ if (FLOATP (o1) && FLOATP (o2))
+ return (extract_float (o1) == extract_float (o2)) ? Qt : Qnil;
+#endif
if (XTYPE (o1) != XTYPE (o2)) return Qnil;
- if (XINT (o1) == XINT (o2)) return Qt;
- if (XTYPE (o1) == Lisp_Cons)
+ if (XTYPE (o1) == Lisp_Cons
+ || XTYPE (o1) == Lisp_Overlay)
{
Lisp_Object v1;
- v1 = Fequal (Fcar (o1), Fcar (o2), depth + 1);
- if (NULL (v1))
+ v1 = internal_equal (Fcar (o1), Fcar (o2), depth + 1);
+ if (NILP (v1))
return v1;
o1 = Fcdr (o1), o2 = Fcdr (o2);
goto do_cdr;
}
if (XTYPE (o1) == Lisp_Marker)
{
- return (XMARKER (o1)->buffer == XMARKER (o2)->buffer
- && XMARKER (o1)->bufpos == XMARKER (o2)->bufpos)
- ? Qt : Qnil;
+ return ((XMARKER (o1)->buffer == XMARKER (o2)->buffer
+ && (XMARKER (o1)->buffer == 0
+ || XMARKER (o1)->bufpos == XMARKER (o2)->bufpos))
+ ? Qt : Qnil);
}
- if (XTYPE (o1) == Lisp_Vector)
+ if (XTYPE (o1) == Lisp_Vector
+ || XTYPE (o1) == Lisp_Compiled)
{
register int index;
if (XVECTOR (o1)->size != XVECTOR (o2)->size)
Lisp_Object v, v1, v2;
v1 = XVECTOR (o1)->contents [index];
v2 = XVECTOR (o2)->contents [index];
- v = Fequal (v1, v2, depth + 1);
- if (NULL (v)) return v;
+ v = internal_equal (v1, v2, depth + 1);
+ if (NILP (v)) return v;
}
return Qt;
}
for (argnum = 0; argnum < nargs; argnum++)
{
tem = args[argnum];
- if (NULL (tem)) continue;
+ if (NILP (tem)) continue;
- if (NULL (val))
+ if (NILP (val))
val = tem;
if (argnum + 1 == nargs) break;
tem = args[argnum + 1];
Fsetcdr (tail, tem);
- if (NULL (tem))
+ if (NILP (tem))
args[argnum + 1] = tail;
}
DEFUN ("mapconcat", Fmapconcat, Smapconcat, 3, 3, 0,
"Apply FN to each element of SEQ, and concat the results as strings.\n\
In between each pair of results, stick in SEP.\n\
-Thus, \" \" as SEP results in spaces between the values return by FN.")
+Thus, \" \" as SEP results in spaces between the values returned by FN.")
(fn, seq, sep)
Lisp_Object fn, seq, sep;
{
DEFUN ("y-or-n-p", Fy_or_n_p, Sy_or_n_p, 1, 1, 0,
"Ask user a \"y or n\" question. Return t if answer is \"y\".\n\
+Takes one argument, which is the string to display to ask the question.\n\
+It should end in a space; `y-or-n-p' adds `(y or n) ' to it.\n\
No confirmation of the answer is requested; a single character is enough.\n\
Also accepts Space to mean yes, or Delete to mean no.")
(prompt)
Lisp_Object prompt;
{
- register Lisp_Object obj;
- register int ans;
+ register Lisp_Object obj, key, def, answer_string, map;
+ register int answer;
Lisp_Object xprompt;
Lisp_Object args[2];
int ocech = cursor_in_echo_area;
struct gcpro gcpro1, gcpro2;
+ map = Fsymbol_value (intern ("query-replace-map"));
+
CHECK_STRING (prompt, 0);
xprompt = prompt;
GCPRO2 (prompt, xprompt);
while (1)
{
- message ("%s(y or n) ", XSTRING (xprompt)->data);
- cursor_in_echo_area = 1;
-
- obj = read_char (0);
- if (XTYPE (obj) == Lisp_Int)
- ans = XINT (obj);
+ if (NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
+ {
+ Lisp_Object pane, menu;
+ pane = Fcons (Fcons (build_string ("Yes"), Qt),
+ Fcons (Fcons (build_string ("No"), Qnil),
+ Qnil));
+ menu = Fcons (prompt, Fcons (Fcons (prompt, pane), Qnil));
+ obj = Fx_popup_menu (Qt, menu);
+ answer = !NILP (obj);
+ break;
+ }
else
- continue;
+ {
+ cursor_in_echo_area = 1;
+ message ("%s(y or n) ", XSTRING (xprompt)->data);
- cursor_in_echo_area = -1;
- message ("%s(y or n) %c", XSTRING (xprompt)->data, ans);
- cursor_in_echo_area = ocech;
- /* Accept a C-g or C-] (abort-recursive-edit) as quit requests. */
- if (ans == 7 || ans == '\035')
+ obj = read_filtered_event (1, 0, 0);
+ cursor_in_echo_area = 0;
+ /* If we need to quit, quit with cursor_in_echo_area = 0. */
+ QUIT;
+ }
+
+ key = Fmake_vector (make_number (1), obj);
+ def = Flookup_key (map, key);
+ answer_string = Fsingle_key_description (obj);
+
+ if (EQ (def, intern ("skip")))
+ {
+ answer = 0;
+ break;
+ }
+ else if (EQ (def, intern ("act")))
+ {
+ answer = 1;
+ break;
+ }
+ else if (EQ (def, intern ("recenter")))
+ {
+ Frecenter (Qnil);
+ xprompt = prompt;
+ continue;
+ }
+ else if (EQ (def, intern ("quit")))
Vquit_flag = Qt;
+
QUIT;
- if (ans >= 0)
- ans = DOWNCASE (ans);
- if (ans == 'y' || ans == ' ')
- { ans = 'y'; break; }
- if (ans == 'n' || ans == 127)
- break;
+
+ /* If we don't clear this, then the next call to read_char will
+ return quit_char again, and we'll enter an infinite loop. */
+ Vquit_flag = Qnil;
Fding (Qnil);
Fdiscard_input ();
}
}
UNGCPRO;
- return (ans == 'y' ? Qt : Qnil);
+
+ if (! noninteractive)
+ {
+ cursor_in_echo_area = -1;
+ message ("%s(y or n) %c", XSTRING (xprompt)->data, answer ? 'y' : 'n');
+ cursor_in_echo_area = ocech;
+ }
+
+ return answer ? Qt : Qnil;
}
\f
/* This is how C code calls `yes-or-no-p' and allows the user
/* Anything that calls this function must protect from GC! */
DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0,
- "Ask user a yes or no question. Return t if answer is yes.\n\
-The user must confirm the answer with a newline,\n\
-and can rub it out if not confirmed.")
+ "Ask user a yes-or-no question. Return t if answer is yes.\n\
+Takes one argument, which is the string to display to ask the question.\n\
+It should end in a space; `yes-or-no-p' adds `(yes or no) ' to it.\n\
+The user must confirm the answer with RET,\n\
+and can edit it until it as been confirmed.")
(prompt)
Lisp_Object prompt;
{
register Lisp_Object ans;
Lisp_Object args[2];
struct gcpro gcpro1;
+ Lisp_Object menu;
CHECK_STRING (prompt, 0);
+ if (NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
+ {
+ Lisp_Object pane, menu, obj;
+ pane = Fcons (Fcons (build_string ("Yes"), Qt),
+ Fcons (Fcons (build_string ("No"), Qnil),
+ Qnil));
+ GCPRO1 (pane);
+ menu = Fcons (prompt, Fcons (Fcons (prompt, pane), Qnil));
+ obj = Fx_popup_menu (Qt, menu);
+ if (!NILP (obj))
+ {
+ prompt = build_string ("Confirm");
+ menu = Fcons (prompt, Fcons (Fcons (prompt, pane), Qnil));
+ obj = Fx_popup_menu (Qt, menu);
+ }
+ UNGCPRO;
+ return obj;
+ }
+
args[0] = prompt;
args[1] = build_string ("(yes or no) ");
prompt = Fconcat (2, args);
GCPRO1 (prompt);
+
while (1)
{
- ans = Fdowncase (read_minibuf (Vminibuffer_local_map,
- Qnil, prompt, Qnil, 0));
+ ans = Fdowncase (Fread_from_minibuffer (prompt, Qnil, Qnil, Qnil,
+ Qyes_or_no_p_history));
if (XSTRING (ans)->size == 3 && !strcmp (XSTRING (ans)->data, "yes"))
{
UNGCPRO;
Fding (Qnil);
Fdiscard_input ();
message ("Please answer yes or no.");
- Fsleep_for (make_number (2));
+ Fsleep_for (make_number (2), Qnil);
}
- UNGCPRO;
}
\f
-/* Avoid static vars inside a function since in HPUX they dump as pure. */
-#ifdef DGUX
-static struct dg_sys_info_load_info load_info; /* what-a-mouthful! */
-
-#else /* Not DGUX */
-
-static int ldav_initialized;
-static int ldav_channel;
-#ifdef LOAD_AVE_TYPE
-#ifndef VMS
-static struct nlist ldav_nl[2];
-#endif /* VMS */
-#endif /* LOAD_AVE_TYPE */
-
-#define channel ldav_channel
-#define initialized ldav_initialized
-#define nl ldav_nl
-#endif /* Not DGUX */
-
DEFUN ("load-average", Fload_average, Sload_average, 0, 0, 0,
"Return list of 1 minute, 5 minute and 15 minute load averages.\n\
Each of the three load averages is multiplied by 100,\n\
-then converted to integer.")
+then converted to integer.\n\
+If the 5-minute or 15-minute load averages are not available, return a\n\
+shortened list, containing only those averages which are available.")
()
{
-#ifdef DGUX
- /* perhaps there should be a "sys_load_avg" call in sysdep.c?! - DJB */
- load_info.one_minute = 0.0; /* just in case there is an error */
- load_info.five_minute = 0.0;
- load_info.fifteen_minute = 0.0;
- dg_sys_info (&load_info, DG_SYS_INFO_LOAD_INFO_TYPE,
- DG_SYS_INFO_LOAD_VERSION_0);
-
- return Fcons (make_number ((int)(load_info.one_minute * 100.0)),
- Fcons (make_number ((int)(load_info.five_minute * 100.0)),
- Fcons (make_number ((int)(load_info.fifteen_minute * 100.0)),
- Qnil)));
-#else /* not DGUX */
-#ifndef LOAD_AVE_TYPE
- error ("load-average not implemented for this operating system");
-
-#else /* LOAD_AVE_TYPE defined */
-
- LOAD_AVE_TYPE load_ave[3];
-#ifdef VMS
-#ifndef eunice
-#include <iodef.h>
-#include <descrip.h>
-#else
-#include <vms/iodef.h>
- struct {int dsc$w_length; char *dsc$a_pointer;} descriptor;
-#endif /* eunice */
-#endif /* VMS */
-
- /* If this fails for any reason, we can return (0 0 0) */
- load_ave[0] = 0.0; load_ave[1] = 0.0; load_ave[2] = 0.0;
-
-#ifdef VMS
- /*
- * VMS specific code -- read from the Load Ave driver
- */
-
- /*
- * Ensure that there is a channel open to the load ave device
- */
- if (initialized == 0)
- {
- /* Attempt to open the channel */
-#ifdef eunice
- descriptor.size = 18;
- descriptor.ptr = "$$VMS_LOAD_AVERAGE";
-#else
- $DESCRIPTOR(descriptor, "LAV0:");
-#endif
- if (sys$assign (&descriptor, &channel, 0, 0) & 1)
- initialized = 1;
- }
- /*
- * Read the load average vector
- */
- if (initialized)
- {
- if (!(sys$qiow (0, channel, IO$_READVBLK, 0, 0, 0,
- load_ave, 12, 0, 0, 0, 0)
- & 1))
- {
- sys$dassgn (channel);
- initialized = 0;
- }
- }
-#else /* not VMS */
- /*
- * 4.2BSD UNIX-specific code -- read _avenrun from /dev/kmem
- */
-
- /*
- * Make sure we have the address of _avenrun
- */
- if (nl[0].n_value == 0)
- {
- /*
- * Get the address of _avenrun
- */
-#ifndef NLIST_STRUCT
- strcpy (nl[0].n_name, LDAV_SYMBOL);
- nl[1].n_zeroes = 0;
-#else /* NLIST_STRUCT */
-#ifdef convex
- nl[0].n_un.n_name = LDAV_SYMBOL;
- nl[1].n_un.n_name = 0;
-#else /* not convex */
- nl[0].n_name = LDAV_SYMBOL;
- nl[1].n_name = 0;
-#endif /* not convex */
-#endif /* NLIST_STRUCT */
-
- nlist (KERNEL_FILE, nl);
-
-#ifdef FIXUP_KERNEL_SYMBOL_ADDR
- FIXUP_KERNEL_SYMBOL_ADDR (nl);
-#endif /* FIXUP_KERNEL_SYMBOL_ADDR */
- }
- /*
- * Make sure we have /dev/kmem open
- */
- if (initialized == 0)
- {
- /*
- * Open /dev/kmem
- */
- channel = open ("/dev/kmem", 0);
- if (channel >= 0) initialized = 1;
- }
- /*
- * If we can, get the load ave values
- */
- if ((nl[0].n_value != 0) && (initialized != 0))
- {
- /*
- * Seek to the correct address
- */
- lseek (channel, (long) nl[0].n_value, 0);
- if (read (channel, load_ave, sizeof load_ave)
- != sizeof(load_ave))
- {
- close (channel);
- initialized = 0;
- }
- }
-#endif /* not VMS */
-
- /*
- * Return the list of load average values
- */
- return Fcons (make_number (LOAD_AVE_CVT (load_ave[0])),
- Fcons (make_number (LOAD_AVE_CVT (load_ave[1])),
- Fcons (make_number (LOAD_AVE_CVT (load_ave[2])),
- Qnil)));
-#endif /* LOAD_AVE_TYPE */
-#endif /* not DGUX */
-}
+ double load_ave[3];
+ int loads = getloadavg (load_ave, 3);
+ Lisp_Object ret;
+
+ if (loads < 0)
+ error ("load-average not implemented for this operating system");
-#undef channel
-#undef initialized
-#undef nl
+ ret = Qnil;
+ while (loads > 0)
+ ret = Fcons (make_number ((int) (load_ave[--loads] * 100.0)), ret);
+
+ return ret;
+}
\f
Lisp_Object Vfeatures;
register Lisp_Object tem;
CHECK_SYMBOL (feature, 0);
tem = Fmemq (feature, Vfeatures);
- return (NULL (tem)) ? Qnil : Qt;
+ return (NILP (tem)) ? Qnil : Qt;
}
DEFUN ("provide", Fprovide, Sprovide, 1, 1, 0,
{
register Lisp_Object tem;
CHECK_SYMBOL (feature, 0);
- if (!NULL (Vautoload_queue))
+ if (!NILP (Vautoload_queue))
Vautoload_queue = Fcons (Fcons (Vfeatures, Qnil), Vautoload_queue);
tem = Fmemq (feature, Vfeatures);
- if (NULL (tem))
+ if (NILP (tem))
Vfeatures = Fcons (feature, Vfeatures);
+ LOADHIST_ATTACH (Fcons (Qprovide, feature));
return feature;
}
register Lisp_Object tem;
CHECK_SYMBOL (feature, 0);
tem = Fmemq (feature, Vfeatures);
- if (NULL (tem))
+ LOADHIST_ATTACH (Fcons (Qrequire, feature));
+ if (NILP (tem))
{
int count = specpdl_ptr - specpdl;
record_unwind_protect (un_autoload, Vautoload_queue);
Vautoload_queue = Qt;
- Fload (NULL (file_name) ? Fsymbol_name (feature) : file_name,
+ Fload (NILP (file_name) ? Fsymbol_name (feature) : file_name,
Qnil, Qt, Qnil);
tem = Fmemq (feature, Vfeatures);
- if (NULL (tem))
+ if (NILP (tem))
error ("Required feature %s was not provided",
XSYMBOL (feature)->name->data );
{
Qstring_lessp = intern ("string-lessp");
staticpro (&Qstring_lessp);
+ Qprovide = intern ("provide");
+ staticpro (&Qprovide);
+ Qrequire = intern ("require");
+ staticpro (&Qrequire);
+ Qyes_or_no_p_history = intern ("yes-or-no-p-history");
+ staticpro (&Qyes_or_no_p_history);
DEFVAR_LISP ("features", &Vfeatures,
"A list of symbols which are the features of the executing emacs.\n\
defsubr (&Sassoc);
defsubr (&Srassq);
defsubr (&Sdelq);
+ defsubr (&Sdelete);
defsubr (&Snreverse);
defsubr (&Sreverse);
defsubr (&Ssort);
HCoop / bpt / emacs.git / blobdiff