C++ CONSP函数代码示例

static void
single_keymap_panes (Lisp_Object keymap, Lisp_Object pane_name,
		     Lisp_Object prefix, int maxdepth)
{
  struct skp skp;

  skp.pending_maps = Qnil;
  skp.maxdepth = maxdepth;
  skp.notbuttons = 0;

  if (maxdepth <= 0)
    return;

  push_menu_pane (pane_name, prefix);

  if (!have_boxes ())
    {
      /* Remember index for first item in this pane so we can go back
	 and add a prefix when (if) we see the first button.  After
	 that, notbuttons is set to 0, to mark that we have seen a
	 button and all non button items need a prefix.  */
      skp.notbuttons = menu_items_used;
    }

  map_keymap_canonical (keymap, single_menu_item, Qnil, &skp);

  /* Process now any submenus which want to be panes at this level.  */
  while (CONSP (skp.pending_maps))
    {
      Lisp_Object elt, eltcdr, string;
      elt = XCAR (skp.pending_maps);
      eltcdr = XCDR (elt);
      string = XCAR (eltcdr);
      /* We no longer discard the @ from the beginning of the string here.
	 Instead, we do this in *menu_show.  */
      single_keymap_panes (Fcar (elt), string, XCDR (eltcdr), maxdepth - 1);
      skp.pending_maps = XCDR (skp.pending_maps);
    }
}

static void
record_point (ptrdiff_t pt)
{
  bool at_boundary;

  /* Don't record position of pt when undo_inhibit_record_point holds.  */
  if (undo_inhibit_record_point)
    return;

  /* Allocate a cons cell to be the undo boundary after this command.  */
  if (NILP (pending_boundary))
    pending_boundary = Fcons (Qnil, Qnil);

  if ((current_buffer != last_undo_buffer)
      /* Don't call Fundo_boundary for the first change.  Otherwise we
	 risk overwriting last_boundary_position in Fundo_boundary with
	 PT of the current buffer and as a consequence not insert an
	 undo boundary because last_boundary_position will equal pt in
	 the test at the end of the present function (Bug#731).  */
      && (MODIFF > SAVE_MODIFF))
    Fundo_boundary ();
  last_undo_buffer = current_buffer;

  at_boundary = ! CONSP (BVAR (current_buffer, undo_list))
                || NILP (XCAR (BVAR (current_buffer, undo_list)));

  if (MODIFF <= SAVE_MODIFF)
    record_first_change ();

  /* If we are just after an undo boundary, and
     point wasn't at start of deleted range, record where it was.  */
  if (at_boundary
      && current_buffer == last_boundary_buffer
      && last_boundary_position != pt)
    bset_undo_list (current_buffer,
		    Fcons (make_number (last_boundary_position),
			   BVAR (current_buffer, undo_list)));
}

static Lisp_Object
get_fringe_bitmap_name (int bn)
{
  Lisp_Object bitmaps;
  Lisp_Object num;

  /* Zero means no bitmap -- return nil.  */
  if (bn <= 0)
    return Qnil;

  bitmaps = Vfringe_bitmaps;
  num = make_number (bn);

  while (CONSP (bitmaps))
    {
      Lisp_Object bitmap = XCAR (bitmaps);
      if (EQ (num, Fget (bitmap, Qfringe)))
	return bitmap;
      bitmaps = XCDR (bitmaps);
    }

  return num;
}

/** Lookup a variable in a frame */
SCM_EXPORT ScmRef
scm_lookup_frame(ScmObj var, ScmObj frame)
{
    ScmObj formals;
    ScmRef actuals;
    DECLARE_INTERNAL_FUNCTION("scm_lookup_frame");

    SCM_ASSERT(IDENTIFIERP(var));
    SCM_ASSERT(valid_framep(frame));

    for (formals = CAR(frame), actuals = REF_CDR(frame);
         CONSP(formals);
         formals = CDR(formals), actuals = REF_CDR(DEREF(actuals)))
    {
        if (EQ(var, CAR(formals)))
            return REF_CAR(DEREF(actuals));
    }
    /* dotted list */
    if (EQ(var, formals))
        return actuals;

    return SCM_INVALID_REF;
}

