/* NS Selection processing for emacs
   Copyright (C) 1993, 1994 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 2, 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.  */

#import <appkit/appkit.h>

#include "config.h"
#include "lisp.h"
#include "nsterm.h"
#include "dispextern.h"
#include "frame.h"
#include "blockinput.h"
#include "termhooks.h"
#include "multi-frame.h"

#define CUT_BUFFER_SUPPORT

static NXAtom NXSecondaryPboard;

static NXAtom symbol_to_nx_atom (Lisp_Object sym)
   {
   CHECK_SYMBOL(sym,0);
   if (EQ (sym, QPRIMARY))     return NXGeneralPboard;
   if (EQ (sym, QSECONDARY))   return NXSecondaryPboard;
   if (EQ (sym, QTEXT))        return NXAsciiPboardType;
   return NXUniqueString(XSYMBOL(sym)->name->data);
   }

static Lisp_Object nx_atom_to_symbol (NXAtom t)
   {
   if (t==NXGeneralPboard)         return QPRIMARY;
   if (t==NXSecondaryPboard)       return QSECONDARY;
   if (t==NXAsciiPboardType)       return QTEXT;
   if (t==NXFilenamePboardType)    return QFILE_NAME;
   if (t==NXTabularTextPboardType) return QTEXT;
   return intern(t);
   }

static Lisp_Object clean_local_selection_data (Lisp_Object obj)
   {
   if (CONSP (obj)
       && INTEGERP (XCONS (obj)->car)
       && CONSP (XCONS (obj)->cdr)
       && INTEGERP (XCONS (XCONS (obj)->cdr)->car)
       && NILP (XCONS (XCONS (obj)->cdr)->cdr))
      obj = Fcons (XCONS (obj)->car, XCONS (obj)->cdr);

   if (CONSP (obj)
       && INTEGERP (XCONS (obj)->car)
       && INTEGERP (XCONS (obj)->cdr))
      {
      if (XINT (XCONS (obj)->car) == 0)
         return XCONS (obj)->cdr;
      if (XINT (XCONS (obj)->car) == -1)
         return make_number (- XINT (XCONS (obj)->cdr));
      }

   if (VECTORP (obj))
      {
      int i;
      int size = XVECTOR (obj)->size;
      Lisp_Object copy;

      if (size == 1)
         return clean_local_selection_data (XVECTOR (obj)->contents [0]);
      copy = Fmake_vector (size, Qnil);
      for (i = 0; i < size; i++)
         XVECTOR (copy)->contents [i]
            = clean_local_selection_data (XVECTOR (obj)->contents [i]);
      return copy;
      }

   return obj;
   }

Lisp_Object ns_string_from_pasteboard(id pb)
   {
   int i;
   NXAtom type;
   Lisp_Object ret;
   int l;
   char *d;

   for (i=0;ns_return_types[i];i++);
   type=[pb findAvailableTypeFrom:ns_return_types num:i];
   if (type==0) return Qnil;
   if (![pb readType:type data: &d length: &l])
      Fsignal (Qerror, Fcons (build_string ("pasteboard doesn't contain valid data"), Qnil));
   ret=make_string (d, l);
   [pb deallocatePasteboardData: d length: l];
   return ret;
   }

void ns_declare_pasteboard(id pb)
   {
   int i;
   for (i=0;ns_send_types[i];i++);
   [pb declareTypes:ns_send_types num:i owner:NXApp];
   }

void ns_undeclare_pasteboard(id pb)
   {
   const NXAtom types[] = { };
   [pb declareTypes:types num:0 owner:nil];
   }

void ns_string_to_pasteboard(id pb,Lisp_Object str)
   {
   int i;

   if (EQ (str, Qnil))
      {
      const NXAtom types[] = { };
      [pb declareTypes:types num:0 owner:nil];
      }
   else
      {
      CHECK_STRING(str, 0);
      for (i=0;ns_send_types[i];i++);
      [pb declareTypes:ns_send_types num:i owner:nil];
      for (i--;i>=0;i--)
         [pb writeType:ns_send_types[i]
                  data:XSTRING(str)->data length:XSTRING(str)->size];
      }
   }

