x11fns.c

早期freebsd实现

/* Functions for the X window system.
   Copyright (C) 1988, 1990 Free Software Foundation.

This file is part of GNU Emacs.

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)
any later version.

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING.  If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */

/* Written by Yakim Martillo; rearranged by Richard Stallman.  */
/* Color and other features added by Robert Krawitz*/
/* Converted to X11 by Robert French */

#include <stdio.h>
#ifdef NULL
#undef NULL
#endif
#include <signal.h>
#include "config.h"

/* Get FIONREAD, if it is available.  */
#ifdef USG
#include <termio.h>
#include <fcntl.h>
#else /* not USG */
#ifndef VMS
#include <sys/ioctl.h>
#endif /* not VMS */
#endif /* not USG */

/* Allow m- file to inhibit use of interrupt-driven input.  */
#ifdef BROKEN_FIONREAD
#undef FIONREAD
#endif

/* We are unable to use interrupts if FIONREAD is not available,
   so flush SIGIO so we won't try.  */
#ifndef FIONREAD
#ifdef SIGIO
#undef SIGIO
#endif
#endif

#include "lisp.h"
#include "window.h"
#include "x11term.h"
#include "dispextern.h"
#include "termchar.h"
#ifdef USG
#include <time.h>
#else
#include <sys/time.h>
#endif
#include <fcntl.h>
#include <setjmp.h>

#ifdef HAVE_X_WINDOWS

#define abs(x) ((x < 0) ? ((x)) : (x))
#define sgn(x) ((x < 0) ? (-1) : (1))
#define min(a,b) ((a) < (b) ? (a) : (b))
#define max(a,b) ((a) > (b) ? (a) : (b))
  
/* Non-nil if Emacs is running with an X window for display.
   Nil if Emacs is run on an ordinary terminal.  */

Lisp_Object Vxterm;

Lisp_Object Vx_mouse_pos;
Lisp_Object Vx_mouse_abs_pos;

Lisp_Object Vx_mouse_item;

extern Lisp_Object MouseMap;

extern Lisp_Object minibuf_window;
extern int minibuf_prompt_width;

extern XEvent *XXm_queue[XMOUSEBUFSIZE];
extern int XXm_queue_num;
extern int XXm_queue_in;
extern int XXm_queue_out;
extern char *fore_color;
extern char *back_color;
extern char *brdr_color;
extern char *mous_color;
extern char *curs_color;

extern unsigned long fore;
extern unsigned long back;
extern unsigned long brdr;
extern unsigned long curs;

extern int XXborder;
extern int XXInternalBorder;

extern char *progname;

extern XFontStruct *fontinfo;
extern Font XXfid;
extern GC XXgc_norm,XXgc_rev,XXgc_curs,XXgc_temp;
extern XGCValues XXgcv;
extern int XXfontw,XXfonth,XXbase,XXisColor;
extern Colormap XXColorMap;

extern int PendingExposure;
extern char *default_window;
extern char *desiredwindow;

extern int XXscreen;
extern Window XXwindow;
extern Cursor EmacsCursor;
extern short MouseCursor[], MouseMask[];
extern char *XXcurrentfont;
extern int informflag;

extern int WindowMapped;
extern int CurHL;
extern int pixelwidth, pixelheight;
extern int XXpid;

extern char *XXidentity;

extern Display *XXdisplay;
extern int bitblt, CursorExists, VisibleX, VisibleY;

check_xterm ()
{
	if (NULL (Vxterm))
		error ("Terminal does not understand X protocol.");
}

DEFUN ("x-set-bell", Fx_set_bell, Sx_set_bell, 1, 1, "P",
  "For X window system, set audible vs visible bell.\n\
With non-nil argument (prefix arg), use visible bell; otherwise, audible bell.")
   (arg)
     Lisp_Object arg;
{
	BLOCK_INPUT_DECLARE ();

	check_xterm ();
	BLOCK_INPUT ();
	if (!NULL (arg))
		XSetFlash ();
	else
		XSetFeep ();
	UNBLOCK_INPUT ();
	return arg;
}

DEFUN ("x-flip-color", Fx_flip_color, Sx_flip_color, 0, 0, "",
  "Toggle the background and foreground colors")
  ()
{
	check_xterm ();
	XFlipColor ();
	return Qt;
}