Lisp_Object
menu_parse_submenu_keywords (Lisp_Object desc, Lisp_Object gui_item)
{
  Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);

  /* Menu descriptor should be a list */
  CHECK_CONS (desc);

  /* First element may be menu name, although can be omitted.
     Let's think that if stuff begins with anything than a keyword
     or a list (submenu), this is a menu name, expected to be a string */
  if (!KEYWORDP (XCAR (desc)) && !CONSP (XCAR (desc)))
    {
      CHECK_STRING (XCAR (desc));
      pgui_item->name = XCAR (desc);
      desc = XCDR (desc);
      if (!NILP (desc))
	CHECK_CONS (desc);
    }

  /* Walk along all key-value pairs */
  while (!NILP(desc) && KEYWORDP (XCAR (desc)))
    {
      Lisp_Object key, val;
      key = XCAR (desc);
      desc = XCDR (desc);
      CHECK_CONS (desc);
      val = XCAR (desc);
      desc = XCDR (desc);
      if (!NILP (desc))
	CHECK_CONS (desc);
      gui_item_add_keyval_pair (gui_item, key, val, ERROR_ME);
    }

  /* Return the rest - supposed to be a list of items */
  return desc;
}

/** Add a binding to recentmost frame of an env */
SCM_EXPORT ScmObj
scm_add_environment(ScmObj var, ScmObj val, ScmObj env)
{
    ScmObj frame, formals, actuals;
    DECLARE_INTERNAL_FUNCTION("scm_add_environment");

    SCM_ASSERT(IDENTIFIERP(var));
    SCM_ASSERT(VALID_ENVP(env));

    /* add (var, val) pair to recentmost frame of the env */
    if (NULLP(env)) {
        frame = CONS(LIST_1(var), LIST_1(val));
        env = LIST_1(frame);
    } else if (CONSP(env)) {
        frame = CAR(env);
        formals = CONS(var, CAR(frame));
        actuals = CONS(val, CDR(frame));
        SET_CAR(frame, formals);
        SET_CDR(frame, actuals);
    } else {
        SCM_NOTREACHED;
    }
    return env;
}

static bool
is_simple_dialog (Lisp_Object contents)
{
  Lisp_Object options;
  Lisp_Object name, yes, no, other;

  if (!CONSP (contents))
    return false;
  options = XCDR (contents);

  yes = build_string ("Yes");
  no = build_string ("No");

  if (!CONSP (options))
    return false;

  name = XCAR (options);
  if (!CONSP (name))
    return false;
  name = XCAR (name);

  if (!NILP (Fstring_equal (name, yes)))
    other = no;
  else if (!NILP (Fstring_equal (name, no)))
    other = yes;
  else
    return false;

  options = XCDR (options);
  if (!CONSP (options))
    return false;

  name = XCAR (options);
  if (!CONSP (name))
    return false;
  name = XCAR (name);
  if (NILP (Fstring_equal (name, other)))
    return false;

  /* Check there are no more options.  */
  options = XCDR (options);
  return !(CONSP (options));
}

/* This is the callback function for arriving signals from
   g_file_monitor.  It shall create a Lisp event, and put it into
   Emacs input queue.  */