static Lisp_Object ns_get_local_selection(Lisp_Object selection_name,
                                          Lisp_Object target_type)
   {
   Lisp_Object local_value;
   Lisp_Object handler_fn, value, type, check;
   int count;

   local_value = assq_no_quit (selection_name, Vselection_alist);

   if (NILP (local_value)) return Qnil;

   count = specpdl_ptr - specpdl;
   specbind (Qinhibit_quit, Qt);
   CHECK_SYMBOL (target_type, 0);
   handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
   if (!NILP (handler_fn))
      value=call3(handler_fn, selection_name, target_type,
                  XCONS (XCONS (local_value)->cdr)->car);
   else
      value=Qnil;
   unbind_to (count, Qnil);

   check=value;
   if (CONSP(value) && SYMBOLP(XCONS (value)->car))
      {
      type=XCONS(value)->car;
      check=XCONS(value)->cdr;
      }

   if (STRINGP (check) || VECTORP (check) || SYMBOLP (check)
       || INTEGERP (check) || NILP (value))
      return value;

   if (CONSP (check)
       && INTEGERP (XCONS (check)->car)
       && (INTEGERP (XCONS (check)->cdr)||
           (CONSP (XCONS (check)->cdr)
            && INTEGERP (XCONS (XCONS (check)->cdr)->car)
            && NILP (XCONS (XCONS (check)->cdr)->cdr))))
      return value;

   return Fsignal (Qerror,
                   Fcons (build_string ("invalid data returned by selection-conversion function"),
                          Fcons (handler_fn, Fcons (value, Qnil))));
   }

static Lisp_Object ns_get_foreign_selection(Lisp_Object symbol, Lisp_Object target)
   {
   id pb;
   pb=[Pasteboard newName:symbol_to_nx_atom(symbol)];
   return ns_string_from_pasteboard(pb);
   }

void ns_handle_selection_request(struct input_event *event)
   {
   id pb=(id)event->x;
   NXAtom type=(NXAtom)event->y;
   Lisp_Object selection_name,selection_data,target_symbol,data;
   Lisp_Object successful_p,rest;

   selection_name=nx_atom_to_symbol([pb name]);
   target_symbol=nx_atom_to_symbol(type);
   selection_data= assq_no_quit (selection_name, Vselection_alist);
   successful_p=Qnil;

   if (NILP (selection_data)) goto DONE;

   data = ns_get_local_selection (selection_name, target_symbol);
   if (!NILP(data))
      {
      if (STRINGP(data))
         [pb writeType:type data:XSTRING(data)->data length:XSTRING(data)->size];
      successful_p=Qt;
      }

 DONE:
   if (!EQ(Vsent_selection_hooks,Qunbound))
      {
      for(rest=Vsent_selection_hooks;CONSP(rest); rest=Fcdr(rest))
         call3 (Fcar(rest), selection_name, target_symbol, successful_p);
      }
   }

void ns_handle_selection_clear(struct input_event *event)
   {
   id pb=(id)event->x;
   Lisp_Object selection_name,selection_data,rest;

   selection_name=nx_atom_to_symbol([pb name]);
   selection_data=assq_no_quit (selection_name, Vselection_alist);
   if (NILP(selection_data)) return;

   if (EQ (selection_data, Fcar (Vselection_alist)))
     Vselection_alist = Fcdr (Vselection_alist);
   else
      {
      for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
         if (EQ (selection_data, Fcar (Fcdr (rest))))
	    Fsetcdr(rest,Fcdr(Fcdr(rest)));
      }

   if (!EQ(Vlost_selection_hooks,Qunbound))
      {
      for(rest=Vlost_selection_hooks;CONSP(rest); rest=Fcdr(rest))
         call1 (Fcar(rest), selection_name);
      }
   }

DEFUN ("ns-own-selection-internal", Fns_own_selection_internal,
       Sns_own_selection_internal, 2, 2, 0, "Assert a selection.\n\
For more details see the window system specific function.")
  (selection_name, selection_value)
Lisp_Object selection_name,selection_value;
   {
   id pb;
   Lisp_Object old_value, new_value;

   check_ns();
   CHECK_SYMBOL (selection_name, 0);
   if (NILP (selection_value)) error ("selection-value may not be nil.");
   pb=[Pasteboard newName:symbol_to_nx_atom(selection_name)];
   ns_declare_pasteboard(pb);
   old_value=assq_no_quit (selection_name, Vselection_alist);
   new_value= Fcons(selection_name, Fcons(selection_value, Qnil));
   if (NILP(old_value))
      Vselection_alist=Fcons(new_value,Vselection_alist);
   else
      Fsetcdr(old_value,Fcdr(new_value));
   /* XXX An evil hack, but a necessary one I fear XXX */
      {
      struct input_event ev;
      ev.kind=selection_request_event;
      ev.modifiers=0;
      ev.code=0;
      ev.x=(int)pb;
      ev.y=(int)NXAsciiPboardType;
      ns_handle_selection_request(&ev);
      }
   return selection_value;
   }

DEFUN ("ns-disown-selection-internal", Fns_disown_selection_internal,
       Sns_disown_selection_internal, 1, 2, 0,
       "If we own the selection SELECTION, disown it.")
  (selection_name, time)
Lisp_Object selection_name,time;
   {
   id pb;
   check_ns();
   CHECK_SYMBOL (selection_name, 0);
   if (NILP(assq_no_quit (selection_name, Vselection_alist))) return Qnil;

   pb=[Pasteboard newName:symbol_to_nx_atom(selection_name)];
   ns_undeclare_pasteboard(pb);
   return Qt;
   }

