/* 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 */

/*
 * $Revision: 1.10 $
 * $Source: /import/kaplan/stable/distrib/epoch-4.2/src/RCS/x11fns.c,v $
 * $Date: 92/02/23 11:00:47 $
 * $Author: love $
 */
#ifndef LINT
static char rcsid[] = "$Author: love $ $Date: 92/02/23 11:00:47 $ $Source: /import/kaplan/stable/distrib/epoch-4.2/src/RCS/x11fns.c,v $ $Revision: 1.10 $";
#endif

#include <stdio.h>
#include <signal.h>
#include "config.h"

/* Get FIONREAD, if it is available.  */
#ifdef USG
#include <termio.h>
#endif /* USG */
#include <fcntl.h>

#ifndef VMS
#include <sys/ioctl.h>
#endif /* not VMS */

/* 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 "x11term.h"
#include "dispepoch.h"
#include "termchar.h"

#ifdef NULL
#undef NULL
#endif

#include "lisp.h"
#include "window.h"
#include "button.h"
#include "screen.h"
#include "screenX.h"
#include "screenW.h"
#include "xresource.h"

/* X11 includes used; use NIL rather than NULL from lisp.h */

#ifdef HAVE_SOCKETS
#include <sys/socket.h>		/* Must be done before gettime.h. */
#endif
/* Include time.h or sys/time.h or both. */
#include "gettime.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 Display *XD_display;

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
check_xterm ()
{
  if (NIL (Vxterm))
    error ("Terminal does not understand X protocol.");
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::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 (XD_display, (char *) XSTRING (string)->data,
	       XSTRING (string)->size);
  UNBLOCK_INPUT ();

  return Qnil;
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::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 (XD_display, &len);
  string = make_string (d, len);
  UNBLOCK_INPUT ();

  return string;
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
unsigned int
ElispSymbolToShiftBit(sym) Lisp_Object sym;
{
  if (EQ(sym,intern("shift"))) return 1;
  if (EQ(sym,intern("lock"))) return 2;
  if (EQ(sym,intern("control"))) return 4;
  if (EQ(sym,intern("meta"))) return 8;
  if (EQ(sym,intern("mod1"))) return 8;
  if (EQ(sym,intern("mod2"))) return 0x10;
  if (EQ(sym,intern("mod3"))) return 0x20;
  if (EQ(sym,intern("mod4"))) return 0x40;
  if (EQ(sym,intern("mod5"))) return 0x80;
  return 0;
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
       "Rebind KEYCODE, with MODIFIERS, to new string NEWSTRING.\n\
KEYCODE should be the string name of an X KeySym\n\
MODIFIERS should be a list of symbols, specifying the keyboard modifers.\n\
The valid ones are 'shift, 'lock, 'control, 'meta, 'mod1, 'mod2, 'mod3,\n\
'mod4 and 'mod5. 'mod1 and 'meta are equivalent.\n\
MODIFIERS can also be a shift mask, as defined by the X window system.\n\
NEWSTRING should be a key sequence string." ) (keycode, modifiers, newstring)
     Lisp_Object keycode;
     Lisp_Object modifiers;
     Lisp_Object newstring;
{
  KeySym xkey,mkey,*modlist;
  int imod = 0;
  int modrequest;
  int i,j,mod_set = 0;
  unsigned int mmask = 0;
  XModifierKeymap *xkmap;
  KeyCode *map;
  Lisp_Object result = Qt;
  BLOCK_INPUT_DECLARE();

  /* check arguments */
  CHECK_STRING(keycode,0);
  CHECK_STRING(newstring,2);

  if (INTEGERP(modifiers))
      mod_set = mmask = XFASTINT(modifiers);
  else if (EQ(modifiers,Qnil))
    mod_set = 0;
  else if (CONSP(modifiers) || SYMBOLP(modifiers))
    {
      mod_set = 1;
      while (!NIL(modifiers))
	{
	  if (SYMBOLP(modifiers)) mmask |= ElispSymbolToShiftBit(modifiers);
	  if (CONSP(modifiers))
	    {
	      mmask |= ElispSymbolToShiftBit(XCONS(modifiers)->car);
	      modifiers = XCONS(modifiers)->cdr;
	    }
	  else modifiers = Qnil;
	}
    }
  else error("Modifiers must be int, symbol, or symbol list");

  BLOCK_INPUT();
  xkey = XStringToKeysym(XSTRING(keycode)->data);
  if (xkey == NoSymbol)
    {
      UNBLOCK_INPUT();
      error("Invalid X-key name");
    }
 
  xkmap = XGetModifierMapping(XD_display);

  modlist = (KeySym *) alloca(xkmap->max_keypermod * 8 * sizeof(KeySym));

  for ( i = 0 ; i < 8 ; ++i, mmask >>= 1 ) /* step through the bits */
    {
      if (mmask & 1)
	{
	  for ( j = 0, map = xkmap->modifiermap + xkmap->max_keypermod * i ;
	       j < xkmap->max_keypermod ; ++j, ++map )
	    if ( *map 
		&& NoSymbol != (mkey = XKeycodeToKeysym(XD_display,*map,0)))
	      modlist[imod++] = mkey;
	}
    }

  XFreeModifiermap(xkmap);
  if (imod || !mod_set)
    XRebindKeysym(XD_display,xkey,modlist,imod,
		  XSTRING(newstring)->data,XSTRING(newstring)->size);
  else result = Qnil;

  UNBLOCK_INPUT();

  return result;
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::mod-to-shiftmask",Fx_mod_to_shiftmask,Sx_mod_to_shiftmask,1,1,0,
"OBSOLETE. Do not use.\n\
 Given an index from 0..7, returns the shift mask corresponding to that\n\
 modifier under X windows. Indices are Shift, Lock, Control, Mod1, Mod2,\n\
 Mod3, Mod4, Mod5")
        (mod) Lisp_Object mod;
{
  int i,index,result;
  XModifierKeymap *xkmap;
  KeyCode *map;

  CHECK_NUMBER(mod,0);
  index = XFASTINT(mod);
  if (index < 0 || index > 7) return make_number(0);
  return make_number(1<<index);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
FlashScreen (dpy,win,fg,bg,width,height)
     Display *dpy;
     Window win;
     unsigned long fg,bg;
     unsigned width,height;
{
#ifdef HAVE_TIMEVAL
  struct timeval to;
#endif
  XGCValues gcv;
  GC thegc;
  BLOCK_INPUT_DECLARE ();
    
#ifdef XDEBUG
  fprintf (stderr, "XTflash\n");
#endif

  gcv.function = GXxor;
  gcv.foreground = fg ^ bg;
  gcv.fill_style = FillSolid;

  BLOCK_INPUT ();

  thegc = XCreateGC(dpy, win, GCFunction|GCForeground|GCFillStyle, &gcv);
  XFillRectangle (dpy, win, thegc, 0, 0, width, height);
  XFlush (dpy);
    
  UNBLOCK_INPUT ();
#ifdef HAVE_TIMEVAL
  to.tv_sec = 0;
  to.tv_usec = 250000;
    
  select(0, 0, 0, 0, &to);
#endif
  BLOCK_INPUT ();
    
  XFillRectangle (dpy, win, thegc, 0, 0, width, height);
  XFreeGC (dpy, thegc);
  XFlush (dpy);
  
  UNBLOCK_INPUT ();
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::flash-screen", Fepoch_flash_screen, Sepoch_flash_screen,
       0, 1, "",
       "Flash the SCREEN-OR-XWIN. If omitted, flashes the current screen.")
     (screen) Lisp_Object screen;
{
  struct Lisp_Xresource *xr;
  struct Root_Block *rb;
  Lisp_Object result = screen;
  unsigned long foreground,background;

  if (! (xr = ResourceOrScreen(screen,&rb))) return Qnil;

  if (rb)
    {
      XS_DEF;

      foreground = XXRESOURCE(XSTYLE(rb->stylenorm)->foreground)->id;
      background = XXRESOURCE(XSTYLE(rb->stylenorm)->background)->id;

      FlashScreen(xs->display, xs->xid, foreground, background,
		  xs->pixwidth, xs->pixheight); 
      XSET(result, Lisp_Root_Block, rb);
    }
  else
    {
      XWindowAttributes data;
      Status zret;

      HOLD_INPUT(zret = XGetWindowAttributes(xr->dpy,xr->id,&data));

      if (zret == True)
	FlashScreen(xr->dpy, xr->id, AllPlanes, 0, data.width, data.height);
      else
	result = Qnil;
    }
  return result;
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("epoch::set-bell", Fepoch_set_bell, Sepoch_set_bell, 1, 1, "",
       "With non-nil argument, sets Epoch to use a visual bell, otherwise to use an audible bell.")
     (arg) Lisp_Object arg;
{
  BLOCK_INPUT_DECLARE ();

  check_xterm ();
  BLOCK_INPUT ();
  if (!NIL (arg)) XSetFlash ();
  else XSetFeep ();
  UNBLOCK_INPUT ();
  return arg;
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
DEFUN ("x-set-baud", Fx_set_baud, Sx_set_baud, 1, 1, "nBaud Rate: ",
       "Sets the apparent baud rate to influence the refresh algorithm")
    (new_baud_rate)
{
    CHECK_NUMBER (new_baud_rate, 1);
    check_xterm ();
    baud_rate = XINT (new_baud_rate);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
XExitWithCoreDump ()
{
  XCleanUp ();
  abort ();
}

DEFUN ("x-debug", Fx_debug, Sx_debug, 1, 1, 0,
  "ARG non-nil means that X errors should generate a coredump.")
  (arg)
     register Lisp_Object arg;
{
  int (*handler)();

  check_xterm ();
  if (!NIL (arg))
    handler = XExitWithCoreDump;
  else
    {
      extern int XIgnoreError ();
      handler = XIgnoreError;
    }
  XSetErrorHandler(handler);
  XSetIOErrorHandler(handler);
  return (Qnil);
}

XRedrawDisplay ()
{
  Fredraw_display ();
}

XCleanUp ()
{
  Fdo_auto_save (Qt);

#ifdef subprocesses
  kill_buffer_processes (Qnil);
#endif				/* subprocesses */
}

syms_of_xfns ()
{
  /* If not dumping, init_display ran before us, so don't override it.  */
#ifdef CANNOT_DUMP
  if (noninteractive)
#endif
    Vxterm = Qnil;
#if 0
  if (!inhibit_window_system)
#endif
  if (1)
    {
      syms_of_mouse();		/* set up mouse handling stuff */

      defsubr (&Sx_set_baud);
      defsubr (&Sx_store_cut_buffer);
      defsubr (&Sx_get_cut_buffer);
      defsubr (&Sx_rebind_key);
      defsubr (&Sx_mod_to_shiftmask);
      defsubr (&Sepoch_flash_screen);
      defsubr (&Sepoch_set_bell);
    }
}

#endif /* HAVE_X_WINDOWS */