/*
 * tkProperty.c --
 *
 *                                                                                                  This file manages properties for the Tk toolkit,
 *
 * Copyright (c) 1994-1999 Nick-Ing-Simmons
 *
 * All rights reserved.
 *
 * Permission is hereby granted, without written agreement and without
 * license or royalty fees, to use, copy, modify, and distribute this
 * software and its documentation for any purpose, provided that the
 * above copyright notice and the following two paragraphs appear in
 * all copies of this software.
 *
 * IN NO EVENT SHALL THE AUTHOR BE LIABLE TO ANY PARTY FOR
 * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
 * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE AUTHOR
 * HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 * THE AUTHOR SPECIFICALLY DISCLAIMS ANY WARRANTIES,
 * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
 * AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
 * ON AN "AS IS" BASIS, AND THE AUTHOR HAS NO OBLIGATION TO
 * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
 */

#ifndef lint
static char rcsid[] = "$Header$";
#endif

#include "tkPort.h"
#include "tkInt.h"

/* /home/nick/bin/add_protos : Added declarations with prototypes */
static int  PropToResult _ANSI_ARGS_((Tcl_Interp *interp, Tk_Window tkwin, Atom type, unsigned char *p, int format, long unsigned int count));
static int  ArgToProp _ANSI_ARGS_((Tcl_Interp *interp, Tk_Window tkwin, Atom type, int format, Tcl_Obj * arg, unsigned char **prop, long unsigned int *count));
extern int  Tk_PropertyCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj * *args));
static int PropertyExists _ANSI_ARGS_((Tk_Window tkwin, Window xid, Atom key, long unsigned int *sizep));

static int
PropertyExists(tkwin, xid, key, sizep)
Tk_Window tkwin;
Window xid;
Atom key;
long unsigned int *sizep;
{
 unsigned long bytes_after = 0;
 Atom type = None;
 unsigned long count = 0;
 unsigned long bytesafter = 0;
 unsigned char *prop = NULL;
 int format = 0;
 if (!sizep)
  sizep = &bytes_after;
 XGetWindowProperty(Tk_Display(tkwin), xid, key, 0L, 0L, False,
                    AnyPropertyType, &type, &format, &count, sizep, &prop);
 if (prop)
  XFree((char *) prop);
 return format;
}

static int
PropToResult(interp, tkwin, type, p, format, count)
Tcl_Interp *interp;
Tk_Window tkwin;
Atom type;
unsigned char *p;
int format;
long unsigned int count;
{
 if (format == 8)
  {
   Lang_SetBinaryResult(interp,(char *) p, count, TCL_VOLATILE);
  }
 else
  {
   while (count--)
    {
     unsigned long value = 0;
     if (8 * sizeof(unsigned char) == format)
      {
       value = *((unsigned char *) p);
      }
     else if (8 * sizeof(unsigned short) == format)
      {
       value = *((unsigned short *) p);
      }
     else if (8 * sizeof(unsigned int) == format)
      {
       value = *((unsigned int *) p);
      }
     else if (8 * sizeof(unsigned long) == format)
      {
       value = *((unsigned long *) p);
      }
     else
      {
       Tcl_SprintfResult(interp, "No type for format %d", format);
       return TCL_ERROR;
      }
     p += (format / 8);

     if (type == XA_ATOM)
      {
       if ((Atom) value != None)
        Tcl_AppendElement(interp, Tk_GetAtomName(tkwin, value));
      }
     else
      {
       Tcl_IntResults(interp, 1, 1, value);
      }
    }
  }
 return TCL_OK;
}

