xfns.c

早期freebsd实现

  ()
{
  Lisp_Object string;
  string = build_string (mous_color);
  return string;
}

DEFUN ("x-get-default", Fx_get_default, Sx_get_default, 1, 1, 0,
       "Get X default ATTRIBUTE from the system.  Returns nil if\n\
attribute does not exist.")
  (arg)
     Lisp_Object arg;
{
  unsigned char *default_name, *value;

  CHECK_STRING (arg, 1);
  default_name = XSTRING (arg)->data;

  value = (unsigned char *) XGetDefault ("emacs", default_name);
  /* if (value == 0)
     value = XGetDefault ("", default_name); */
  if (value)
    return build_string (value);
  else
    return (Qnil);
}

DEFUN ("x-set-icon", Fx_set_icon, Sx_set_icon, 1, 1, "P",
  "Set type of icon used by X for Emacs's window.\n\
ARG non-nil means use kitchen-sink icon;\n\
nil means use generic window manager icon.")
  (arg)
     Lisp_Object arg;
{
  check_xterm ();
  if (NULL (arg))
    XTextIcon ();
  else
    XBitmapIcon ();
  return arg;
}

DEFUN ("x-set-font", Fx_set_font, Sx_set_font, 1, 1, "sFont Name: ",
      "At initialization sets the font to be used for the X window.")
  (arg)
     Lisp_Object arg;
{
  register char *newfontname;
	
  CHECK_STRING (arg, 1);
  check_xterm ();

  newfontname = (char *) xmalloc (XSTRING (arg)->size + 1);
  bcopy (XSTRING (arg)->data, newfontname, XSTRING (arg)->size + 1);
  if (XSTRING (arg)->size == 0)
    /* XOpenFont ("") gets a badarg error rather than a badfont error.
       I believe this is an X bug.
       In emacs, badarg errors cause emacs to die, whilst badfont errors
       are caught.  This kludge prevents us from dying.
     */
    goto badfont;

  if (!XNewFont (newfontname))
    {
      free (XXcurrentfont);
      XXcurrentfont = newfontname;
      return Qt;
    }
  else
    {
    badfont:
      error ("Font \"%s\" is not defined", newfontname);
      free (newfontname);
    }

  return Qnil;
}

DEFUN ("x-set-window-edges", Fx_set_window_edges, Sx_set_window_edges, 4, 4,
  "nNumber of Columns: \nnNumber of Rows: \nnX Offset in Pixels: \n\
nY Offset in Pixels: ",
  "Sets X window size/position: size COLS by ROWS, positions XOFF and YOFF.\n\
To get \"minus zero\" for XOFF or YOFF, supply -1.")
  (cols, rows, xoffset, yoffset)
     Lisp_Object rows, cols, xoffset, yoffset;
{
  BLOCK_INPUT_DECLARE ()

  CHECK_NUMBER (rows, 1);
  CHECK_NUMBER (cols, 2);
  CHECK_NUMBER (xoffset, 3);
  CHECK_NUMBER (yoffset, 4);
  check_xterm ();

  BLOCK_INPUT ();
  x_edges_specified = 1;
  if (XINT (rows) != screen_width || XINT (cols) != screen_height) 
    {
      XSetWindowSize (XINT (rows), XINT (cols));
    }
  XSetOffset (XINT (xoffset), XINT (yoffset));
  XFlush ();
  UNBLOCK_INPUT ();
  return Qt;
}

DEFUN ("coordinates-in-window-p", Fcoordinates_in_window_p,
  Scoordinates_in_window_p, 2, 2, 0,
  "Return non-nil if POSITIONS (a list, (SCREEN-X SCREEN-Y)) is in WINDOW.\n\
Returned value is list of positions expressed\n\
relative to window upper left corner.")
  (coordinate, window)
     register Lisp_Object coordinate, window;
{
  register Lisp_Object xcoord, ycoord;
	
  if (!CONSP (coordinate)) wrong_type_argument (Qlistp, coordinate);
  CHECK_WINDOW (window, 2);
  xcoord = Fcar (coordinate);
  ycoord = Fcar (Fcdr (coordinate));
  CHECK_NUMBER (xcoord, 0);
  CHECK_NUMBER (ycoord, 1);
  if ((XINT (xcoord) < XINT (XWINDOW (window)->left)) ||
      (XINT (xcoord) >= (XINT (XWINDOW (window)->left) +
			 XINT (XWINDOW (window)->width))))
    {
      return Qnil;
    } 
  XFASTINT (xcoord) -= XFASTINT (XWINDOW (window)->left);
  if (XINT (ycoord) == (screen_height - 1))
    return Qnil;
  if ((XINT (ycoord) < XINT (XWINDOW (window)->top)) ||
      (XINT (ycoord) >= (XINT (XWINDOW (window)->top) +
			 XINT (XWINDOW (window)->height)) - 1))
    {
      return Qnil;
    }
  XFASTINT (ycoord) -= XFASTINT (XWINDOW (window)->top);
  return Fcons (xcoord, Fcons (ycoord, Qnil));
}

