1 files changed, 624 insertions, 0 deletions

diff --git a/src/nsselect.m b/src/nsselect.m
new file mode 100644
index 00000000000..a999fc38365
--- /dev/null
+++ b/src/nsselect.m
@@ -0,0 +1,624 @@
+/* NeXT/Open/GNUstep / MacOSX Cocoa selection processing for emacs.
+   Copyright (C) 1993, 1994, 2005, 2006, 2008,
+   Free Software Foundation, Inc.
+
+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 3, 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, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.
+
+Originally by Carl Edman
+Updated by Christian Limpach (chris@nice.ch)
+OpenStep/Rhapsody port by Scott Bender (sbender@harmony-ds.com)
+MacOSX/Aqua port by Christophe de Dinechin (descubes@earthlink.net)
+GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu)
+
+*/
+
+#include "config.h"
+#include "lisp.h"
+#include "nsterm.h"
+#include "termhooks.h"
+
+#define CUT_BUFFER_SUPPORT
+
+Lisp_Object QPRIMARY, QSECONDARY, QTEXT, QFILE_NAME;
+
+static Lisp_Object Vns_sent_selection_hooks;
+static Lisp_Object Vns_lost_selection_hooks;
+static Lisp_Object Vselection_alist;
+static Lisp_Object Vselection_converter_alist;
+
+/* 23: new */
+/* Coding system for communicating with other programs. */
+static Lisp_Object Vselection_coding_system;
+/* Coding system for the next communicating with other programs. */
+static Lisp_Object Vnext_selection_coding_system;
+static Lisp_Object Qforeign_selection;
+
+NSString *NXSecondaryPboard;
+
+
+
+/* ==========================================================================
+
+    Internal utility functions
+
+   ========================================================================== */
+
+
+static NSString *
+symbol_to_nsstring (Lisp_Object sym)
+{
+  CHECK_SYMBOL (sym);
+  if (EQ (sym, QPRIMARY))     return NSGeneralPboard;
+  if (EQ (sym, QSECONDARY))   return NXSecondaryPboard;
+  if (EQ (sym, QTEXT))        return NSStringPboardType;
+  return [NSString stringWithUTF8String: XSTRING (XSYMBOL (sym)->xname)->data];
+}
+
+
+static Lisp_Object
+ns_string_to_symbol (NSString *t)
+{
+  if ([t isEqualToString: NSGeneralPboard])
+    return QPRIMARY;
+  if ([t isEqualToString: NXSecondaryPboard])
+    return QSECONDARY;
+  if ([t isEqualToString: NSStringPboardType])
+    return QTEXT;
+  if ([t isEqualToString: NSFilenamesPboardType])
+    return QFILE_NAME;
+  if ([t isEqualToString: NSTabularTextPboardType])
+    return QTEXT;
+  return intern ([t UTF8String]);
+}
+
+
+static Lisp_Object
+clean_local_selection_data (Lisp_Object obj)
+{
+  if (CONSP (obj)
+      && INTEGERP (XCAR (obj))
+      && CONSP (XCDR (obj))
+      && INTEGERP (XCAR (XCDR (obj)))
+      && NILP (XCDR (XCDR (obj))))
+    obj = Fcons (XCAR (obj), XCDR (obj));
+
+  if (CONSP (obj)
+      && INTEGERP (XCAR (obj))
+      && INTEGERP (XCDR (obj)))
+    {
+      if (XINT (XCAR (obj)) == 0)
+        return XCDR (obj);
+      if (XINT (XCAR (obj)) == -1)
+        return make_number (- XINT (XCDR (obj)));
+    }
+
+  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;
+}
+
+
+static void
+ns_declare_pasteboard (id pb)
+{
+  [pb declareTypes: ns_send_types owner: NSApp];
+}
+
+
+static void
+ns_undeclare_pasteboard (id pb)
+{
+  [pb declareTypes: [NSArray array] owner: nil];
+}
+
+
+static void
+ns_string_to_pasteboard_internal (id pb, Lisp_Object str, NSString *gtype)
+{
+  if (EQ (str, Qnil))
+    {
+      [pb declareTypes: [NSArray array] owner: nil];
+    }
+  else
+    {
+      char *utfStr;
+      NSString *type, *nsStr;
+      NSEnumerator *tenum;
+
+      CHECK_STRING (str);
+
+      utfStr = XSTRING (str)->data;
+      nsStr = [NSString stringWithUTF8String: utfStr];
+
+      if (gtype == nil)
+        {
+          [pb declareTypes: ns_send_types owner: nil];
+          tenum = [ns_send_types objectEnumerator];
+          while ( (type = [tenum nextObject]) )
+            [pb setString: nsStr forType: type];
+        }
+      else
+        {
+          [pb setString: nsStr forType: gtype];
+        }
+    }
+}
+
+
+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);
+  handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
+  if (!NILP (handler_fn))
+    value =call3 (handler_fn, selection_name, target_type,
+                XCAR (XCDR (local_value)));
+  else
+    value =Qnil;
+  unbind_to (count, Qnil);
+
+  check =value;
+  if (CONSP (value) && SYMBOLP (XCAR (value)))
+    {
+      type = XCAR (value);
+      check = XCDR (value);
+    }
+
+  if (STRINGP (check) || VECTORP (check) || SYMBOLP (check)
+      || INTEGERP (check) || NILP (value))
+    return value;
+
+  if (CONSP (check)
+      && INTEGERP (XCAR (check))
+      && (INTEGERP (XCDR (check))||
+          (CONSP (XCDR (check))
+           && INTEGERP (XCAR (XCDR (check)))
+           && NILP (XCDR (XCDR (check))))))
+    return value;
+
+  Fsignal (Qquit, 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 =[NSPasteboard pasteboardWithName: symbol_to_nsstring (symbol)];
+  return ns_string_from_pasteboard (pb);
+}
+
+
+static void
+ns_handle_selection_request (struct input_event *event)
+{
+  id pb =(id)event->x;
+  NSString *type =(NSString *)event->y;
+  Lisp_Object selection_name, selection_data, target_symbol, data;
+  Lisp_Object successful_p, rest;
+
+  selection_name =ns_string_to_symbol ([(NSPasteboard *)pb name]);
+  target_symbol =ns_string_to_symbol (type);
+  selection_data = assq_no_quit (selection_name, Vselection_alist);
+  successful_p =Qnil;
+
+  if (!NILP (selection_data))
+    {
+      data = ns_get_local_selection (selection_name, target_symbol);
+      if (!NILP (data))
+        {
+          if (STRINGP (data))
+            ns_string_to_pasteboard_internal (pb, data, type);
+          successful_p =Qt;
+        }
+    }
+
+  if (!EQ (Vns_sent_selection_hooks, Qunbound))
+    {
+      for (rest =Vns_sent_selection_hooks;CONSP (rest); rest =Fcdr (rest))
+        call3 (Fcar (rest), selection_name, target_symbol, successful_p);
+    }
+}
+
+
+static void
+ns_handle_selection_clear (struct input_event *event)
+{
+  id pb = (id)event->x;
+  Lisp_Object selection_name, selection_data, rest;
+
+  selection_name =ns_string_to_symbol ([(NSPasteboard *)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 (Vns_lost_selection_hooks, Qunbound))
+    {
+      for (rest =Vns_lost_selection_hooks;CONSP (rest); rest =Fcdr (rest))
+        call1 (Fcar (rest), selection_name);
+    }
+}
+
+
+
+/* ==========================================================================
+
+    Functions used externally
+
+   ========================================================================== */
+
+
+Lisp_Object
+ns_string_from_pasteboard (id pb)
+{
+  NSString *type, *str;
+  const char *utfStr;
+
+  type = [pb availableTypeFromArray: ns_return_types];
+  if (type == nil)
+    {
+      Fsignal (Qquit,
+              Fcons (build_string ("empty or unsupported pasteboard type"),
+                    Qnil));
+    return Qnil;
+    }
+
+  /* get the string */
+  if (! (str = [pb stringForType: type]))
+    {
+      NSData *data = [pb dataForType: type];
+      if (data != nil)
+        str = [[NSString alloc] initWithData: data
+                                    encoding: NSUTF8StringEncoding];
+      if (str != nil)
+        {
+          [str autorelease];
+        }
+      else
+        {
+          Fsignal (Qquit,
+                  Fcons (build_string ("pasteboard doesn't contain valid data"),
+                        Qnil));
+          return Qnil;
+        }
+    }
+
+  /* assume UTF8 */
+  NS_DURING
+    {
+      /* EOL conversion: PENDING- is this too simple? */
+      NSMutableString *mstr = [[str mutableCopy] autorelease];
+      [mstr replaceOccurrencesOfString: @"\r\n" withString: @"\n"
+            options: NSLiteralSearch range: NSMakeRange (0, [mstr length])];
+      [mstr replaceOccurrencesOfString: @"\r" withString: @"\n"
+            options: NSLiteralSearch range: NSMakeRange (0, [mstr length])];
+
+      utfStr = [mstr UTF8String];
+      if (!utfStr)
+        utfStr = [mstr cString];
+    }
+  NS_HANDLER
+    {
+      message1 ("ns_string_from_pasteboard: UTF8String failed\n");
+      utfStr = [str lossyCString];
+    }
+  NS_ENDHANDLER
+
+  return build_string (utfStr);
+}
+
+
+void
+ns_string_to_pasteboard (id pb, Lisp_Object str)
+{
+  ns_string_to_pasteboard_internal (pb, str, nil);
+}
+
+
+
+/* ==========================================================================
+
+    Lisp Defuns
+
+   ========================================================================== */
+
+
+DEFUN ("ns-own-selection-internal", Fns_own_selection_internal,
+       Sns_own_selection_internal, 2, 2, 0, "Assert a selection.")
+     (selection_name, selection_value)
+     Lisp_Object selection_name, selection_value;
+{
+  id pb;
+  Lisp_Object old_value, new_value;
+
+  check_ns ();
+  CHECK_SYMBOL (selection_name);
+  if (NILP (selection_value))
+      error ("selection-value may not be nil.");
+  pb =[NSPasteboard pasteboardWithName: symbol_to_nsstring (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)NSStringPboardType;
+    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);
+  if (NILP (assq_no_quit (selection_name, Vselection_alist))) return Qnil;
+
+  pb =[NSPasteboard pasteboardWithName: symbol_to_nsstring (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;
+  NSArray *types;
+
+  check_ns ();
+  CHECK_SYMBOL (selection);
+  if (EQ (selection, Qnil)) selection = QPRIMARY;
+  if (EQ (selection, Qt)) selection = QSECONDARY;
+  pb =[NSPasteboard pasteboardWithName: symbol_to_nsstring (selection)];
+  types =[pb types];
+  return ([types count] == 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);
+  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);
+  CHECK_SYMBOL (target_type);
+  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 =[NSPasteboard pasteboardWithName: symbol_to_nsstring (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. CURRENTLY NOT IMPLEMENTED UNDER NeXTstep.")
+     (n)
+     Lisp_Object n;
+{
+  /* XXX This function is unimplemented under NeXTstep XXX */
+  Fsignal (Qquit, Fcons (build_string (
+      "Warning: ns-rotate-cut-buffers-internal not implemented\n"), Qnil));
+  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 =[NSPasteboard pasteboardWithName: symbol_to_nsstring (buffer)];
+  ns_string_to_pasteboard (pb, string);
+  return Qnil;
+}
+#endif
+
+
+void
+nxatoms_of_nsselect (void)
+{
+  NXSecondaryPboard = @"Selection";
+}
+
+void
+syms_of_nsselect (void)
+{
+  QPRIMARY   = intern ("PRIMARY");      staticpro (&QPRIMARY);
+  QSECONDARY = intern ("SECONDARY");    staticpro (&QSECONDARY);
+  QTEXT      = intern ("TEXT");         staticpro (&QTEXT);
+  QFILE_NAME = intern ("FILE_NAME");    staticpro (&QFILE_NAME);
+
+  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
+
+  Vselection_alist = Qnil;
+  staticpro (&Vselection_alist);
+
+  DEFVAR_LISP ("ns-sent-selection-hooks", &Vns_sent_selection_hooks,
+               "A list of functions to be called when Emacs answers a selection request.\n\
+The functions are called with four arguments:\n\
+  - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
+  - the selection-type which Emacs was asked to convert the\n\
+    selection into before sending (for example, `STRING' or `LENGTH');\n\
+  - a flag indicating success or failure for responding to the request.\n\
+We might have failed (and declined the request) for any number of reasons,\n\
+including being asked for a selection that we no longer own, or being asked\n\
+to convert into a type that we don't know about or that is inappropriate.\n\
+This hook doesn't let you change the behavior of Emacs's selection replies,\n\
+it merely informs you that they have happened.");
+  Vns_sent_selection_hooks = Qnil;
+
+  DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist,
+               "An alist associating X Windows selection-types with functions.\n\
+These functions are called to convert the selection, with three args:\n\
+the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
+a desired type to which the selection should be converted;\n\
+and the local selection value (whatever was given to `x-own-selection').\n\
+\n\
+The function should return the value to send to the X server\n\
+\(typically a string).  A return value of nil\n\
+means that the conversion could not be done.\n\
+A return value which is the symbol `NULL'\n\
+means that a side-effect was executed,\n\
+and there is no meaningful selection value.");
+  Vselection_converter_alist = Qnil;
+
+  DEFVAR_LISP ("ns-lost-selection-hooks", &Vns_lost_selection_hooks,
+               "A list of functions to be called when Emacs loses an X selection.\n\
+\(This happens when some other X client makes its own selection\n\
+or when a Lisp program explicitly clears the selection.)\n\
+The functions are called with one argument, the selection type\n\
+\(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD').");
+  Vns_lost_selection_hooks = Qnil;
+
+/* 23: { */
+  DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system,
+               doc: /* Coding system for communicating with other programs.
+When sending or receiving text via cut_buffer, selection, and clipboard,
+the text is encoded or decoded by this coding system.
+The default value is determined by the system script code.  */);
+  Vselection_coding_system = Qnil;
+
+  DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system,
+               doc: /* Coding system for the next communication with other programs.
+Usually, `selection-coding-system' is used for communicating with
+other programs.  But, if this variable is set, it is used for the
+next communication only.  After the communication, this variable is
+set to nil.  */);
+  Vnext_selection_coding_system = Qnil;
+
+  Qforeign_selection = intern ("foreign-selection");
+  staticpro (&Qforeign_selection);
+/* } */
+
+}