static int
ArgToProp(interp, tkwin, type, format, arg, prop, count)
Tcl_Interp *interp;
Tk_Window tkwin;
Atom type;
int format;
Tcl_Obj * arg;
unsigned char **prop;
long unsigned int *count;
{
 int result = TCL_OK;
 if (format == 8)
  {
   char *s = Tcl_GetString(arg);
   int l = strlen(s);
   *prop = (unsigned char *) ckalloc(l + 1);
   *count = l + 1;
   strcpy((char *)(*prop), s);
  }
 else
  {
   int valc = 0;
   Tcl_Obj * *valv = NULL;
   result = Tcl_ListObjGetElements(interp, arg, &valc, &valv);
   if (result == TCL_OK)
    {
     unsigned char *p = (unsigned char *) ckalloc(valc * format / 8);
     int i;
     *prop = p;
     *count = valc;
     for (i = 0; i < valc; i++)
      {
       int value = 0;
       result = Tcl_GetIntFromObj(interp, valv[i], &value);
       if (result != TCL_OK)
        {
         if (type == XA_ATOM)
          {
           value = Tk_InternAtom(tkwin, Tcl_GetString(valv[i]));
           result = TCL_OK;
          }
         else
          break;
        }
       if (8 * sizeof(unsigned char) == format)
        {
         *((unsigned char *) p) = value;
        }
       else if (8 * sizeof(unsigned short) == format)
        {
         *((unsigned short *) p) = value;
        }
       else if (8 * sizeof(unsigned int) == format)
        {
         *((unsigned int *) p) = value;
        }
       else if (8 * sizeof(unsigned long) == format)
        {
         *((unsigned long *) p) = value;
        }
       else
        {
         Tcl_SprintfResult(interp, "No type for format %d", format);
         result = TCL_ERROR;
         break;
        }
       p += (format / 8);
      }
     if (result != TCL_OK)
      {
       ckfree(*prop);
       *prop = NULL;
       *count = 0;
      }
    }
  }
 return result;
}

static int ErrorProc _ANSI_ARGS_((ClientData clientData,
				  XErrorEvent *errEventPtr));

static int
ErrorProc(clientData,errEventPtr)
ClientData clientData;
XErrorEvent *errEventPtr;
{
 int *resultPtr = (int *) clientData;
 *resultPtr = TCL_ERROR;
 return 0;
}

int
Tk_PropertyCmd(clientData, interp, argc, args)
ClientData clientData;            /* Main window associated with
                                     * interpreter. */