DEFUN ("ns-selection-exists-p", Fns_selection_exists_p, Sns_selection_exists_p,
       0, 1, 0, "Whether there is an owner for the given selection.\n\
The arg should be the name of the selection in question, typically one of\n\
the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
\(Those are literal upper-case symbol names.)\n\
For convenience, the symbol nil is the same as `PRIMARY',\n\
and t is the same as `SECONDARY'.)")
  (selection)
Lisp_Object selection;
   {
   id pb;
   const NXAtom *types;

   check_ns();
   CHECK_SYMBOL (selection, 0);
   if (EQ (selection, Qnil)) selection = QPRIMARY;
   if (EQ (selection, Qt)) selection = QSECONDARY;
   pb=[Pasteboard newName:symbol_to_nx_atom(selection)];
   types=[pb types];
   return (*types==0) ? Qnil : Qt;
   }

DEFUN ("ns-selection-owner-p", Fns_selection_owner_p, Sns_selection_owner_p,
       0, 1, 0,
  "Whether the current Emacs process owns the given selection.\n\
The arg should be the name of the selection in question, typically one of\n\
the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
\(Those are literal upper-case symbol names.)\n\
For convenience, the symbol nil is the same as `PRIMARY',\n\
and t is the same as `SECONDARY'.)")
  (selection)
Lisp_Object selection;
   {
   check_ns();
   CHECK_SYMBOL (selection, 0);
   if (EQ (selection, Qnil)) selection = QPRIMARY;
   if (EQ (selection, Qt)) selection = QSECONDARY;
   return (NILP (Fassq (selection, Vselection_alist))) ? Qnil : Qt;
   }

DEFUN ("ns-get-selection-internal", Fns_get_selection_internal,
       Sns_get_selection_internal, 2, 2, 0,
  "Return text selected from some pasteboard.\n\
SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
\(Those are literal upper-case symbol names.)\n\
TYPE is the type of data desired, typically `STRING'.")
  (selection_name, target_type)
Lisp_Object selection_name, target_type;
   {
   Lisp_Object val;

   check_ns();
   CHECK_SYMBOL(selection_name, 0);
   CHECK_SYMBOL(target_type,0);
   val= ns_get_local_selection(selection_name,target_type);
   if (NILP(val))
      val= ns_get_foreign_selection(selection_name,target_type);
   if (CONSP(val) && SYMBOLP (Fcar(val)))
      {
      val = Fcdr(val);
      if (CONSP (val) && NILP (Fcdr(val)))
         val = Fcar(val);
      }
   val = clean_local_selection_data (val);
   return val;
   }

#ifdef CUT_BUFFER_SUPPORT
DEFUN ("ns-get-cut-buffer-internal", Fns_get_cut_buffer_internal,
       Sns_get_cut_buffer_internal, 1, 1, 0,
  "Returns the value of the named cut buffer.")
  (buffer)
Lisp_Object buffer;
   {
   id pb;
   check_ns();
   pb=[Pasteboard newName:symbol_to_nx_atom(buffer)];
   return ns_string_from_pasteboard(pb);
   }

DEFUN ("ns-rotate-cut-buffers-internal", Fns_rotate_cut_buffers_internal,
       Sns_rotate_cut_buffers_internal, 1, 1, 0,
   "Rotate the values of the cut buffers by the given number of steps;\n\
 positive means move values forward, negative means backward.")
  (n)
     Lisp_Object n;
   {
   /* XXX This function is unimplemented under NeXTstep XXX */
   return Qnil;
   }

DEFUN ("ns-store-cut-buffer-internal", Fns_store_cut_buffer_internal,
       Sns_store_cut_buffer_internal, 2, 2, 0,
  "Sets the value of the named cut buffer (typically CUT_BUFFER0).")
  (buffer, string)
Lisp_Object buffer, string;
   {
   id pb;
   check_ns();
   pb=[Pasteboard newName:symbol_to_nx_atom(buffer)];
   ns_string_to_pasteboard(pb,string);
   return Qnil;
   }
#endif

void nxatoms_of_nsselect (void)
   {
   NXSecondaryPboard=NXUniqueString("NeXT secondary pasteboard name");
   }

void syms_of_nsselect (void)
   {
   defsubr (&Sns_disown_selection_internal);
   defsubr (&Sns_get_selection_internal);
   defsubr (&Sns_own_selection_internal);
   defsubr (&Sns_selection_exists_p);
   defsubr (&Sns_selection_owner_p);
#ifdef CUT_BUFFER_SUPPORT
   defsubr (&Sns_get_cut_buffer_internal);
   defsubr (&Sns_rotate_cut_buffers_internal);
   defsubr (&Sns_store_cut_buffer_internal);
#endif
   }
