This is nsselect.m in view mode; [Download] [Up]
/* 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
}
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.