Tcl_Interp *interp;               /* Current interpreter. */
int argc;                         /* Number of arguments. */
Tcl_Obj * *args;                        /* Argument strings. */
{

 Tk_Window tkwin = (Tk_Window) clientData;
 Tk_Window window;
 Atom atom;
 Window xid;
 int length;
 char c;
 int result = TCL_OK;
 Tk_ErrorHandler errorHandler = NULL;

 if (argc < 3)
  {
 error:
   Tcl_SprintfResult(interp,
                "wrong # args: should be \"%.50s option window ?arg arg ...?\"",
                     Tcl_GetString(args[0]));
   return TCL_ERROR;
  }

 window = Tk_NameToWindow(interp, Tcl_GetString(args[2]), tkwin);
 if (window == NULL)
  return TCL_ERROR;
 tkwin = window;
 Tk_MakeWindowExist(window);
 xid = Tk_WindowId(window);

 c = Tcl_GetString(args[1])[0];
 length = strlen(Tcl_GetString(args[1]));
 if (!c)
  goto error;

 errorHandler = Tk_CreateErrorHandler(Tk_Display(tkwin), -1, -1, -1, ErrorProc, (ClientData) &result);

 if (((c == 'g') && (strncmp(Tcl_GetString(args[1]), "get", length) == 0)) ||
     ((c == 'e') && (strncmp(Tcl_GetString(args[1]), "exists", length) == 0)) ||
     ((c == 'd') && (strncmp(Tcl_GetString(args[1]), "delete", length) == 0))
  )
  {
   if (argc == 5)
    {
     if (!strcmp(Tcl_GetString(args[4]), "root"))
      xid = RootWindowOfScreen(Tk_Screen(tkwin));
     else
      {
       char *end;
       xid = strtoul(Tcl_GetString(args[4]), &end, 10);
       if (*end)
        {
         Tcl_SprintfResult(interp, "Bad number '%s'", Tcl_GetString(args[4]));
         result = TCL_ERROR;
         goto done;
        }
      }
     argc--;
    }
   if (argc != 4)
    {
     Tcl_SprintfResult(interp, "wrong # args: should be \"%.50s %s window Atom ?xid?\"",
                       Tcl_GetString(args[0]), Tcl_GetString(args[1]));
     result = TCL_ERROR;
     goto done;
    }
   else
    {
     Atom atom = Tk_InternAtom(tkwin, Tcl_GetString(args[3]));
     if (c == 'd')
      {
       XDeleteProperty(Tk_Display(tkwin), xid, atom);
       if (result != TCL_OK)
        {
         Tcl_SprintfResult(interp, "XError in XDeleteProperty()");
         goto done;
        }
      }
     else
      {
       long unsigned int size = 0;
       int format = PropertyExists(tkwin, xid, atom, &size);
       if (result != TCL_OK)
        Tcl_SprintfResult(interp, "XError in occured");
       else if (c == 'e')
        {
         Tcl_SetIntObj(Tcl_GetObjResult(interp), format);
        }
       else
        {
         Atom type = None;
         unsigned char *prop = NULL;
         unsigned long count = 0;
         XGetWindowProperty(Tk_Display(tkwin), xid, atom, 0L, size, False,
                         AnyPropertyType, &type, &format, &count, &size, &prop);
         if (result != TCL_OK)
          Tcl_SprintfResult(interp, "XError occured");
         else if (format == 0 || type == None)
          {
           Tcl_SprintfResult(interp, "Property %s does not exist on 0x%lx",
                             Tcl_GetString(args[3]), (unsigned long) xid);
           result = TCL_ERROR;
          }
         else
          {
           Tcl_SetResult(interp, (char *) Tk_GetAtomName(tkwin, type), TCL_STATIC);
           result = PropToResult(interp, tkwin, type, prop, format, count);
          }
         if (prop)
          XFree((char *) prop);
        }
      }
    }
   goto done;
  }
 else if ((c == 'l') && (strncmp(Tcl_GetString(args[1]), "list", length) == 0))
  {
   if (argc == 4)
    {
     if (!strcmp(Tcl_GetString(args[3]), "root"))
      xid = RootWindowOfScreen(Tk_Screen(tkwin));
     else
      {
       char *end;
       xid = strtoul(Tcl_GetString(args[3]), &end, 10);
       if (*end)
        {
         Tcl_SprintfResult(interp, "Bad number '%s'", Tcl_GetString(args[3]));
         result = TCL_ERROR;
         goto done;
        }
      }
     argc--;
    }
   if (argc == 3)
    {
#ifndef WIN32
     int num_prop = 0;
     Atom *list = XListProperties(Tk_Display(tkwin), xid, &num_prop);
     int i;
     for (i = 0; i < num_prop; i++)
      {
       if (list[i] != None)
        Tcl_AppendElement(interp, Tk_GetAtomName(tkwin, list[i]));
      }
     if (list)
      XFree((char *) list);
#endif
    }
  }
 else if ((c == 's') && (strncmp(Tcl_GetString(args[1]), "set", length) == 0))
  {
   int result = TCL_OK;
   if (argc == 8)
    {
     if (!strcmp(Tcl_GetString(args[7]), "root"))
      xid = RootWindowOfScreen(Tk_Screen(tkwin));
     else
      {
       char *end;
       xid = strtoul(Tcl_GetString(args[7]), &end, 10);
       if (*end)
        {
         Tcl_SprintfResult(interp, "Bad number '%s'", Tcl_GetString(args[7]));
         result = TCL_ERROR;
         goto done;
        }
      }
     argc--;
    }
   if (argc != 7)
    {
     Tcl_SprintfResult(interp, "wrong # args: should be \"%.50s %s window Atom type format value ?xid?\"",
                       Tcl_GetString(args[0]), Tcl_GetString(args[1]));
     result = TCL_ERROR;
     goto done;
    }
   else
    {
     Atom atom = Tk_InternAtom(tkwin, Tcl_GetString(args[3]));
     Atom type = Tk_InternAtom(tkwin, Tcl_GetString(args[4]));
     int format = 0;
     result = Tcl_GetIntFromObj(interp, args[5], &format);
     if (result == TCL_OK)
      {
       unsigned char *prop = NULL;
       unsigned long count = 0;
       result = ArgToProp(interp, tkwin, type, format, args[6], &prop, &count);
       if (result == TCL_OK)
        {
         XChangeProperty(Tk_Display(tkwin), xid, atom, type, format,
                         PropModeReplace, prop, count);
         if (prop)
          ckfree(prop);
        }
      }
    }
  }
 else
  {
   Tcl_SprintfResult(interp,
              "bad option \"%.50s\":  must be get, exists, list, delete or set",
                     Tcl_GetString(args[1]));
   result = TCL_ERROR;
  }
 done:
  if (errorHandler)
   Tk_DeleteErrorHandler(errorHandler);
  return result;
}