static gboolean
dir_monitor_callback (GFileMonitor *monitor,
		      GFile *file,
		      GFile *other_file,
		      GFileMonitorEvent event_type,
		      gpointer user_data)
{
  Lisp_Object symbol, monitor_object, watch_object, flags;
  char *name = g_file_get_parse_name (file);
  char *oname = other_file ? g_file_get_parse_name (other_file) : NULL;

  /* Determine event symbol.  */
  switch (event_type)
    {
    case G_FILE_MONITOR_EVENT_CHANGED:
      symbol = Qchanged;
      break;
    case G_FILE_MONITOR_EVENT_CHANGES_DONE_HINT:
      symbol = Qchanges_done_hint;
      break;
    case G_FILE_MONITOR_EVENT_DELETED:
      symbol = Qdeleted;
      break;
    case G_FILE_MONITOR_EVENT_CREATED:
      symbol = Qcreated;
      break;
    case G_FILE_MONITOR_EVENT_ATTRIBUTE_CHANGED:
      symbol = Qattribute_changed;
      break;
    case G_FILE_MONITOR_EVENT_PRE_UNMOUNT:
      symbol = Qpre_unmount;
      break;
    case G_FILE_MONITOR_EVENT_UNMOUNTED:
      symbol = Qunmounted;
      break;
    case G_FILE_MONITOR_EVENT_MOVED:
      symbol = Qmoved;
      break;
    default:
      goto cleanup;
    }

  /* Determine callback function.  */
  monitor_object = make_pointer_integer (monitor);
  eassert (INTEGERP (monitor_object));
  watch_object = assq_no_quit (monitor_object, watch_list);

  if (CONSP (watch_object))
    {
      struct input_event event;
      Lisp_Object otail = oname ? list1 (build_string (oname)) : Qnil;

      /* Check, whether event_type is expected.  */
      flags = XCAR (XCDR (XCDR (watch_object)));
      if ((!NILP (Fmember (Qchange, flags)) &&
	   !NILP (Fmember (symbol, list5 (Qchanged, Qchanges_done_hint,
					  Qdeleted, Qcreated, Qmoved)))) ||
	  (!NILP (Fmember (Qattribute_change, flags)) &&
	   ((EQ (symbol, Qattribute_changed)))))
	{
	  /* Construct an event.  */
	  EVENT_INIT (event);
	  event.kind = FILE_NOTIFY_EVENT;
	  event.frame_or_window = Qnil;
	  event.arg = list2 (Fcons (monitor_object,
				    Fcons (symbol,
					   Fcons (build_string (name),
						  otail))),
			     XCAR (XCDR (XCDR (XCDR (watch_object)))));

	  /* Store it into the input event queue.  */
	  kbd_buffer_store_event (&event);
	  // XD_DEBUG_MESSAGE ("%s", XD_OBJECT_TO_STRING (event.arg));
	}

      /* Cancel monitor if file or directory is deleted.  */
      if (!NILP (Fmember (symbol, list2 (Qdeleted, Qmoved))) &&
	  !g_file_monitor_is_cancelled (monitor))
	g_file_monitor_cancel (monitor);
    }

  /* Cleanup.  */
 cleanup:
  g_free (name);
  g_free (oname);

  return TRUE;
}

/* This is the callback function for arriving signals from
   g_file_monitor.  It shall create a Lisp event, and put it into
   Emacs input queue.  */
static gboolean
dir_monitor_callback (GFileMonitor *monitor,
		      GFile *file,
		      GFile *other_file,
		      GFileMonitorEvent event_type,
		      gpointer user_data)
{
  Lisp_Object symbol, monitor_object, watch_object;
  char *name = g_file_get_parse_name (file);
  char *oname = other_file ? g_file_get_parse_name (other_file) : NULL;

  /* Determine event symbol.  */
  switch (event_type)
    {
    case G_FILE_MONITOR_EVENT_CHANGED:
      symbol = Qchanged;
      break;
    case G_FILE_MONITOR_EVENT_CHANGES_DONE_HINT:
      symbol = Qchanges_done_hint;
      break;
    case G_FILE_MONITOR_EVENT_DELETED:
      symbol = Qdeleted;
      break;
    case G_FILE_MONITOR_EVENT_CREATED:
      symbol = Qcreated;
      break;
    case G_FILE_MONITOR_EVENT_ATTRIBUTE_CHANGED:
      symbol = Qattribute_changed;
      break;
    case G_FILE_MONITOR_EVENT_PRE_UNMOUNT:
      symbol = Qpre_unmount;
      break;
    case G_FILE_MONITOR_EVENT_UNMOUNTED:
      symbol = Qunmounted;
      break;
    case G_FILE_MONITOR_EVENT_MOVED:
      symbol = Qmoved;
      break;
    default:
      goto cleanup;
    }

  /* Determine callback function.  */
  monitor_object = XIL ((intptr_t) monitor);
  eassert (INTEGERP (monitor_object));
  watch_object = assq_no_quit (monitor_object, watch_list);

  if (CONSP (watch_object))
    {
      /* Construct an event.  */
      struct input_event event;
      Lisp_Object otail = oname ? list1 (build_string (oname)) : Qnil;
      EVENT_INIT (event);
      event.kind = FILE_NOTIFY_EVENT;
      event.frame_or_window = Qnil;
      event.arg = list2 (Fcons (monitor_object,
				Fcons (symbol,
				       Fcons (build_string (name),
					      otail))),
			 XCDR (watch_object));

      /* Store it into the input event queue.  */
      kbd_buffer_store_event (&event);
    }

  /* Cleanup.  */
 cleanup:
  g_free (name);
  g_free (oname);

  return TRUE;
}