DEFUN ("x-set-foreground-color", Fx_set_foreground_color,
       Sx_set_foreground_color, 1, 1, "sSet foregroud color:  ",
       "Set foreground (text) color to COLOR.")
  (arg)
     Lisp_Object arg;
{
	XColor cdef;
	BLOCK_INPUT_DECLARE ();
	char *save_color;

	save_color = fore_color;
	check_xterm ();
	CHECK_STRING (arg,1);
	fore_color = (char *) xmalloc (XSTRING (arg)->size + 1);
	bcopy (XSTRING (arg)->data, fore_color, XSTRING (arg)->size + 1);

	BLOCK_INPUT ();

	if (fore_color && XXisColor &&
	    XParseColor (XXdisplay, XXColorMap, fore_color, &cdef) &&
	    XAllocColor(XXdisplay, XXColorMap, &cdef))
		fore = cdef.pixel;
	else
		if (fore_color && !strcmp (fore_color, "black"))
			fore = BlackPixel (XXdisplay, XXscreen);
		else
			if (fore_color && !strcmp (fore_color, "white"))
				fore = WhitePixel (XXdisplay, XXscreen);
			else
				fore_color = save_color;

	XSetForeground(XXdisplay, XXgc_norm, fore);
	XSetBackground(XXdisplay, XXgc_rev, fore);
	
	Fredraw_display ();
	UNBLOCK_INPUT ();

	XFlush (XXdisplay);
	return Qt;
}

DEFUN ("x-set-background-color", Fx_set_background_color,
       Sx_set_background_color, 1, 1, "sSet background color: ",
       "Set background color to COLOR.")
  (arg)
     Lisp_Object arg;
{
	XColor cdef;
	BLOCK_INPUT_DECLARE ();
	char *save_color;

	check_xterm ();
	CHECK_STRING (arg,1);
	save_color = back_color;
	back_color = (char *) xmalloc (XSTRING (arg)->size + 1);
	bcopy (XSTRING (arg)->data, back_color, XSTRING (arg)->size + 1);

	BLOCK_INPUT ();

	if (back_color && XXisColor &&
	    XParseColor (XXdisplay, XXColorMap, back_color, &cdef) &&
	    XAllocColor(XXdisplay, XXColorMap, &cdef))
		back = cdef.pixel;
	else
		if (back_color && !strcmp (back_color, "white"))
			back = WhitePixel (XXdisplay, XXscreen);
		else
			if (back_color && !strcmp (back_color, "black"))
				back = BlackPixel (XXdisplay, XXscreen);
			else
				back_color = save_color;

	XSetBackground (XXdisplay, XXgc_norm, back);
	XSetForeground (XXdisplay, XXgc_rev, back);
	XSetForeground (XXdisplay, XXgc_curs, back);
	XSetWindowBackground(XXdisplay, XXwindow, back);
	XClearArea (XXdisplay, XXwindow, 0, 0,
		    screen_width*XXfontw+2*XXInternalBorder,
		    screen_height*XXfonth+2*XXInternalBorder, 0);
	
	UNBLOCK_INPUT ();
	Fredraw_display ();

	XFlush (XXdisplay);
	return Qt;
}

DEFUN ("x-set-border-color", Fx_set_border_color, Sx_set_border_color, 1, 1,
       "sSet border color: ",
       "Set border color to COLOR.")
  (arg)
     Lisp_Object arg;
{
	XColor cdef;
	BLOCK_INPUT_DECLARE ();

	check_xterm ();
	CHECK_STRING (arg,1);
	brdr_color= (char *) xmalloc (XSTRING (arg)->size + 1);
	bcopy (XSTRING (arg)->data, brdr_color, XSTRING (arg)->size + 1);

	BLOCK_INPUT ();

	if (brdr_color && XXisColor &&
	    XParseColor (XXdisplay, XXColorMap, brdr_color, &cdef) &&
	    XAllocColor(XXdisplay, XXColorMap, &cdef))
		brdr = cdef.pixel;
	else
		if (brdr_color && !strcmp (brdr_color, "black"))
			brdr = BlackPixel (XXdisplay, XXscreen);
		else
			if (brdr_color && !strcmp (brdr_color, "white"))
				brdr = WhitePixel (XXdisplay, XXscreen);
			else {
				brdr_color = "black";
				brdr = BlackPixel (XXdisplay, XXscreen);
			}

	if (XXborder) {
		XSetWindowBorder(XXdisplay, XXwindow, brdr);
		XFlush (XXdisplay);
	}
	
	UNBLOCK_INPUT ();

	return Qt;
}

