void Fset_cdddar(CL_FORM *base)
{
Fcar(ARG(1));
Fcdr(ARG(1));
Fcdr(ARG(1));
Fset_cdr(ARG(0));
}
void Fcddadr(CL_FORM *base)
{
Fcdr(ARG(0));
Fcar(ARG(0));
Fcdr(ARG(0));
Fcdr(ARG(0));
}
static void
store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
{
/* Don't use indirect_function here, or defaliases will apply their
docstrings to the base functions (Bug#2603). */
Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj;
/* The type determines where the docstring is stored. */
/* Lisp_Subrs have a slot for it. */
if (SUBRP (fun))
{
intptr_t negative_offset = - offset;
XSUBR (fun)->doc = (char *) negative_offset;
}
/* If it's a lisp form, stick it in the form. */
else if (CONSP (fun))
{
Lisp_Object tem;
tem = XCAR (fun);
if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
|| (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
{
tem = Fcdr (Fcdr (fun));
if (CONSP (tem) && INTEGERP (XCAR (tem)))
/* FIXME: This modifies typically pure hash-cons'd data, so its
correctness is quite delicate. */
XSETCAR (tem, make_number (offset));
}
else if (EQ (tem, Qmacro))
store_function_docstring (XCDR (fun), offset);
}
/* Bytecode objects sometimes have slots for it. */
else if (COMPILEDP (fun))
{
/* This bytecode object must have a slot for the
docstring, since we've found a docstring for it. */
if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
ASET (fun, COMPILED_DOC_STRING, make_number (offset));
else
{
AUTO_STRING (format, "No docstring slot for %s");
CALLN (Fmessage, format,
(SYMBOLP (obj)
? SYMBOL_NAME (obj)
: build_string ("<anonymous>")));
}
}
}
static Lisp_Object
call_process_cleanup (Lisp_Object arg)
{
Lisp_Object fdpid = Fcdr (arg);
int fd;
#if defined (MSDOS)
Lisp_Object file;
#else
pid_t pid;
#endif
Fset_buffer (Fcar (arg));
CONS_TO_INTEGER (Fcar (fdpid), int, fd);
#if defined (MSDOS)
/* for MSDOS fdpid is really (fd . tempfile) */
file = Fcdr (fdpid);
/* FD is -1 and FILE is "" when we didn't actually create a
temporary file in call-process. */
if (fd >= 0)
emacs_close (fd);
if (!(strcmp (SDATA (file), NULL_DEVICE) == 0 || SREF (file, 0) == '\0'))
unlink (SDATA (file));
#else /* not MSDOS */
CONS_TO_INTEGER (Fcdr (fdpid), pid_t, pid);
if (call_process_exited)
{
emacs_close (fd);
return Qnil;
}
if (EMACS_KILLPG (pid, SIGINT) == 0)
{
ptrdiff_t count = SPECPDL_INDEX ();
record_unwind_protect (call_process_kill, fdpid);
message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
immediate_quit = 1;
QUIT;
wait_for_termination (pid);
immediate_quit = 0;
specpdl_ptr = specpdl + count; /* Discard the unwind protect. */
message1 ("Waiting for process to die...done");
}
synch_process_alive = 0;
emacs_close (fd);
#endif /* not MSDOS */
return Qnil;
}
static Lisp_Object
x_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type,
int local_request, struct mac_display_info *dpyinfo)
{
Lisp_Object local_value;
Lisp_Object handler_fn, value, type, check;
if (!x_selection_owner_p (selection_symbol, dpyinfo))
return Qnil;
local_value = LOCAL_SELECTION (selection_symbol, dpyinfo);
/* TIMESTAMP is a special case. */
if (EQ (target_type, QTIMESTAMP))
{
handler_fn = Qnil;
value = XCAR (XCDR (XCDR (local_value)));
}
else
{
/* Don't allow a quit within the converter.
When the user types C-g, he would be surprised
if by luck it came during a converter. */
ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qinhibit_quit, Qt);
CHECK_SYMBOL (target_type);
handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
/* gcpro is not needed here since nothing but HANDLER_FN
is live, and that ought to be a symbol. */
if (!NILP (handler_fn))
value = call3 (handler_fn,
selection_symbol, (local_request ? Qnil : target_type),
XCAR (XCDR (local_value)));
else
value = Qnil;
unbind_to (count, Qnil);
}
if (local_request)
return value;
/* Make sure this value is of a type that we could transmit
to another application. */
type = target_type;
check = value;
if (CONSP (value)
&& SYMBOLP (XCAR (value)))
type = XCAR (value),
check = XCDR (value);
if (NILP (value) || mac_valid_selection_value_p (check, type))
return value;
signal_error ("Invalid data returned by selection-conversion function",
list2 (handler_fn, value));
}
static Lisp_Object
call_process_kill (Lisp_Object fdpid)
{
emacs_close (XFASTINT (Fcar (fdpid)));
EMACS_KILLPG (XFASTINT (Fcdr (fdpid)), SIGKILL);
synch_process_alive = 0;
return Qnil;
}
static Lisp_Object
call_process_cleanup (Lisp_Object arg)
{
Lisp_Object fdpid = Fcdr (arg);
#if defined (MSDOS)
Lisp_Object file;
#else
int pid;
#endif
Fset_buffer (Fcar (arg));
#if defined (MSDOS)
/* for MSDOS fdpid is really (fd . tempfile) */
file = Fcdr (fdpid);
emacs_close (XFASTINT (Fcar (fdpid)));
if (strcmp (SDATA (file), NULL_DEVICE) != 0)
unlink (SDATA (file));
#else /* not MSDOS */
pid = XFASTINT (Fcdr (fdpid));
if (call_process_exited)
{
emacs_close (XFASTINT (Fcar (fdpid)));
return Qnil;
}
if (EMACS_KILLPG (pid, SIGINT) == 0)
{
int count = SPECPDL_INDEX ();
record_unwind_protect (call_process_kill, fdpid);
message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
immediate_quit = 1;
QUIT;
wait_for_termination (pid);
immediate_quit = 0;
specpdl_ptr = specpdl + count; /* Discard the unwind protect. */
message1 ("Waiting for process to die...done");
}
synch_process_alive = 0;
emacs_close (XFASTINT (Fcar (fdpid)));
#endif /* not MSDOS */
return Qnil;
}
static void
store_function_docstring (Lisp_Object obj, EMACS_INT offset)
/* Use EMACS_INT because we get offset from pointer subtraction. */
{
/* Don't use indirect_function here, or defaliases will apply their
docstrings to the base functions (Bug#2603). */
Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj;
/* The type determines where the docstring is stored. */
/* Lisp_Subrs have a slot for it. */
if (SUBRP (fun))
{
intptr_t negative_offset = - offset;
XSUBR (fun)->doc = (char *) negative_offset;
}
/* If it's a lisp form, stick it in the form. */
else if (CONSP (fun))
{
Lisp_Object tem;
tem = XCAR (fun);
if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
|| (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
{
tem = Fcdr (Fcdr (fun));
if (CONSP (tem) && INTEGERP (XCAR (tem)))
XSETCAR (tem, make_number (offset));
}
else if (EQ (tem, Qmacro))
store_function_docstring (XCDR (fun), offset);
}
/* Bytecode objects sometimes have slots for it. */
else if (COMPILEDP (fun))
{
/* This bytecode object must have a slot for the
docstring, since we've found a docstring for it. */
if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
ASET (fun, COMPILED_DOC_STRING, make_number (offset));
}
}
static Lisp_Object
call_process_kill (Lisp_Object fdpid)
{
int fd;
pid_t pid;
CONS_TO_INTEGER (Fcar (fdpid), int, fd);
CONS_TO_INTEGER (Fcdr (fdpid), pid_t, pid);
emacs_close (fd);
EMACS_KILLPG (pid, SIGKILL);
synch_process_alive = 0;
return Qnil;
}
/* Set up data in menu_items for a menu bar item
whose event type is ITEM_KEY (with string ITEM_NAME)
and whose contents come from the list of keymaps MAPS. */
bool
parse_single_submenu (Lisp_Object item_key, Lisp_Object item_name,
Lisp_Object maps)
{
Lisp_Object length;
EMACS_INT len;
Lisp_Object *mapvec;
ptrdiff_t i;
bool top_level_items = 0;
USE_SAFE_ALLOCA;
length = Flength (maps);
len = XINT (length);
/* Convert the list MAPS into a vector MAPVEC. */
SAFE_ALLOCA_LISP (mapvec, len);
for (i = 0; i < len; i++)
{
mapvec[i] = Fcar (maps);
maps = Fcdr (maps);
}
/* Loop over the given keymaps, making a pane for each map.
But don't make a pane that is empty--ignore that map instead. */
for (i = 0; i < len; i++)
{
if (!KEYMAPP (mapvec[i]))
{
/* Here we have a command at top level in the menu bar
as opposed to a submenu. */
top_level_items = 1;
push_menu_pane (Qnil, Qnil);
push_menu_item (item_name, Qt, item_key, mapvec[i],
Qnil, Qnil, Qnil, Qnil);
}
else
{
Lisp_Object prompt;
prompt = Fkeymap_prompt (mapvec[i]);
single_keymap_panes (mapvec[i],
!NILP (prompt) ? prompt : item_name,
item_key, 10);
}
}
SAFE_FREE ();
return top_level_items;
}
/* Set up data in menu_items for a menu bar item
whose event type is ITEM_KEY (with string ITEM_NAME)
and whose contents come from the list of keymaps MAPS. */
int
parse_single_submenu (Lisp_Object item_key, Lisp_Object item_name, Lisp_Object maps)
{
Lisp_Object length;
int len;
Lisp_Object *mapvec;
int i;
int top_level_items = 0;
length = Flength (maps);
len = XINT (length);
/* Convert the list MAPS into a vector MAPVEC. */
mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
for (i = 0; i < len; i++)
{
mapvec[i] = Fcar (maps);
maps = Fcdr (maps);
}
/* Loop over the given keymaps, making a pane for each map.
But don't make a pane that is empty--ignore that map instead. */
for (i = 0; i < len; i++)
{
if (!KEYMAPP (mapvec[i]))
{
/* Here we have a command at top level in the menu bar
as opposed to a submenu. */
top_level_items = 1;
push_menu_pane (Qnil, Qnil);
push_menu_item (item_name, Qt, item_key, mapvec[i],
Qnil, Qnil, Qnil, Qnil);
}
else
{
Lisp_Object prompt;
prompt = Fkeymap_prompt (mapvec[i]);
single_keymap_panes (mapvec[i],
!NILP (prompt) ? prompt : item_name,
item_key, 10);
}
}
return top_level_items;
}
/* Push all the panes and items of a menu described by the
alist-of-alists MENU.
This handles old-fashioned calls to x-popup-menu. */
void
list_of_panes (Lisp_Object menu)
{
Lisp_Object tail;
init_menu_items ();
for (tail = menu; CONSP (tail); tail = XCDR (tail))
{
Lisp_Object elt, pane_name, pane_data;
elt = XCAR (tail);
pane_name = Fcar (elt);
CHECK_STRING (pane_name);
push_menu_pane (encode_menu_string (pane_name), Qnil);
pane_data = Fcdr (elt);
CHECK_CONS (pane_data);
list_of_items (pane_data);
}
finish_menu_items ();
}
void concatenate_to_non_list(CL_FORM *base, int nargs)
{
Flist(STACK(base, 1), nargs - 1);
LOAD_NIL(STACK(base, 2));
LOAD_FIXNUM(0, STACK(base, 3));
LOAD_FIXNUM(0, STACK(base, 4));
LOAD_NIL(STACK(base, 5));
COPY(STACK(base, 1), STACK(base, 6));
M144_1:;
if(CL_ATOMP(STACK(base, 6)))
{
LOAD_NIL(STACK(base, 5));
goto RETURN158;
}
COPY(STACK(base, 6), STACK(base, 7));
Fcar(STACK(base, 7));
COPY(STACK(base, 7), STACK(base, 5));
COPY(STACK(base, 3), STACK(base, 7));
COPY(STACK(base, 5), STACK(base, 8));
Flength(STACK(base, 8));
Fplus(STACK(base, 7), 2);
COPY(STACK(base, 7), STACK(base, 3));
Fcdr(STACK(base, 6));
goto M144_1;
RETURN158:;
COPY(STACK(base, 0), STACK(base, 5));
COPY(STACK(base, 3), STACK(base, 6));
Fmake_sequence(STACK(base, 5), 2);
COPY(STACK(base, 5), STACK(base, 2));
LOAD_NIL(STACK(base, 5));
COPY(STACK(base, 1), STACK(base, 6));
M145_1:;
if(CL_ATOMP(STACK(base, 6)))
{
LOAD_NIL(STACK(base, 5));
goto RETURN159;
}
COPY(STACK(base, 6), STACK(base, 7));
Fcar(STACK(base, 7));
COPY(STACK(base, 7), STACK(base, 5));
if(CL_LISTP(STACK(base, 5)))
{
LOAD_NIL(STACK(base, 7));
COPY(STACK(base, 5), STACK(base, 8));
M146_1:;
if(CL_ATOMP(STACK(base, 8)))
{
LOAD_NIL(STACK(base, 7));
goto RETURN160;
}
COPY(STACK(base, 8), STACK(base, 9));
Fcar(STACK(base, 9));
COPY(STACK(base, 9), STACK(base, 7));
COPY(STACK(base, 2), STACK(base, 10));
COPY(STACK(base, 4), STACK(base, 11));
Fset_elt(STACK(base, 9));
COPY(STACK(base, 4), STACK(base, 9));
F1plus(STACK(base, 9));
COPY(STACK(base, 9), STACK(base, 4));
Fcdr(STACK(base, 8));
goto M146_1;
RETURN160:;
}
else
{
COPY(STACK(base, 5), STACK(base, 7));
Flength(STACK(base, 7));
LOAD_FIXNUM(0, STACK(base, 8));
M147_1:;
COPY(STACK(base, 8), STACK(base, 9));
COPY(STACK(base, 7), STACK(base, 10));
Fge(STACK(base, 9), 2);
if(CL_TRUEP(STACK(base, 9)))
{
goto RETURN161;
}
COPY(STACK(base, 5), STACK(base, 9));
COPY(STACK(base, 8), STACK(base, 10));
Felt(STACK(base, 9));
COPY(STACK(base, 9), STACK(base, 10));
COPY(STACK(base, 2), STACK(base, 11));
COPY(STACK(base, 4), STACK(base, 12));
Fset_elt(STACK(base, 10));
COPY(STACK(base, 4), STACK(base, 9));
F1plus(STACK(base, 9));
COPY(STACK(base, 9), STACK(base, 4));
F1plus(STACK(base, 8));
goto M147_1;
RETURN161:;
}
Fcdr(STACK(base, 6));
goto M145_1;
RETURN159:;
COPY(STACK(base, 2), STACK(base, 0));
}
void
compute_fringe_widths (struct frame *f, int redraw)
{
int o_left = FRAME_LEFT_FRINGE_WIDTH (f);
int o_right = FRAME_RIGHT_FRINGE_WIDTH (f);
int o_cols = FRAME_FRINGE_COLS (f);
Lisp_Object left_fringe = Fassq (Qleft_fringe, f->param_alist);
Lisp_Object right_fringe = Fassq (Qright_fringe, f->param_alist);
int left_fringe_width, right_fringe_width;
if (!NILP (left_fringe))
left_fringe = Fcdr (left_fringe);
if (!NILP (right_fringe))
right_fringe = Fcdr (right_fringe);
left_fringe_width = ((NILP (left_fringe) || !INTEGERP (left_fringe)) ? 8 :
XINT (left_fringe));
right_fringe_width = ((NILP (right_fringe) || !INTEGERP (right_fringe)) ? 8 :
XINT (right_fringe));
if (left_fringe_width || right_fringe_width)
{
int left_wid = left_fringe_width >= 0 ? left_fringe_width : -left_fringe_width;
int right_wid = right_fringe_width >= 0 ? right_fringe_width : -right_fringe_width;
int conf_wid = left_wid + right_wid;
int font_wid = FRAME_COLUMN_WIDTH (f);
int cols = (left_wid + right_wid + font_wid-1) / font_wid;
int real_wid = cols * font_wid;
if (left_wid && right_wid)
{
if (left_fringe_width < 0)
{
/* Left fringe width is fixed, adjust right fringe if necessary */
FRAME_LEFT_FRINGE_WIDTH (f) = left_wid;
FRAME_RIGHT_FRINGE_WIDTH (f) = real_wid - left_wid;
}
else if (right_fringe_width < 0)
{
/* Right fringe width is fixed, adjust left fringe if necessary */
FRAME_LEFT_FRINGE_WIDTH (f) = real_wid - right_wid;
FRAME_RIGHT_FRINGE_WIDTH (f) = right_wid;
}
else
{
/* Adjust both fringes with an equal amount.
Note that we are doing integer arithmetic here, so don't
lose a pixel if the total width is an odd number. */
int fill = real_wid - conf_wid;
FRAME_LEFT_FRINGE_WIDTH (f) = left_wid + fill/2;
FRAME_RIGHT_FRINGE_WIDTH (f) = right_wid + fill - fill/2;
}
}
else if (left_fringe_width)
{
FRAME_LEFT_FRINGE_WIDTH (f) = real_wid;
FRAME_RIGHT_FRINGE_WIDTH (f) = 0;
}
else
{
FRAME_LEFT_FRINGE_WIDTH (f) = 0;
FRAME_RIGHT_FRINGE_WIDTH (f) = real_wid;
}
FRAME_FRINGE_COLS (f) = cols;
}
else
{
FRAME_LEFT_FRINGE_WIDTH (f) = 0;
FRAME_RIGHT_FRINGE_WIDTH (f) = 0;
FRAME_FRINGE_COLS (f) = 0;
}
if (redraw && FRAME_VISIBLE_P (f))
if (o_left != FRAME_LEFT_FRINGE_WIDTH (f) ||
o_right != FRAME_RIGHT_FRINGE_WIDTH (f) ||
o_cols != FRAME_FRINGE_COLS (f))
redraw_frame (f);
}
void unparse_unix_directory_list(CL_FORM *base)
{
LOAD_NIL(STACK(base, 1));
LOAD_NIL(STACK(base, 2));
{
CL_FORM *lptr;
lptr = form_alloc(STACK(base, 3), 2);
COPY(STACK(base, 1), CAR(lptr));
COPY(STACK(base, 2), CDR(lptr));
LOAD_CONS(lptr, STACK(base, 1));
}
if(CL_TRUEP(STACK(base, 0)))
{
COPY(STACK(base, 0), STACK(base, 2));
Fcar(STACK(base, 2));
COPY(STACK(base, 0), STACK(base, 3));
COPY(STACK(base, 3), STACK(base, 4));
Fcdr(STACK(base, 4));
COPY(STACK(base, 4), STACK(base, 0));
if(CL_SYMBOLP(STACK(base, 2)) && GET_SYMBOL(STACK(base, 2)) == SYMBOL(Slisp, 198)) /* ABSOLUTE */
{
LOAD_SMSTR((CL_FORM *)&Kunparse_unix_directory_list[0], STACK(base, 3)); /* / */
COPY(STACK(base, 1), STACK(base, 4));
add_q(STACK(base, 3));
}
else
{
if(CL_SYMBOLP(STACK(base, 2)) && GET_SYMBOL(STACK(base, 2)) == SYMBOL(Slisp, 201)) /* RELATIVE */
{
LOAD_T(STACK(base, 3));
}
else
{
LOAD_NIL(STACK(base, 3));
}
if(CL_TRUEP(STACK(base, 3)))
{
}
else
{
LOAD_SMSTR((CL_FORM *)&Kunparse_unix_directory_list[2], STACK(base, 4)); /* ecase: the value ~a is not a legal value */
COPY(STACK(base, 2), STACK(base, 5));
Ferror(STACK(base, 4), 2);
}
}
LOAD_NIL(STACK(base, 2));
COPY(STACK(base, 0), STACK(base, 3));
M33_1:;
if(CL_ATOMP(STACK(base, 3)))
{
LOAD_NIL(STACK(base, 2));
goto RETURN34;
}
COPY(STACK(base, 3), STACK(base, 4));
Fcar(STACK(base, 4));
COPY(STACK(base, 4), STACK(base, 2));
if(CL_SYMBOLP(STACK(base, 2)) && GET_SYMBOL(STACK(base, 2)) == SYMBOL(Slisp, 205)) /* UP */
{
LOAD_SMSTR((CL_FORM *)&Kunparse_unix_directory_list[4], STACK(base, 4)); /* ../ */
COPY(STACK(base, 1), STACK(base, 5));
add_q(STACK(base, 4));
}
else
{
if(CL_SYMBOLP(STACK(base, 2)) && GET_SYMBOL(STACK(base, 2)) == SYMBOL(Slisp, 199)) /* BACK */
{
LOAD_SMSTR((CL_FORM *)&Kunparse_unix_directory_list[6], STACK(base, 4)); /* :BACK cannot be represented in namestrings. */
Ferror(STACK(base, 4), 1);
}
else
{
if(CL_SMAR_P(STACK(base, 2)))
{
COPY(STACK(base, 2), STACK(base, 4));
LOAD_SYMBOL(SYMBOL(Slisp, 43), STACK(base, 5)); /* STANDARD-CHAR */
LOAD_SYMBOL(SYMBOL(Slisp, 48), STACK(base, 6)); /* * */
check_array_internal(STACK(base, 4));
}
else
{
LOAD_NIL(STACK(base, 4));
}
if(CL_TRUEP(STACK(base, 4)))
{
bool_result = TRUE;
}
else
{
COPY(STACK(base, 2), STACK(base, 5));
LOAD_SYMBOL(SYMBOL(Slisp, 181), STACK(base, 6)); /* PATTERN */
struct_typep(STACK(base, 5));
bool_result = CL_TRUEP(STACK(base, 5));
}
if(bool_result)
{
COPY(STACK(base, 2), STACK(base, 4));
unparse_unix_piece(STACK(base, 4));
COPY(STACK(base, 1), STACK(base, 5));
add_q(STACK(base, 4));
LOAD_SMSTR((CL_FORM *)&Kunparse_unix_directory_list[8], STACK(base, 4)); /* / */
COPY(STACK(base, 1), STACK(base, 5));
add_q(STACK(base, 4));
}
else
{
LOAD_SMSTR((CL_FORM *)&Kunparse_unix_directory_list[10], STACK(base, 4)); /* Invalid directory component: ~S */
COPY(STACK(base, 2), STACK(base, 5));
Ferror(STACK(base, 4), 2);
}
}
}
Fcdr(STACK(base, 3));
goto M33_1;
RETURN34:;
}
LOAD_GLOBFUN(&CFconcatenate, STACK(base, 2));
LOAD_SYMBOL(SYMBOL(Slisp, 40), STACK(base, 3)); /* SIMPLE-STRING */
COPY(STACK(base, 1), STACK(base, 4));
Fcar(STACK(base, 4));
Fapply(STACK(base, 2), 3);
COPY(STACK(base, 2), STACK(base, 0));
}
static void
fix_command (Lisp_Object input, Lisp_Object values)
{
/* FIXME: Instead of this ugly hack, we should provide a way for an
interactive spec to return an expression/function that will re-build the
args without user intervention. */
if (CONSP (input))
{
Lisp_Object car;
car = XCAR (input);
/* Skip through certain special forms. */
while (EQ (car, Qlet) || EQ (car, Qletx)
|| EQ (car, Qsave_excursion)
|| EQ (car, Qprogn))
{
while (CONSP (XCDR (input)))
input = XCDR (input);
input = XCAR (input);
if (!CONSP (input))
break;
car = XCAR (input);
}
if (EQ (car, Qlist))
{
Lisp_Object intail, valtail;
for (intail = Fcdr (input), valtail = values;
CONSP (valtail);
intail = Fcdr (intail), valtail = XCDR (valtail))
{
Lisp_Object elt;
elt = Fcar (intail);
if (CONSP (elt))
{
Lisp_Object presflag, carelt;
carelt = XCAR (elt);
/* If it is (if X Y), look at Y. */
if (EQ (carelt, Qif)
&& EQ (Fnthcdr (make_number (3), elt), Qnil))
elt = Fnth (make_number (2), elt);
/* If it is (when ... Y), look at Y. */
else if (EQ (carelt, Qwhen))
{
while (CONSP (XCDR (elt)))
elt = XCDR (elt);
elt = Fcar (elt);
}
/* If the function call we're looking at
is a special preserved one, copy the
whole expression for this argument. */
if (CONSP (elt))
{
presflag = Fmemq (Fcar (elt), preserved_fns);
if (!NILP (presflag))
Fsetcar (valtail, Fcar (intail));
}
}
}
}
}
}
void concatenate_to_list(CL_FORM *base, int nargs)
{
Flist(STACK(base, 0), nargs - 0);
LOAD_NIL(STACK(base, 1));
LOAD_NIL(STACK(base, 2));
{
CL_FORM *lptr;
lptr = form_alloc(STACK(base, 3), 2);
COPY(STACK(base, 1), CAR(lptr));
COPY(STACK(base, 2), CDR(lptr));
LOAD_CONS(lptr, STACK(base, 1));
}
LOAD_NIL(STACK(base, 2));
COPY(STACK(base, 0), STACK(base, 3));
M148_1:;
if(CL_ATOMP(STACK(base, 3)))
{
LOAD_NIL(STACK(base, 2));
goto RETURN162;
}
COPY(STACK(base, 3), STACK(base, 4));
Fcar(STACK(base, 4));
COPY(STACK(base, 4), STACK(base, 2));
if(CL_LISTP(STACK(base, 2)))
{
LOAD_NIL(STACK(base, 4));
COPY(STACK(base, 2), STACK(base, 5));
M149_1:;
if(CL_ATOMP(STACK(base, 5)))
{
LOAD_NIL(STACK(base, 4));
goto RETURN163;
}
COPY(STACK(base, 5), STACK(base, 6));
Fcar(STACK(base, 6));
COPY(STACK(base, 6), STACK(base, 4));
COPY(STACK(base, 1), STACK(base, 7));
add_q(STACK(base, 6));
Fcdr(STACK(base, 5));
goto M149_1;
RETURN163:;
}
else
{
COPY(STACK(base, 2), STACK(base, 4));
Flength(STACK(base, 4));
LOAD_FIXNUM(0, STACK(base, 5));
M150_1:;
COPY(STACK(base, 5), STACK(base, 6));
COPY(STACK(base, 4), STACK(base, 7));
Fge(STACK(base, 6), 2);
if(CL_TRUEP(STACK(base, 6)))
{
goto RETURN164;
}
COPY(STACK(base, 2), STACK(base, 6));
COPY(STACK(base, 5), STACK(base, 7));
Felt(STACK(base, 6));
COPY(STACK(base, 1), STACK(base, 7));
add_q(STACK(base, 6));
F1plus(STACK(base, 5));
goto M150_1;
RETURN164:;
}
Fcdr(STACK(base, 3));
goto M148_1;
RETURN162:;
COPY(STACK(base, 1), STACK(base, 0));
Fcar(STACK(base, 0));
}