DEFUN ("x-mouse-events", Fx_mouse_events, Sx_mouse_events, 0, 0, 0,
  "Return number of pending mouse events from X window system.")
  ()
{
  register Lisp_Object tem;
  register int windex, rindex, mindex;

  check_xterm ();
  windex = Xxrepbuffer.windex;
  rindex = Xxrepbuffer.rindex;
  mindex = Xxrepbuffer.mindex;

  if (windex >= rindex) 
    {
      XSET (tem, Lisp_Int, windex - rindex);
    }
  else
    {
      XSET (tem, Lisp_Int, mindex + 1 - (rindex - windex));
    }
  return tem;
}

DEFUN ("x-proc-mouse-event", Fx_proc_mouse_event, Sx_proc_mouse_event,
  0, 0, 0,
  "Pulls a mouse event out of the mouse event buffer and dispatches\n\
the appropriate function to act upon this event.")
  ()
{
  XButtonEvent xrep;
  register Lisp_Object Mouse_Cmd;
  register char com_letter;
  register char key_mask;
  register Lisp_Object tempx;
  register Lisp_Object tempy;
  extern Lisp_Object get_keyelt ();

  check_xterm ();
  if (unloadxrepbuffer (&xrep, &Xxrepbuffer) == 0) 
    {
      com_letter = xrep.detail & 3;
      key_mask = (xrep.detail >> 8) & 0xf0;
      com_letter |= key_mask;
#ifndef HPUX
      if (xrep.type == ButtonReleased) com_letter |= 0x04;
#endif
      XSET (tempx, Lisp_Int, min (screen_width-1, max (0, (xrep.x - XXInternalBorder)/fontinfo->width)));
      XSET (tempy, Lisp_Int, min (screen_height-1, max (0, (xrep.y - XXInternalBorder)/fontinfo->height)));
      Vx_mouse_pos = Fcons (tempx, Fcons (tempy, Qnil));
      XSET (tempx, Lisp_Int, xrep.x + XXxoffset);
      XSET (tempy, Lisp_Int, xrep.y + XXyoffset);
      Vx_mouse_abs_pos = Fcons (tempx, Fcons (tempy, Qnil));
      Vx_mouse_item = make_number (com_letter);
      Mouse_Cmd = get_keyelt (access_keymap (MouseMap, com_letter));
      if (NULL (Mouse_Cmd)) 
	{
#ifndef HPUX
	  if (xrep.type != ButtonReleased)
	    bell ();
#endif
	  Vx_mouse_pos = Qnil;
	  Vx_mouse_abs_pos = Qnil;
	}
      else
	{
	  return call1 (Mouse_Cmd, Vx_mouse_pos);
	}
    }
  return Qnil;
}