int
update_window_fringes (struct window *w, int keep_current_p)
{
  struct glyph_row *row, *cur = 0;
  int yb = window_text_bottom_y (w);
  int rn, nrows = w->current_matrix->nrows;
  int y;
  int redraw_p = 0;
  Lisp_Object boundary_top = Qnil, boundary_bot = Qnil;
  Lisp_Object arrow_top = Qnil, arrow_bot = Qnil;
  Lisp_Object empty_pos;
  Lisp_Object ind = Qnil;
#define MAX_BITMAP_CACHE (8*4)
  int bitmap_cache[MAX_BITMAP_CACHE];
  int top_ind_rn, bot_ind_rn;
  int top_ind_min_y, bot_ind_max_y;

  /* top_ind_rn is set to a nonnegative value whenver
     row->indicate_bob_p is set, so it's OK that top_row_ends_at_zv_p
     is not initialized here.  Similarly for bot_ind_rn,
     row->indicate_eob_p and bot_row_ends_at_zv_p.  */
  int top_row_ends_at_zv_p IF_LINT (= 0), bot_row_ends_at_zv_p IF_LINT (= 0);

  if (w->pseudo_window_p)
    return 0;

  if (!MINI_WINDOW_P (w)
      && (ind = BVAR (XBUFFER (w->buffer), indicate_buffer_boundaries), !NILP (ind)))
    {
      if (EQ (ind, Qleft) || EQ (ind, Qright))
	boundary_top = boundary_bot = arrow_top = arrow_bot = ind;
      else if (CONSP (ind) && CONSP (XCAR (ind)))
	{
	  Lisp_Object pos;
	  if (pos = Fassq (Qt, ind), !NILP (pos))
	    boundary_top = boundary_bot = arrow_top = arrow_bot = XCDR (pos);
	  if (pos = Fassq (Qtop, ind), !NILP (pos))
	    boundary_top = XCDR (pos);
	  if (pos = Fassq (Qbottom, ind), !NILP (pos))
	    boundary_bot = XCDR (pos);
	  if (pos = Fassq (Qup, ind), !NILP (pos))
	    arrow_top = XCDR (pos);
	  if (pos = Fassq (Qdown, ind), !NILP (pos))
	    arrow_bot = XCDR (pos);
	}
      else
	/* Anything else means boundary on left and no arrows.  */
	boundary_top = boundary_bot = Qleft;
    }

  top_ind_rn = bot_ind_rn = -1;
  if (!NILP (ind))
    {
      for (y = w->vscroll, rn = 0;
	   y < yb && rn < nrows;
	   y += row->height, ++rn)
	{
	  row = w->desired_matrix->rows + rn;
	  if (!row->enabled_p)
	    row = w->current_matrix->rows + rn;

	  row->indicate_bob_p = row->indicate_top_line_p = 0;
	  row->indicate_eob_p = row->indicate_bottom_line_p = 0;

	  if (!row->mode_line_p)
	    {
	      if (top_ind_rn < 0 && row->visible_height > 0)
		{
		  if (MATRIX_ROW_START_CHARPOS (row) <= BUF_BEGV (XBUFFER (w->buffer))
		      && !MATRIX_ROW_PARTIALLY_VISIBLE_AT_TOP_P (w, row))
		    row->indicate_bob_p = !NILP (boundary_top);
		  else
		    row->indicate_top_line_p = !NILP (arrow_top);
		  top_ind_rn = rn;
		}

	      if (bot_ind_rn < 0)
		{
		  if (MATRIX_ROW_END_CHARPOS (row) >= BUF_ZV (XBUFFER (w->buffer))
		      && !MATRIX_ROW_PARTIALLY_VISIBLE_AT_BOTTOM_P (w, row))
		    row->indicate_eob_p = !NILP (boundary_bot), bot_ind_rn = rn;
		  else if (y + row->height >= yb)
		    row->indicate_bottom_line_p = !NILP (arrow_bot), bot_ind_rn = rn;
		}
	    }
	}
    }

  empty_pos = BVAR (XBUFFER (w->buffer), indicate_empty_lines);
  if (!NILP (empty_pos) && !EQ (empty_pos, Qright))
    empty_pos = WINDOW_LEFT_FRINGE_WIDTH (w) == 0 ? Qright : Qleft;

  for (y = 0; y < MAX_BITMAP_CACHE; y++)
    bitmap_cache[y] = -1;

#define LEFT_FRINGE(cache, which, partial_p)			\
  (bitmap_cache[cache*4+partial_p] >= 0				\
   ? bitmap_cache[cache*4+partial_p]				\
   : (bitmap_cache[cache*4+partial_p] =				\
      get_logical_fringe_bitmap (w, which, 0, partial_p)))
//.........这里部分代码省略.........

static int
handle_file_notifications (struct input_event *hold_quit)
{
  BYTE *p = file_notifications;
  FILE_NOTIFY_INFORMATION *fni = (PFILE_NOTIFY_INFORMATION)p;
  const DWORD min_size
    = offsetof (FILE_NOTIFY_INFORMATION, FileName) + sizeof(wchar_t);
  struct input_event inev;
  int nevents = 0;

  /* We cannot process notification before Emacs is fully initialized,
     since we need the UTF-16LE coding-system to be set up.  */
  if (!initialized)
    {
      notification_buffer_in_use = 0;
      return nevents;
    }

  enter_crit ();
  if (notification_buffer_in_use)
    {
      DWORD info_size = notifications_size;
      Lisp_Object cs = intern ("utf-16le");
      Lisp_Object obj = w32_get_watch_object (notifications_desc);

      /* notifications_size could be zero when the buffer of
	 notifications overflowed on the OS level, or when the
	 directory being watched was itself deleted.  Do nothing in
	 that case.  */
      if (info_size
	  && !NILP (obj) && CONSP (obj))
	{
	  Lisp_Object callback = XCDR (obj);

	  EVENT_INIT (inev);

	  while (info_size >= min_size)
	    {
	      Lisp_Object utf_16_fn
		= make_unibyte_string ((char *)fni->FileName,
				       fni->FileNameLength);
	      /* Note: mule-conf is preloaded, so utf-16le must
		 already be defined at this point.  */
	      Lisp_Object fname
		= code_convert_string_norecord (utf_16_fn, cs, 0);
	      Lisp_Object action = lispy_file_action (fni->Action);

	      inev.kind = FILE_NOTIFY_EVENT;
	      inev.code = (ptrdiff_t)XINT (XIL ((EMACS_INT)notifications_desc));
	      inev.timestamp = GetTickCount ();
	      inev.modifiers = 0;
	      inev.frame_or_window = callback;
	      inev.arg = Fcons (action, fname);
	      kbd_buffer_store_event_hold (&inev, hold_quit);

	      if (!fni->NextEntryOffset)
		break;
	      p += fni->NextEntryOffset;
	      fni = (PFILE_NOTIFY_INFORMATION)p;
	      info_size -= fni->NextEntryOffset;
	    }
	}
      notification_buffer_in_use = 0;
    }
  leave_crit ();
  return nevents;
}

static lref_t execute_fast_op(lref_t fop, lref_t env)
{
     lref_t retval = NIL;
     lref_t sym;
     lref_t binding;
     lref_t fn;
     lref_t args;
     size_t argc;
     lref_t argv[ARG_BUF_LEN];
     lref_t after;
     lref_t tag;
     lref_t cell;
     lref_t escape_retval;
     jmp_buf *jmpbuf;

     STACK_CHECK(&fop);
     _process_interrupts();

     fstack_enter_eval_frame(&fop, fop, env);

     while(!NULLP(fop)) {
          switch(fop->header.opcode)
          {
          case FOP_LITERAL:
               retval = fop->as.fast_op.arg1;
               fop = fop->as.fast_op.next;
               break;

          case FOP_GLOBAL_REF:
               sym = fop->as.fast_op.arg1;
               binding = SYMBOL_VCELL(sym);

               if (UNBOUND_MARKER_P(binding))
                    vmerror_unbound(sym);

               retval = binding;

               fop = fop->as.fast_op.next;
               break;

          case FOP_GLOBAL_SET:
               sym = fop->as.fast_op.arg1;
               binding = SYMBOL_VCELL(sym);

               if (UNBOUND_MARKER_P(binding))
                    vmerror_unbound(sym);

               SET_SYMBOL_VCELL(sym, retval);

               fop = fop->as.fast_op.next;
               break;

          case FOP_APPLY_GLOBAL:
               sym = fop->as.fast_op.arg1;
               fn = SYMBOL_VCELL(sym);

               if (UNBOUND_MARKER_P(fn))
                    vmerror_unbound(sym);

               argc = 0;
               args = fop->as.fast_op.arg2;

               while (CONSP(args)) {
                    if (argc >= ARG_BUF_LEN) {
                         vmerror_unsupported(_T("too many actual arguments"));
                         break;
                    }

                    argv[argc] = execute_fast_op(CAR(args), env);

                    args = CDR(args);
                    argc++;
               }

               if (!NULLP(args))
                    vmerror_arg_out_of_range(fop->as.fast_op.arg2,
                                             _T("bad formal argument list"));

               fop = apply(fn, argc, argv, &env, &retval);
               break;

          case FOP_APPLY:
               argc = 0;
               fn = execute_fast_op(fop->as.fast_op.arg1, env);
               args = fop->as.fast_op.arg2;

               while (CONSP(args)) {
                    if (argc >= ARG_BUF_LEN) {
                         vmerror_unsupported(_T("too many actual arguments"));
                         break;
                    }

                    argv[argc] = execute_fast_op(CAR(args), env);

                    args = CDR(args);
                    argc++;
               }

               if (!NULLP(args))
                    vmerror_arg_out_of_range(fop->as.fast_op.arg2,
//.........这里部分代码省略.........

Lisp_Object
get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
{
  char *from, *to, *name, *p, *p1;
  int fd;
  int offset;
  EMACS_INT position;
  Lisp_Object file, tem, pos;
  ptrdiff_t count;
  USE_SAFE_ALLOCA;

  if (INTEGERP (filepos))
    {
      file = Vdoc_file_name;
      pos = filepos;
    }
  else if (CONSP (filepos))
    {
      file = XCAR (filepos);
      pos = XCDR (filepos);
    }
  else
    return Qnil;

  position = eabs (XINT (pos));

  if (!STRINGP (Vdoc_directory))
    return Qnil;

  if (!STRINGP (file))
    return Qnil;

  /* Put the file name in NAME as a C string.
     If it is relative, combine it with Vdoc_directory.  */

  tem = Ffile_name_absolute_p (file);
  file = ENCODE_FILE (file);
  Lisp_Object docdir
    = NILP (tem) ? ENCODE_FILE (Vdoc_directory) : empty_unibyte_string;
  ptrdiff_t docdir_sizemax = SBYTES (docdir) + 1;
#ifndef CANNOT_DUMP
  docdir_sizemax = max (docdir_sizemax, sizeof sibling_etc);
#endif
  name = SAFE_ALLOCA (docdir_sizemax + SBYTES (file));
  lispstpcpy (lispstpcpy (name, docdir), file);

  fd = emacs_open (name, O_RDONLY, 0);
  if (fd < 0)
    {
#ifndef CANNOT_DUMP
      if (!NILP (Vpurify_flag))
	{
	  /* Preparing to dump; DOC file is probably not installed.
	     So check in ../etc.  */
	  lispstpcpy (stpcpy (name, sibling_etc), file);

	  fd = emacs_open (name, O_RDONLY, 0);
	}
#endif
      if (fd < 0)
	{
	  if (errno == EMFILE || errno == ENFILE)
	    report_file_error ("Read error on documentation file", file);

	  SAFE_FREE ();
	  AUTO_STRING (cannot_open, "Cannot open doc string file \"");
	  AUTO_STRING (quote_nl, "\"\n");
	  return concat3 (cannot_open, file, quote_nl);
	}
    }
  count = SPECPDL_INDEX ();
  record_unwind_protect_int (close_file_unwind, fd);

  /* Seek only to beginning of disk block.  */
  /* Make sure we read at least 1024 bytes before `position'
     so we can check the leading text for consistency.  */
  offset = min (position, max (1024, position % (8 * 1024)));
  if (TYPE_MAXIMUM (off_t) < position
      || lseek (fd, position - offset, 0) < 0)
    error ("Position %"pI"d out of range in doc string file \"%s\"",
	   position, name);

  /* Read the doc string into get_doc_string_buffer.
     P points beyond the data just read.  */

  p = get_doc_string_buffer;
  while (1)
    {
      ptrdiff_t space_left = (get_doc_string_buffer_size - 1
			      - (p - get_doc_string_buffer));
      int nread;

      /* Allocate or grow the buffer if we need to.  */
      if (space_left <= 0)
	{
	  ptrdiff_t in_buffer = p - get_doc_string_buffer;
	  get_doc_string_buffer
	    = xpalloc (get_doc_string_buffer, &get_doc_string_buffer_size,
		       16 * 1024, -1, 1);
	  p = get_doc_string_buffer + in_buffer;
//.........这里部分代码省略.........

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));
		    }
		}
	    }
	}
    }
}