DEFUN ("x-set-cursor-color", Fx_set_cursor_color, Sx_set_cursor_color, 1, 1,
       "sSet text cursor color: ",
       "Set text cursor color to COLOR.")
  (arg)
     Lisp_Object arg;
{
	XColor cdef;
	BLOCK_INPUT_DECLARE ();
	char *save_color;

	check_xterm ();
	CHECK_STRING (arg,1);
	save_color = curs_color;
	curs_color = (char *) xmalloc (XSTRING (arg)->size + 1);
	bcopy (XSTRING (arg)->data, curs_color, XSTRING (arg)->size + 1);

	BLOCK_INPUT ();

	if (curs_color && XXisColor &&
	    XParseColor (XXdisplay, XXColorMap, curs_color, &cdef) &&
	    XAllocColor(XXdisplay, XXColorMap, &cdef))
		curs = cdef.pixel;
	else
		if (curs_color && !strcmp (curs_color, "black"))
			curs = BlackPixel (XXdisplay, XXscreen);
		else
			if (curs_color && !strcmp (curs_color, "white"))
				curs = WhitePixel (XXdisplay, XXscreen);
			else
				curs_color = save_color;

	XSetBackground(XXdisplay, XXgc_curs, curs);
	
	CursorToggle ();
	CursorToggle ();

	UNBLOCK_INPUT ();
	return Qt;
}

DEFUN ("x-set-mouse-color", Fx_set_mouse_color, Sx_set_mouse_color, 1, 1,
       "sSet mouse cursor color: ",
       "Set mouse cursor color to COLOR.")
  (arg)
     Lisp_Object arg;
{
  BLOCK_INPUT_DECLARE ();
  char *save_color;

  check_xterm ();
  CHECK_STRING (arg,1);
  save_color = mous_color;
  mous_color = (char *) xmalloc (XSTRING (arg)->size + 1);
  bcopy (XSTRING (arg)->data, mous_color, XSTRING (arg)->size + 1);

  BLOCK_INPUT ();

  if (! x_set_cursor_colors ())
    mous_color = save_color;

  XFlush (XXdisplay);
	
  UNBLOCK_INPUT ();
  return Qt;
}   

/* Set the actual X cursor colors from `mous_color' and `back_color'.  */

int
x_set_cursor_colors ()
{
  XColor forec, backc;

  char	 *useback;

  /* USEBACK is the background color, but on monochrome screens
     changed if necessary not to match the mouse.  */

  useback = back_color;

  if (!XXisColor && !strcmp (mous_color, back_color))
    {
      if (strcmp (back_color, "white"))
	useback = "white";
      else
	useback = "black";
    }

  if (XXisColor && mous_color
      && XParseColor (XXdisplay, XXColorMap, mous_color, &forec)
      && XParseColor (XXdisplay, XXColorMap, useback, &backc))
    {
      XRecolorCursor (XXdisplay, EmacsCursor, &forec, &backc);
      return 1;
    }
  else return 0;
}

DEFUN ("x-color-p", Fx_color_p, Sx_color_p, 0, 0, 0,
       "Returns t if the display is a color X terminal.")
  ()
{
	check_xterm ();

	if (XXisColor)
		return Qt;
	else
		return Qnil;
}
	
DEFUN ("x-get-foreground-color", Fx_get_foreground_color,
       Sx_get_foreground_color, 0, 0, 0,
       "Returns the color of the foreground, as a string.")
  ()
{
	Lisp_Object string;

	check_xterm ();
	string = build_string (fore_color);
	return string;
}

DEFUN ("x-get-background-color", Fx_get_background_color,
       Sx_get_background_color, 0, 0, 0,
       "Returns the color of the background, as a string.")
  ()
{
	Lisp_Object string;

	check_xterm ();
	string = build_string (back_color);
	return string;
}

DEFUN ("x-get-border-color", Fx_get_border_color,
       Sx_get_border_color, 0, 0, 0,
       "Returns the color of the border, as a string.")
  ()
{
	Lisp_Object string;

	check_xterm ();
	string = build_string (brdr_color);
	return string;
}

DEFUN ("x-get-cursor-color", Fx_get_cursor_color,
       Sx_get_cursor_color, 0, 0, 0,
       "Returns the color of the cursor, as a string.")
  ()
{
	Lisp_Object string;

	check_xterm ();
	string = build_string (curs_color);
	return string;
}

DEFUN ("x-get-mouse-color", Fx_get_mouse_color,
       Sx_get_mouse_color, 0, 0, 0,
       "Returns the color of the mouse cursor, as a string.")
  ()
{
	Lisp_Object string;

	check_xterm ();
	string = build_string (mous_color);
	return string;
}

DEFUN ("x-get-default", Fx_get_default, Sx_get_default, 1, 1, 0,
       "Get default for X-window attribute ATTRIBUTE from the system.\n\
ATTRIBUTE must be a string.\n\
Returns nil if attribute default isn't specified.")
  (arg)
     Lisp_Object arg;
{
	char *default_name, *value;

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

#ifdef XBACKWARDS