martin/emacs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
Files
586b975c015e01ae666f6322c64408da86fdcdfe
emacs/src/nsselect.m

625 lines
18 KiB
Objective-C
Raw Blame History

/* 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 of the License, 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. If not, see <http://www.gnu.org/licenses/>. */
/*
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);
/* } */
}
// arch-tag: 39d1dde7-06a6-49ff-95a7-0e7af12d2218
Reference in New Issue View Git Blame Copy Permalink