DEFUN ("x-get-mouse-event", Fx_get_mouse_event, Sx_get_mouse_event,
  1, 1, 0,
  "Get next mouse event out of mouse event buffer (com-letter (x y)).\n\
ARG non-nil means return nil immediately if no pending event;\n\
otherwise, wait for an event.")
  (arg)
     Lisp_Object arg;
{
  XButtonEvent xrep;
  register Lisp_Object Mouse_Cmd;
  register char com_letter;
  register char key_mask;

  register Lisp_Object tempx;
  register Lisp_Object tempy;
  extern Lisp_Object get_keyelt ();

  check_xterm ();

  if (NULL (arg))
    while (Xxrepbuffer.windex == Xxrepbuffer.rindex);
/*** ??? Surely you don't mean to busy wait??? */
  if (unloadxrepbuffer (&xrep, &Xxrepbuffer) == 0) 
    {
      com_letter = *((char *)&xrep.detail);
      com_letter &= 3;
      key_mask = *((char *)&xrep.detail + 1);
      key_mask &= 0xf0;
      com_letter |= key_mask;
#ifndef HPUX
      if (xrep.type == ButtonReleased) com_letter |= 0x04;
#endif
      XSET (tempx, Lisp_Int, min (screen_width, max (0, (xrep.x - XXInternalBorder)/fontinfo->width)));
      XSET (tempy, Lisp_Int, min (screen_height, max (0, (xrep.y - XXInternalBorder)/fontinfo->height)));
      Vx_mouse_pos = Fcons (tempx, Fcons (tempy, Qnil));
      XSET (tempx, Lisp_Int, xrep.x + XXxoffset);
      XSET (tempy, Lisp_Int, xrep.y + XXyoffset);
      Vx_mouse_abs_pos = Fcons (tempx, Fcons (tempy, Qnil));
      return Fcons (com_letter, Fcons (Vx_mouse_pos, Qnil));
    }
  return Qnil;
}

DEFUN ("x-set-keyboard-enable", Fx_set_keyboard_enable,
  Sx_set_keyboard_enable, 1, 1, 0,
  "In the X window system, set the flag that permite keyboard input.\n\
Permit input if ARG is non-nil.")
  (arg)
     Lisp_Object arg;
{
  BLOCK_INPUT_DECLARE ()

  check_xterm ();

  BLOCK_INPUT ();
  XSelectInput (XXwindow,
		ExposeWindow | ButtonPressed
#ifndef HPUX
		| ButtonReleased
#endif
		| ExposeRegion | ExposeCopy | (!NULL (arg) ? KeyPressed : 0));
  UNBLOCK_INPUT ();
  return arg;
}

DEFUN ("x-set-mouse-inform-flag", Fx_set_mouse_inform_flag,
  Sx_set_mouse_inform_flag, 1, 1, 0,
  "Set inform-of-mouse-events flag in X window system on if ARG is non-nil.")
  (arg)
     Lisp_Object arg;
{
  informflag = !NULL (arg);
  return arg;
}

DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer, Sx_store_cut_buffer,
  1, 1, "sSend string to X:",
  "Store contents of STRING into the cut buffer of the X window system.")
  (string)
     register Lisp_Object string;
{
  BLOCK_INPUT_DECLARE ()

  CHECK_STRING (string, 1);
  check_xterm ();

  BLOCK_INPUT ();
  XStoreBytes (XSTRING (string)->data, XSTRING (string)->size);
  UNBLOCK_INPUT ();

  return Qnil;
}

DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer, Sx_get_cut_buffer, 0, 0, 0,
  "Return contents of cut buffer of the X window system, as a string.")
  ()
{
  int len;
  register Lisp_Object string;
  BLOCK_INPUT_DECLARE ()
  register char *d;

  BLOCK_INPUT ();
  d = XFetchBytes (&len);
  string = make_string (d, len);
  UNBLOCK_INPUT ();
  return string;
}

DEFUN ("x-rubber-band", Fx_rubber_band, Sx_rubber_band, 0, 0, "",
  "Ask user to specify Emacs window position and size with mouse.\n\
This is done automatically if the data has not been specified\n\
when Emacs needs the window to be displayed.")
  ()
{
  int x, y, width, height;
  BLOCK_INPUT_DECLARE ()

  x_edges_specified = 1;

  check_xterm ();
  BLOCK_INPUT ();
  window_fetch (fontinfo->id, &x, &y, &width, &height, "", default_window,
		XXborder, "GNU Emacs");
  XSetWindowSize (height, width);
  XSetOffset (x, y);
  XFlush ();
  ++screen_garbaged;
  UNBLOCK_INPUT ();
  return Qnil;
}