LispObj *
Lisp_Require(LispBuiltin *builtin)
/*
 require module &optional pathname
 */
{
    char filename[1024], *ext;
    int len;

    LispObj *obj, *module, *pathname;

    pathname = ARGUMENT(1);
    module = ARGUMENT(0);

    CHECK_STRING(module);
    if (pathname != UNSPEC) {
	if (PATHNAMEP(pathname))
	    pathname = CAR(pathname->data.pathname);
	else {
	    CHECK_STRING(pathname);
	}
    }
    else
	pathname = module;

    for (obj = MOD; CONSP(obj); obj = CDR(obj)) {
	if (strcmp(THESTR(CAR(obj)), THESTR(module)) == 0)
	    return (module);
    }

    if (THESTR(pathname)[0] != '/') {
#ifdef LISPDIR
	snprintf(filename, sizeof(filename), "%s", LISPDIR);
#else
	getcwd(filename, sizeof(filename));
#endif
    }
    else
	filename[0] = '\0';
    *(filename + sizeof(filename) - 5) = '\0';	/* make sure there is place for ext */
    len = strlen(filename);
    if (!len || filename[len - 1] != '/') {
	strcat(filename, "/");
	++len;
    }

    snprintf(filename + len, sizeof(filename) - len - 5, "%s", THESTR(pathname));

    ext = filename + strlen(filename);

#ifdef SHARED_MODULES
    strcpy(ext, ".so");
    if (access(filename, R_OK) == 0) {
	LispModule *lisp_module;
	char data[64];
	int len;

	if (lisp__data.module == NULL) {
	    /* export our own symbols */
	    if (dlopen(NULL, RTLD_LAZY | RTLD_GLOBAL) == NULL)
		LispDestroy("%s: ", STRFUN(builtin), dlerror());
	}

	lisp_module = (LispModule*)LispMalloc(sizeof(LispModule));
	if ((lisp_module->handle =
	     dlopen(filename, RTLD_LAZY | RTLD_GLOBAL)) == NULL)
	    LispDestroy("%s: dlopen: %s", STRFUN(builtin), dlerror());
	snprintf(data, sizeof(data), "%sLispModuleData", THESTR(module));
	if ((lisp_module->data =
	     (LispModuleData*)dlsym(lisp_module->handle, data)) == NULL) {
	    dlclose(lisp_module->handle);
	    LispDestroy("%s: cannot find LispModuleData for %s",
			STRFUN(builtin), STROBJ(module));
	}
	LispMused(lisp_module);
	lisp_module->next = lisp__data.module;
	lisp__data.module = lisp_module;
	if (lisp_module->data->load)
	    (lisp_module->data->load)();

	if (MOD == NIL)
	    MOD = CONS(module, NIL);
	else {
	    RPLACD(MOD, CONS(CAR(MOD), CDR(MOD)));
	    RPLACA(MOD, module);
	}
	LispSetVar(lisp__data.modules, MOD);

	return (module);
    }
#endif

    strcpy(ext, ".lsp");
    (void)LispLoadFile(STRING(filename), 0, 0, 0);

    return (module);
}