DEFUN ("x-create-x-window", Fx_create_x_window, Sx_create_x_window,
       1, 1, 0,
       "Create window for GNU Emacs from a valid GEOMETRY specification.")
     (arg)
     Lisp_Object arg;
{
  int x, y, width, height;
  char *geometry;
  BLOCK_INPUT_DECLARE ()

  x_edges_specified = 1;

  check_xterm ();
  CHECK_STRING (arg, 1);
  geometry= (char *) xmalloc (XSTRING (arg)->size + 1);
  bcopy (XSTRING (arg)->data, geometry, XSTRING (arg)->size + 1);
  BLOCK_INPUT ();
  window_fetch (fontinfo->id, &x, &y, &width, &height, geometry,
		default_window,	XXborder, "GNU Emacs");
  XSetWindowSize (height, width);
/*  XSetWindowSize ((height - (2 * XXborder))/fontinfo -> height,
    (width - (2 * XXborder))/fontinfo -> width);*/
  XSetOffset (x, y);
  XMapWindow (XXwindow);
  XFlush ();
  UNBLOCK_INPUT ();
  return Qnil;
}


static int
grey_p (colour)
     char *colour;
{
  return (!strcmp (colour, "grey") || !strcmp (colour, "Grey") ||
	  !strcmp (colour, "gray") || !strcmp (colour, "Gray"));
}

DEFUN ("x-set-border-width", Fx_set_border_width, Sx_set_border_width,
  1, 1, "NSet border width: ",
  "Set width of border to WIDTH, in the X window system.")
  (borderwidth)
     register Lisp_Object borderwidth;
{
  WindowInfo WinInfo;
  BLOCK_INPUT_DECLARE ()
  Window tempwindow;
  register int temppixelwidth;
  register int temppixelheight;
  register int tempx;
  register int tempy;
  Pixmap temp_brdr, temp_back;

  CHECK_NUMBER (borderwidth, 0);

  check_xterm ();
  
  if (XINT (borderwidth) < 0) XSETINT (borderwidth, 0);
  
  temppixelwidth = screen_width * fontinfo->width + 2 * XXInternalBorder;
  temppixelheight = screen_height * fontinfo->height + 2 * XXInternalBorder;
  BLOCK_INPUT ();
  XQueryWindow (XXwindow, &WinInfo);
  tempx = WinInfo.x;
  tempy = WinInfo.y;
  if (grey_p (brdr_color))
    temp_brdr = XMakePixmap ((Bitmap) XStoreBitmap (16, 16, gray_bits),
			     BlackPixel, WhitePixel);
  else
    temp_brdr = XMakeTile (brdr);
  temp_back = XMakeTile (back);
  tempwindow = XCreateWindow (RootWindow,
			      tempx /* Absolute horizontal offset */,
			      tempy /* Absolute Vertical offset */,
			      temppixelwidth, temppixelheight,
			      XINT (borderwidth),
			      temp_brdr, temp_back);
  if (tempwindow) 
    {
      XDestroyWindow (XXwindow);
      XXwindow = tempwindow;
      pixelwidth = temppixelwidth;
      pixelheight = temppixelheight;
      XXborder = XINT (borderwidth);
      XSelectInput (XXwindow, NoEvent);
      XSetResizeHint (XXwindow, 2 * XXInternalBorder, 2 * XXInternalBorder,
		      /* fontinfo->width * 1, fontinfo->height * 1, */
		      fontinfo->width, fontinfo->height);
      XStoreName (XXwindow, &iconidentity[0]);
      XDefineCursor (XXwindow, EmacsCursor);
      XFreePixmap (temp_brdr);
      XFreePixmap (temp_back);
      UNBLOCK_INPUT_RESIGNAL ();
      if (WindowMapped)
	{
	  XMapWindow (XXwindow);
	  XSelectInput (XXwindow, KeyPressed | ExposeWindow | ButtonPressed
#ifndef HPUX
			| ButtonReleased
#endif
			| ExposeRegion | ExposeCopy);
	  ++screen_garbaged;
	  XFlush ();
	}
      return Qt;
    }
  else
    {
      UNBLOCK_INPUT_RESIGNAL ();
      message ("Could not recreate window.");
      return Qnil;
    }
}


DEFUN ("x-set-internal-border-width", Fx_set_internal_border_width,
       Sx_set_internal_border_width, 1, 1, "NSet internal border width: ",
  "Set width of internal border to WIDTH, in the X window system.")
  (internalborderwidth)
     register Lisp_Object internalborderwidth;
{
  WindowInfo WinInfo;
  BLOCK_INPUT_DECLARE ()