This is nsfns.m in view mode; [Download] [Up]
/* Functions for the NeXTstep window system.
Copyright (C) 1989, 1992, 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 <signal.h>
#include "config.h"
#include "lisp.h"
#include "nsterm.h"
#include "frame.h"
#include "window.h"
#include "buffer.h"
#include "dispextern.h"
#include "keyboard.h"
#include "blockinput.h"
#include "multi-frame.h"
#include "regex.h"
#include "termhooks.h"
#ifdef HAVE_NS
/*
* 3.3 supports eight bit "pseudo-color" and is defined under the 3.3
* operating system as an enum with the value "514". This hack allows the
* code in nsfns.m to be compliant with 3.2 and 3.3 (3.2 doesn't define this
* value in the NXWindowDepth enumerated type), as well as letting Emacs
* versions compiled under 3.2 to work properly under 3.3. The only problem is
* systems that have built more modern versions of the compiler from the source
* (like me) that don't match up with the header files anymore. NeXT, of
* course, doesn't place any versioning information in their headers, so in
* this case, I don't know what the correct thing to do is. Maybe just
* outright define it. - darcy
*/
#if !defined(NX_CURRENT_COMPILER_RELEASE)||(NX_CURRENT_COMPILER_RELEASE < 330)
#define NX_EightBitRGBDepth 514
#endif
extern void ns_free_frame_menubar();
extern struct re_pattern_buffer searchbuf;
Lisp_Object Qns_frame_parameter;
/* Alist of elements (REGEXP . IMAGE) for images of icons associated
to frames.*/
Lisp_Object Vns_icon_type_alist;
void check_ns (void)
{
if (ns_current_display == nil)
error ("NeXTstep is not in use or not initialized");
}
/* Nonzero if using NS for display. */
int using_ns_p ()
{
return ns_current_display != nil;
}
static Lisp_Object ns_get_arg (Lisp_Object alist, Lisp_Object param,
char *owner, char *name)
{
Lisp_Object tem;
tem = Fassq (param, alist);
if (!NILP(tem)) return Fcdr(tem);
tem = Fassq (param, Vdefault_frame_alist);
if (!NILP(tem)) return Fcdr(tem);
if (!name) return Qunbound;
tem = Fns_get_resource(owner ? build_string(owner) : Qnil, build_string (name));
if (NILP(tem)) return Qunbound;
if (XTYPE(tem)==Lisp_String)
{
if (!strcmp(XSTRING(tem)->data,"YES")||
!strcmp(XSTRING(tem)->data,"ON")||
!strcmp(XSTRING(tem)->data,"TRUE")) return Qt;
if (!strcmp(XSTRING(tem)->data,"NO")||
!strcmp(XSTRING(tem)->data,"OFF")||
!strcmp(XSTRING(tem)->data,"FALSE")) return Qnil;
}
return tem;
}
static Lisp_Object ns_default_parameter (struct frame *f, Lisp_Object alist,
Lisp_Object prop, Lisp_Object deflt,
char *owner, char *name)
{
Lisp_Object tem;
tem = ns_get_arg (alist, prop, owner, name);
if (EQ (tem, Qunbound)) tem=deflt;
ns_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
return tem;
}
void ns_set_foreground_color (struct frame *f, Lisp_Object arg,
Lisp_Object oldval)
{
if (ns_lisp_to_color(arg,&f->display.ns->face->foreground_color))
{
store_frame_param(f,Qforeground_color,oldval);
error("Unknown color");
}
if (f->display.ns->view != nil)
{
ns_recompute_basic_faces (f);
if (FRAME_VISIBLE_P (f))
redraw_frame (f);
}
}
void ns_set_background_color (struct frame *f, Lisp_Object arg,
Lisp_Object oldval)
{
NXColor col;
id view=f->display.ns->view;
if (ns_lisp_to_color(arg,&col))
{
store_frame_param(f,Qbackground_color,oldval);
error("Unknown color");
}
f->display.ns->face->background_color=col;
if (view != nil)
{
[[view window] setBackgroundColor:col];
[[view window] setBackgroundGray:NXGrayComponent(col)];
ns_recompute_basic_faces (f);
if (FRAME_VISIBLE_P (f))
redraw_frame (f);
}
}
void ns_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
id view=f->display.ns->view;
if (ns_lisp_to_color(arg,&f->display.ns->desired_cursor_color))
{
store_frame_param(f,Qcursor_color,oldval);
error("Unknown color");
}
if (view != nil)
{
extern void ns_dumpcursor(struct frame *f,int nx,int ny);
ns_dumpcursor(f,f->cursor_x,f->cursor_y);
}
}
void ns_set_internal_border_width (struct frame *f, Lisp_Object arg,
Lisp_Object oldval)
{
if (XTYPE(arg)==Lisp_String)
{
arg=Fstring_to_number(arg);
store_frame_param(f,Qinternal_border_width,arg);
}
if (!NUMBERP(arg) || (XFLOATINT(arg)<0))
{
store_frame_param(f,Qinternal_border_width,oldval);
error("Internal border width out of range");
}
f->display.ns->internal_border_width=XFLOATINT(arg);
ns_set_window_size (f, 0, f->width, f->height);
}
void ns_set_visibility (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
Lisp_Object frame;
XSET (frame, Lisp_Frame, f);
if (XTYPE(arg)==Lisp_String)
{
arg=intern(arg);
store_frame_param(f,Qvisibility,arg);
}
if (NILP (arg))
Fmake_frame_invisible (frame, Qt);
else if (EQ (arg, Qicon))
Ficonify_frame (frame);
else
Fmake_frame_visible (frame);
}
void ns_explicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
id view=f->display.ns->view;
if (f->explicit_name && NILP (arg)) update_mode_lines =1;
f->explicit_name = !NILP(arg);
if (NILP (arg))
arg = build_string ([NXApp appName]);
else
CHECK_STRING (arg, 0);
if (! NILP (Fstring_equal (arg, f->name)))
return;
[[view window] setTitle:XSTRING (arg)->data];
f->name = arg;
}
void ns_implicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
id view=f->display.ns->view;
if (f->explicit_name) return;
if (NILP (arg))
arg = build_string ([NXApp appName]);
else
CHECK_STRING (arg, 0);
if (! NILP (Fstring_equal (arg, f->name)))
return;
[[view window] setTitleAsFilename:XSTRING (arg)->data];
f->name = arg;
}
void ns_set_doc_edited (struct frame *f, Lisp_Object arg,
Lisp_Object oldval)
{
id view=f->display.ns->view;
[[view window] setDocEdited:!NILP(arg)];
}
void ns_set_menu_bar_lines (struct frame *f, Lisp_Object arg,
Lisp_Object oldval)
{
if (XTYPE(arg)==Lisp_String)
{
arg=Fstring_to_number(arg);
FRAME_MENU_BAR_LINES(f)=(int)rint(XFLOATINT(arg));
}
if (FRAME_MINIBUF_ONLY_P(f))
return;
if (NILP(arg) || (XTYPE(arg)==Lisp_Int && XINT(arg)==0))
{
if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
ns_free_frame_menubar (f);
FRAME_EXTERNAL_MENU_BAR (f) = 0;
}
else
{
FRAME_EXTERNAL_MENU_BAR (f) = 1;
}
}
void ns_set_icon_type (struct frame *f, Lisp_Object arg,
Lisp_Object oldval)
{
id view=f->display.ns->view;
id image=nil;
unsigned char *name,*fname;
Lisp_Object chain, elt;
if (XTYPE(arg) == Lisp_Symbol)
{
arg=build_string(XSYMBOL(arg)->name->data);
store_frame_param(f,Qicon_type,arg);
}
CHECK_STRING (arg,0);
for (chain = Vns_icon_type_alist;
(image==nil) && XTYPE (chain) == Lisp_Cons;
chain = XCONS (chain)->cdr)
if (XTYPE (elt=XCONS(chain)->car) == Lisp_Cons &&
XTYPE (XCONS(elt)->car) == Lisp_String &&
XTYPE (XCONS(elt)->cdr) == Lisp_String &&
fast_string_match (XCONS(elt)->car, arg) >= 0)
image=[NXImage findImageNamed:XSTRING(XCONS (elt)->cdr)->data];
for(fname=XSTRING(arg)->data+XSTRING(arg)->size;
(fname>XSTRING(arg)->data)&&(*fname!='.');
fname--);
if ((image==nil) && *fname=='.')
{
fname++;
name=alloca(strlen(fname)+5);
strcpy(name,fname);
strcat(name,"file");
image=[NXImage findImageNamed:name];
}
if (image==nil) image=[NXImage findImageNamed:"text"];
f->display.ns->miniimage=image;
[[view window] setMiniwindowImage: image];
}
int ns_lisp_to_cursor_type (Lisp_Object arg)
{
char *str;
if (XTYPE(arg) == Lisp_String)
str=XSTRING(arg)->data;
else if (XTYPE(arg) == Lisp_Symbol)
str=XSYMBOL(arg)->name->data;
else return -1;
if (!strcmp(str,"bar")) return bar;
if (!strcmp(str,"box")) return filled_box;
if (!strcmp(str,"hollow")) return hollow_box;
if (!strcmp(str,"line")) return line;
if (!strcmp(str,"no")) return no_highlight;
return -1;
}
void ns_set_cursor_type (struct frame *f, Lisp_Object arg,
Lisp_Object oldval)
{
int val;
id view=f->display.ns->view;
val=ns_lisp_to_cursor_type(arg);
if (val>=0)
{
f->display.ns->desired_cursor=val;
}
else
{
store_frame_param(f,Qcursor_type,oldval);
error ("the `cursor-type' frame parameter should be either `no', `bar', `box', `hollow' or `line'.");
}
update_mode_lines++;
}
void ns_set_autoraise (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
f->auto_raise = !NILP(arg);
}
void ns_set_autolower (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
f->auto_lower = !NILP(arg);
}
void ns_set_vertical_scroll_bars (struct frame *f, Lisp_Object arg,
Lisp_Object oldval)
{
FRAME_HAS_VERTICAL_SCROLL_BARS (f) = !NILP (arg);
/* We set this parameter before creating the window for the
frame, so we can get the geometry right from the start.
However, if the window hasn't been created yet, we shouldn't
call ns_set_window_size. */
if (f->display.ns->view) ns_set_window_size (f, 0, f->width, f->height);
}
void ns_set_font (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
if (XTYPE(arg) == Lisp_Symbol)
{
arg=intern(arg);
store_frame_param (f, Qfont, arg);
}
else if (XTYPE(arg) != Lisp_String)
{
store_frame_param (f, Qfont, oldval);
error ("Font not a string or symbol.");
}
if (f->display.ns->view)
{
if (ns_new_font(f))
{
store_frame_param (f, Qfont, oldval);
error("Not an available fixed-width font.");
}
ns_recompute_basic_faces (f);
}
SET_FRAME_GARBAGED (f);
}
void ns_set_fontsize (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
if (XTYPE(arg)==Lisp_String)
{
arg=Fstring_to_number(arg);
store_frame_param (f, Qfontsize, arg);
}
if (!NUMBERP(arg) || (XFLOATINT(arg)<=0.0))
{
store_frame_param (f, Qfontsize, oldval);
error ("Fontsize not a positive number.");
}
if (f->display.ns->view)
{
if (ns_new_font(f))
{
store_frame_param (f, Qfontsize, oldval);
error("Not an available font size.");
}
ns_recompute_basic_faces (f);
}
SET_FRAME_GARBAGED (f);
}
void ns_set_underline (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
if (f->display.ns->view)
{
if (ns_new_font(f))
{
store_frame_param (f, Qunderline, oldval);
error("Invalid underline.");
}
ns_recompute_basic_faces (f);
}
SET_FRAME_GARBAGED (f);
}
struct ns_frame_parm_table
{
char *name;
void (*setter)(struct frame *f, Lisp_Object arg, Lisp_Object oldval);
};
static struct ns_frame_parm_table ns_frame_parms[] =
{
"foreground-color", ns_set_foreground_color,
"background-color", ns_set_background_color,
"cursor-type", ns_set_cursor_type,
"icon-type", ns_set_icon_type,
"font", ns_set_font,
"fontsize", ns_set_fontsize,
"internal-border-width", ns_set_internal_border_width,
"name", ns_explicitly_set_name,
"auto-raise", ns_set_autoraise,
"auto-lower", ns_set_autolower,
"vertical-scroll-bars", ns_set_vertical_scroll_bars,
"visibility", ns_set_visibility,
"menu-bar-lines", ns_set_menu_bar_lines,
"doc-edited", ns_set_doc_edited,
"cursor-color", ns_set_cursor_color,
"underline", ns_set_underline
};
void ns_set_frame_parameters (struct frame *f, Lisp_Object alist)
{
Lisp_Object tail;
/* If both of these parameters are present, it's more efficient to
set them both at once. So we wait until we've looked at the
entire list before we set them. */
Lisp_Object width, height;
/* Same here. */
Lisp_Object left, top;
/* Record in these vectors all the parms specified. */
Lisp_Object *parms;
Lisp_Object *values;
int i;
i = 0;
for (tail = alist; CONSP (tail); tail = Fcdr (tail))
i++;
parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
/* Extract parm names and values into those vectors. */
i = 0;
for (tail = alist; CONSP (tail); tail = Fcdr (tail))
{
Lisp_Object elt, prop, val;
elt = Fcar (tail);
parms[i] = Fcar (elt);
values[i] = Fcdr (elt);
i++;
}
width = height = top = left = Qunbound;
/* Now process them in reverse of specified order. */
for (i--; i >= 0; i--)
{
Lisp_Object prop, val;
prop = parms[i];
val = values[i];
if (EQ (prop, Qwidth))
width = (XTYPE(val)==Lisp_String) ? Fstring_to_number(val) : val;
else if (EQ (prop, Qheight))
height = (XTYPE(val)==Lisp_String) ? Fstring_to_number(val) : val;
else if (EQ (prop, Qtop))
top = (XTYPE(val)==Lisp_String) ? Fstring_to_number(val) : val;
else if (EQ (prop, Qleft))
left = (XTYPE(val)==Lisp_String) ? Fstring_to_number(val) : val;
else
{
Lisp_Object param_index, old_value;
param_index = Fget (prop, Qns_frame_parameter);
old_value = get_frame_param (f, prop);
store_frame_param (f, prop, val);
if (XTYPE (param_index) == Lisp_Int
&& XINT (param_index) >= 0
&& (XINT (param_index)
< sizeof (ns_frame_parms)/sizeof (ns_frame_parms[0])))
(*ns_frame_parms[XINT (param_index)].setter)(f, val, old_value);
}
}
/* Don't die if just one of these was set. */
if (EQ (left, Qunbound))
XSET (left, Lisp_Int, (int)f->display.ns->left);
if (EQ (top, Qunbound))
XSET (top, Lisp_Int, (int)f->display.ns->top);
/* Don't die if just one of these was set. */
if (EQ (width, Qunbound))
XSET (width, Lisp_Int, FRAME_WIDTH (f));
if (EQ (height, Qunbound))
XSET (height, Lisp_Int, FRAME_HEIGHT (f));
/* Don't set these parameters these unless they've been explicitly
specified. The window might be mapped or resized while we're in
this function, and we don't want to override that unless the lisp
code has asked for it.
Don't set these parameters unless they actually differ from the
window's current parameters; the window may not actually exist
yet. */
{
Lisp_Object frame;
XSET (frame, Lisp_Frame, f);
if ((NUMBERP (width) && XINT (width) != FRAME_WIDTH (f))
|| (NUMBERP (height) && XINT (height) != FRAME_HEIGHT (f)))
Fset_frame_size (frame, width, height);
if ((NUMBERP (left) && XINT (left) != f->display.ns->left)
|| (NUMBERP (top) && XINT (top) != f->display.ns->top))
Fset_frame_position (frame, left, top);
}
}
void ns_report_frame_params (struct frame *f, Lisp_Object *alistptr)
{
store_in_alist (alistptr, Qleft, make_number ((int) f->display.ns->left));
store_in_alist (alistptr, Qtop, make_number ((int) f->display.ns->top));
store_in_alist (alistptr, Qinternal_border_width,
make_number ((int) f->display.ns->internal_border_width));
FRAME_SAMPLE_VISIBILITY (f);
store_in_alist (alistptr, Qvisibility,
(FRAME_VISIBLE_P (f) ? Qt
: FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
store_in_alist (alistptr, Qmenu_bar_lines, FRAME_EXTERNAL_MENU_BAR(f));
}
DEFUN ("ns-popup-font-panel", Fns_popup_font_panel, Sns_popup_font_panel, 0,1,"",
"Pop up the font panel.")
(frame)
Lisp_Object frame;
{
id fm;
struct frame *f;
check_ns();
fm=[FontManager new];
if (NILP(frame))
f=selected_frame;
else
{
CHECK_FRAME(frame, 0);
f=XFRAME (frame);
}
if (f->display.ns->face->font==0)
ns_load_font(f->display.ns->face);
[fm setSelFont:f->display.ns->face->font isMultiple:NO];
[fm orderFrontFontPanel:NXApp];
return Qnil;
}
DEFUN ("ns-popup-color-panel", Fns_popup_color_panel, Sns_popup_color_panel, 0,1,"",
"Pop up the color panel.")
(frame)
Lisp_Object frame;
{
struct frame *f;
check_ns();
if (NILP(frame))
f=selected_frame;
else
{
CHECK_FRAME(frame, 0);
f=XFRAME (frame);
}
[NXApp orderFrontColorPanel:NXApp];
return Qnil;
}
DEFUN ("ns-read-file-name", Fns_read_file_name, Sns_read_file_name, 1, 5, 0,
"As read-file-name except that NS panels are used for querrying.")
(prompt, dir, defalt, mustmatch, initial)
Lisp_Object prompt, dir, defalt, mustmatch, initial;
{
int ret;
id panel;
check_ns();
CHECK_STRING(prompt, 0);
if (NILP(dir))
dir=current_buffer->directory;
else
CHECK_STRING(dir,0);
if (NILP(defalt))
defalt=current_buffer->filename;
else
CHECK_STRING(defalt,0);
if (NILP(initial))
initial=build_string("");
else
CHECK_STRING(initial,0);
panel=[EmacsFilePanel new];
[panel setAllowCreate:NILP(mustmatch)];
[panel setAllowOld:YES];
[panel setAllowDir:YES];
[panel setTitle:XSTRING(prompt)->data];
[panel setRequiredFileType:""];
[panel setTreatsFilePackagesAsDirectories:YES];
ret=[panel runModalForDirectory:XSTRING(dir)->data file:XSTRING(initial)->data];
[[selected_frame->display.ns->view window] makeKeyWindow];
if (ret!=NX_OKTAG) Fsignal(Qquit,Qnil);
return build_string([panel filename]);
}
DEFUN ("ns-yes-or-no-p", Fns_yes_or_no_p, Sns_yes_or_no_p, 1, 1, 0,
"As yes-or-no-p except that NS panels are used for querrying.")
(prompt)
{
int ret;
CHECK_STRING(prompt, 0);
ret=NXRunAlertPanel([NXApp appName], XSTRING(prompt)->data,
"Yes", "No", "Cancel");
[[selected_frame->display.ns->view window] makeKeyWindow];
if (ret==NX_ALERTDEFAULT) return Qt;
if (ret==NX_ALERTALTERNATE) return Qnil;
if (ret==NX_ALERTOTHER) Fsignal(Qquit,Qnil);
error ("NXRunAlertPanel returns invalid.");
return Qnil;
}
DEFUN ("ns-get-resource", Fns_get_resource, Sns_get_resource, 2, 2, 0,
"Return the value of the property NAME of OWNER from the defaults database.\n\
If OWNER is nil, Emacs is assumed.")
(owner, name)
Lisp_Object owner, name;
{
const char *value;
check_ns();
if (NILP(owner))
owner= build_string([NXApp appName]);
CHECK_STRING(owner, 0);
CHECK_STRING(name, 0);
value=NXGetDefaultValue(XSTRING(owner)->data, XSTRING(name)->data);
if (value)
return build_string (value);
else
return Qnil;
}
DEFUN ("ns-set-resource", Fns_set_resource, Sns_set_resource, 3, 3, 0,
"Set property NAME of OWNER to VALUE, from the defaults database.\n\
If OWNER is nil, Emacs is assumed.\n\
If VALUE is nil, the default is removed.")
(owner, name, value)
Lisp_Object owner, name, value;
{
check_ns();
if (NILP(owner))
owner= build_string([NXApp appName]);
CHECK_STRING(owner, 0);
CHECK_STRING(name, 0);
if (NILP(value))
{
NXRemoveDefault(XSTRING(owner)->data, XSTRING(name)->data);
}
else
{
CHECK_STRING(value, 0);
NXWriteDefault(XSTRING(owner)->data, XSTRING(name)->data,
XSTRING(value)->data);
}
return Qnil;
}
DEFUN ("ns-create-frame", Fns_create_frame, Sns_create_frame,
1, 1, 0,
"Make a new NS window, which is called a \"frame\" in Emacs terms.\n\
Return an Emacs frame object representing the X window.\n\
ALIST is an alist of frame parameters.\n\
If the parameters specify that the frame should not have a minibuffer,\n\
and do not specify a specific minibuffer window to use,\n\
then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
be shared by the new frame.")
(parms)
Lisp_Object parms;
{
struct frame *f;
Lisp_Object frame, tem;
Lisp_Object name;
int minibuffer_only = 0;
long window_prompting = 0;
int width, height;
int count = specpdl_ptr - specpdl;
check_ns();
tem = ns_get_arg(parms, Qminibuffer, 0, 0);
if (XTYPE(tem)==Lisp_String) tem=intern(tem);
if (EQ (tem,Qnone) || NILP(tem))
{
f= make_frame_without_minibuffer(Qnil);
}
else if (EQ (tem, Qonly))
{
f= make_minibuffer_frame ();
minibuffer_only =1;
}
else if (XTYPE (tem) == Lisp_Window)
{
f= make_frame_without_minibuffer(Qnil);
}
else
{
f= make_frame (1);
}
FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
name = ns_get_arg (parms, Qname, 0, 0);
if (EQ (name, Qunbound) || NILP (name) || (XTYPE (name) != Lisp_String))
{
f->name = build_string([NXApp appName]);
f->explicit_name=0;
}
else
{
f->name = name;
f->explicit_name=1;
/* use the frame's title when getting resources for this frame. */
specbind (Qresource_name, name);
}
XSET (frame, Lisp_Frame, f);
f->output_method = output_ns;
f->display.ns = (struct ns_display *) xmalloc (sizeof *(f->display.ns));
bzero (f->display.ns, sizeof (*(f->display.ns)));
f->display.ns->face = (struct ns_face *) xmalloc (sizeof *(f->display.ns->face));
bzero (f->display.ns->face, sizeof (*(f->display.ns->face)));
f->phys_cursor_x = -1;
f->phys_cursor_y = -1;
ns_default_parameter(f, parms, Qinternal_border_width, make_number(2),
0, "InternalBorderWidth");
ns_default_parameter(f, parms, Qvertical_scroll_bars, Qt,
0, "VerticalScrollBars");
ns_default_parameter(f, parms, Qauto_raise, Qnil,0, "AutoRaise");
ns_default_parameter(f, parms, Qauto_lower, Qnil,0, "AutoLower");
ns_default_parameter(f, parms, Qbuffered, Qt, 0, "Buffered");
{
id font=[Font userFixedPitchFontOfSize:-1.0 matrix:NX_FLIPPEDMATRIX];
ns_default_parameter(f, parms, Qforeground_color, build_string("Black"),
0, "Foreground");
ns_default_parameter(f, parms, Qbackground_color, build_string("White"),
0, "Background");
ns_default_parameter(f, parms, Qfont, build_string([font name]),
0, "Font");
ns_default_parameter(f, parms, Qfontsize, make_number((int)[font pointSize]),
0, "FontSize");
ns_default_parameter(f, parms, Qunderline, Qnil,
0, "Underline");
ns_new_font(f);
}
ns_default_parameter(f, parms, Qheight, make_number(48), 0, "Height");
ns_default_parameter(f, parms, Qwidth, make_number(80), 0, "Width");
ns_default_parameter(f, parms, Qcursor_color, build_string("Highlight"),
0, "CursorColor");
ns_default_parameter(f, parms, Qcursor_type, Qbox, 0, "CursorType");
ns_default_parameter(f, parms, Qtop, make_number(100), 0, "Top");
ns_default_parameter(f, parms, Qleft, make_number(100), 0, "Left");
ns_default_parameter(f, parms, Qmenu_bar_lines, make_number(1), 0, "Menus");
tem= ns_get_arg (parms, Qunsplittable, 0, 0);
f->no_split = minibuffer_only || (!EQ (tem, Qunbound) && !EQ (tem, Qnil));
ns_init_frame_faces(f);
[[EmacsView alloc] initFrameFromEmacs:f];
/* It is now ok to make the frame official
even if we get an error below.
And the frame needs to be on Vframe_list
or making it visible won't work. */
Vframe_list = Fcons (frame, Vframe_list);
tem=ns_get_arg(parms, Qvisibility,0,0);
if (EQ (tem, Qunbound)) tem = Qt;
ns_set_visibility(f,tem,Qnil);
return unbind_to (count, frame);
}
Lisp_Object ns_get_focus_frame(void)
{
Lisp_Object nsfocus;
if (!ns_focus_frame)
return Qnil;
XSET(nsfocus, Lisp_Frame, ns_focus_frame);
return nsfocus;
}
DEFUN ("ns-list-fonts", Fns_list_fonts, Sns_list_fonts, 1, 3, 0,
"Return a list of the names of available fonts matching PATTERN.\n\
If optional arguments FACE and FRAME are specified, return only fonts\n\
the same size as FACE on FRAME.\n\
\n\
PATTERN is a regular expression; FACE is a face name - a symbol.\n\
\n\
The return value is a list of strings, suitable as arguments to\n\
set-face-font.\n\
\n\
Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
even if they match PATTERN and FACE.")
(pattern, face, frame)
Lisp_Object pattern, face, frame;
{
int len;
Lisp_Object list,str,rpattern,args[3];
char **fonts,**ofonts;
id fm=[FontManager new];
check_ns();
CHECK_STRING(pattern,0);
args[0]=build_string("^");
args[1]=pattern;
args[2]=build_string("$");
rpattern = Fconcat(3, args);
compile_pattern (rpattern, &searchbuf, 0, 0);
if (!NILP(face)) CHECK_SYMBOL(face,0);
if (!NILP(frame))
{
CHECK_FRAME(frame,0);
if (! FRAME_NS_P (XFRAME(frame)))
error ("non-NS frame used in `ns-list-fonts'");
}
for(ofonts=fonts=[fm availableFonts],list=Qnil;*fonts;fonts++)
{
/* XXX: Don't ignore frame/face */
len=strlen(*fonts);
if (re_search(&searchbuf, *fonts, len, 0, len, 0)>=0)
list=Fcons(build_string (*fonts),list);
free(*fonts);
}
free(ofonts);
return list;
}
DEFUN ("ns-color-defined-p", Fns_color_defined_p, Sns_color_defined_p, 1, 1, 0,
"Return t if the current NS display supports the color named COLOR.")
(color)
Lisp_Object color;
{
NXColor col;
check_ns();
return ns_lisp_to_color(color, &col) ? Qnil : Qt;
}
DEFUN ("ns-color-values", Fns_color_values, Sns_color_values, 1, 1, 0,
"Return a description of the color named COLOR.\n\
The value is a list of integer RGBA values--(RED GREEN BLUE ALPHA).\n\
These values appear to range from 0 to 65280; white is (65280 65280 65280 0).")
(color)
Lisp_Object color;
{
NXColor col;
float red,green,blue,alpha;
Lisp_Object rgba[4];
check_ns ();
CHECK_STRING (color, 0);
if (ns_lisp_to_color(color, &col))
return Qnil;
NXConvertColorToRGBA(col,&red,&green,&blue,&alpha);
rgba[0] = make_number ((int) rint(red*65280));
rgba[1] = make_number ((int) rint(green*65280));
rgba[2] = make_number ((int) rint(blue*65280));
rgba[3] = make_number ((int) rint(alpha*65280));
return Flist (4, rgba);
}
static id ns_get_window(Lisp_Object frame)
{
id view=nil,window=nil;
const NXScreen *screen=0;
CHECK_FRAME(frame,0);
if (!FRAME_NS_P(XFRAME(frame)))
frame = wrong_type_argument (Qframep, frame);
view=XFRAME(frame)->display.ns->view;
if (view) window=[view window];
return window;
}
static const NXScreen *ns_get_screen(Lisp_Object frame)
{
id window=nil;
const NXScreen *screen=0;
if (FRAMEP(frame) && FRAME_NS_P(XFRAME(frame)))
window=ns_get_window(frame);
if (window!=nil) screen=[window screen];
if (!screen) screen=[NXApp mainScreen];
return screen;
}
DEFUN ("ns-display-color-p", Fns_display_color_p, Sns_display_color_p, 0, 0, 0,
"Return t if the main NS screen supports color.")
()
{
check_ns();
switch (ns_get_screen(Qnil)->depth)
{
case NX_TwoBitGrayDepth:
case NX_EightBitGrayDepth:
return Qnil;
case NX_EightBitRGBDepth:
case NX_TwelveBitRGBDepth:
case NX_TwentyFourBitRGBDepth:
return Qt;
default:
error ("Screen has an unknown visual class");
}
}
DEFUN ("ns-display-pixel-width", Fns_display_pixel_width, Sns_display_pixel_width,
0, 1, 0,
"Returns the width in pixels of the display FRAME is on.")
(frame)
Lisp_Object frame;
{
check_ns();
return make_number ((int) ns_get_screen(frame)->screenBounds.size.width);
}
DEFUN ("ns-display-pixel-height", Fns_display_pixel_height,
Sns_display_pixel_height, 0, 1, 0,
"Returns the height in pixels of the display FRAME is on.")
(frame)
Lisp_Object frame;
{
check_ns();
return make_number ((int) ns_get_screen(frame)->screenBounds.size.height);
}
DEFUN ("ns-display-planes", Fns_display_planes, Sns_display_planes,
0, 1, 0,
"Returns the number of bitplanes of the display FRAME is on.")
(frame)
Lisp_Object frame;
{
check_ns();
return make_number (NXBPSFromDepth(ns_get_screen(frame)->depth));
}
DEFUN ("ns-display-color-cells", Fns_display_color_cells, Sns_display_color_cells,
0, 1, 0,
"Returns the number of color cells of the display FRAME is on.")
(frame)
Lisp_Object frame;
{
check_ns();
return make_number (1<<NXBPSFromDepth(ns_get_screen(frame)->depth));
}
DEFUN ("ns-server-max-request-size", Fns_server_max_request_size,
Sns_server_max_request_size,
0, 1, 0,
"This function is only present for completeness. It does not return\n\
a usable result for NS windows.")
(frame)
Lisp_Object frame;
{
check_ns();
/* This function has no real equivalent under NeXTstep. Return nil to
indicate this. */
return Qnil;
}
DEFUN ("ns-server-vendor", Fns_server_vendor, Sns_server_vendor, 0, 1, 0,
"Returns the vendor ID string of the NS server FRAME is on.")
(frame)
Lisp_Object frame;
{
check_ns();
return build_string ("NeXT");
}
DEFUN ("ns-server-version", Fns_server_version, Sns_server_version, 0, 1, 0,
"Returns the release of NS on the current host.")
(frame)
Lisp_Object frame;
{
kernel_version_t string;
check_ns();
if (host_kernel_version(host_self(), string) == KERN_SUCCESS)
return build_string(string);
else
return Qnil;
}
DEFUN ("ns-display-screens", Fns_display_screens, Sns_display_screens, 0, 1, 0,
"Returns the number of screens on the NS server FRAME is on.")
(frame)
Lisp_Object frame;
{
const NXScreen *screen;
int num;
check_ns();
[NXApp getScreens:&screen count:&num];
return (screen!=0) ? make_number (num) : Qnil;
}
DEFUN ("ns-display-mm-height", Fns_display_mm_height, Sns_display_mm_height, 0, 1, 0,
"Returns the height in millimeters of the X screen FRAME is on.")
(frame)
Lisp_Object frame;
{
check_ns();
return make_number ((int) (ns_get_screen(frame)->screenBounds.size.height/(92.0/25.4)));
}
DEFUN ("ns-display-mm-width", Fns_display_mm_width, Sns_display_mm_width, 0, 1, 0,
"Returns the width in millimeters of the X screen FRAME is on.")
(frame)
Lisp_Object frame;
{
check_ns();
return make_number ((int) (ns_get_screen(frame)->screenBounds.size.width/(92.0/25.4)));
}
DEFUN ("ns-display-backing-store", Fns_display_backing_store,
Sns_display_backing_store, 0, 1, 0,
"Returns an indication of what type of backing store FRAME does.\n\
The value may be `buffered', `retained', or `non-retained'.")
(frame)
Lisp_Object frame;
{
check_ns();
switch ([ns_get_window(frame) backingType])
{
case NX_BUFFERED:
return intern ("buffered");
case NX_RETAINED:
return intern ("retained");
case NX_NONRETAINED:
return intern ("non-retained");
default:
error ("Strange value for backingType parameter of frame");
}
}
DEFUN ("ns-display-visual-class", Fns_display_visual_class,
Sns_display_visual_class, 0, 1, 0,
"Returns the visual class of the display `screen' is on.\n\
The value is one of the symbols `static-gray', `gray-scale',\n\
`static-color', `true-color', or `direct-color'.")
(frame)
Lisp_Object frame;
{
check_ns();
switch (ns_get_screen(frame)->depth)
{
case NX_TwoBitGrayDepth:
return (intern ("static-gray"));
case NX_EightBitGrayDepth:
return (intern ("gray-scale"));
case NX_EightBitRGBDepth:
return (intern ("pseudo-color"));
case NX_TwelveBitRGBDepth:
return (intern ("true-color"));
case NX_TwentyFourBitRGBDepth:
return (intern ("direct-color"));
default:
error ("Screen has an unknown visual class");
}
}
DEFUN ("ns-display-save-under", Fns_display_save_under,
Sns_display_save_under, 0, 1, 0,
"Returns t if FRAME supports the save-under feature.")
(frame)
Lisp_Object frame;
{
check_ns();
switch ([ns_get_window(frame) backingType])
{
case NX_BUFFERED:
return Qt;
case NX_RETAINED:
case NX_NONRETAINED:
return Qnil;
default:
error ("Strange value for backingType parameter of frame");
}
}
int ns_pixel_width (struct frame *f)
{
id view=f->display.ns->view;
NXRect r;
[view getBounds:&r];
return r.size.width+2*f->display.ns->internal_border_width;
}
int ns_pixel_height (struct frame *f)
{
id view=f->display.ns->view;
NXRect r;
[view getBounds:&r];
return r.size.height+2*f->display.ns->internal_border_width;
}
int ns_char_width (struct frame *f)
{
return f->display.ns->face->width;
}
int ns_char_height (struct frame *f)
{
return f->display.ns->line_height;
}
/* Offset in buffer of character under the pointer, or 0. */
/* XXX: update ns_mouse_buffer_offset (but then X doesn't either) */
int ns_mouse_buffer_offset;
DEFUN ("ns-open-connection", Fns_open_connection, Sns_open_connection,
1, 1, 0, "Open a connection to a NS server.\n\
DISPLAY is the name of the display to connect to.")
(display)
Lisp_Object display;
{
if (ns_current_display != nil)
{
error ("NS connection already initialized");
return Qnil;
}
nxatoms_of_nsselect();
ns_term_init(STRINGP(display) ? 0 : XSTRING (display)->data);
return Qnil;
}
DEFUN ("ns-close-current-connection", Fns_close_current_connection,
Sns_close_current_connection,
0, 0, 0, "Close the connection to the current NS server.")
()
{
check_ns();
DPSFlush();
[NXApp terminate:NXApp];
ns_current_display=nil;
return Qnil;
}
DEFUN ("ns-synchronize", Fns_synchronize, Sns_synchronize,
1, 1, 0,
"If ON is non-nil, report NS errors as soon as the erring request is made.\n\
If ON is nil, allow buffering of requests.\n\
Turning on synchronization prohibits the NS routines from buffering\n\
requests and seriously degrades performance, but makes debugging much\n\
easier.")
(on)
Lisp_Object on;
{
check_ns();
DPSSynchronizeContext(DPSGetCurrentContext(), !EQ (on, Qnil));
return Qnil;
}
DEFUN ("ns-hide-emacs", Fns_hide_emacs, Sns_hide_emacs,
1, 1, 0, "If ON is non-nil, the entire emacs application is hidden.\n\
Otherwise if emacs is hidden, it is unhidden.\n\
If ON is equal to 'activate, emacs is unhidden and becomes the active application.")
(on)
Lisp_Object on;
{
check_ns();
if (EQ(on,intern("activate")))
{
[NXApp unhide:NXApp];
[NXApp activateSelf:YES];
}
else if (NILP(on))
[NXApp unhide:NXApp];
else
[NXApp hide:NXApp];
return Qnil;
}
static Lisp_Object interpret_command_keys(id menu,
Lisp_Object prefix,Lisp_Object old)
{
int i;
id matrix=[menu itemList],cell;
unsigned short key;
for (i=0;(cell=[matrix cellAt:i:0])!=nil;i++)
{
if ([cell hasSubmenu])
{
old=interpret_command_keys([cell target],
Fcons([cell value],prefix),old);
}
else if (key=[cell userKeyEquivalent])
{
if (!NILP(ns_iso_latin) && key<256)
key=ns2isomap[key];
old=Fcons(Fcons(make_number(key|super_modifier),
Freverse(Fcons([cell value],prefix))),old);
}
}
return old;
}
DEFUN ("ns-list-command-keys", Fns_list_command_keys, Sns_list_command_keys,
0, 0, 0, "List NS command equivalents for menus.")
()
{
Lisp_Object ret=Qnil;
check_ns();
ret=interpret_command_keys([NXApp mainMenu],Qnil,Qnil);
return ret;
}
static Lisp_Object interpret_services_menu(id menu,
Lisp_Object prefix,Lisp_Object old)
{
int i;
id matrix=[menu itemList],cell;
const char *name;
unsigned short key;
Lisp_Object res;
for (i=0;(cell=[matrix cellAt:i:0])!=nil;i++)
{
name=[cell title];
if (!name) continue;
if ([cell hasSubmenu])
{
old=interpret_services_menu([cell target],
Fcons(build_string(name),prefix),old);
[[cell target] free];
}
else
{
key=[cell keyEquivalent];
if (key)
{
if (!NILP(ns_iso_latin) && key<256)
key=ns2isomap[key];
res=make_number(key|super_modifier);
}
else
res=Qundefined;
old=Fcons(Fcons(res,Freverse(Fcons(build_string(name),prefix))),old);
}
}
return old;
}
DEFUN ("ns-list-services", Fns_list_services, Sns_list_services, 0, 0, 0,
"List NS services.\n\
WARNING: This function crashes NS version older than NS 3.2.")
()
{
Lisp_Object ret=Qnil;
check_ns();
[NXApp registerServicesMenuSendTypes:ns_send_types
andReturnTypes:ns_return_types];
[NXApp setServicesMenu:[[Menu alloc] init]];
[[NXApp servicesMenu] update];
ret=interpret_services_menu([NXApp servicesMenu],Qnil,ret);
[NXApp setServicesMenu:nil];
return ret;
}
DEFUN ("ns-perform-service", Fns_perform_service, Sns_perform_service,
2, 2, 0, "Perform NS SERVICE on SEND which is either a string or nil.\n\
Returns result of service as string or nil if no result.")
(service, send)
Lisp_Object service, send;
{
id pb;
check_ns();
pb=[Pasteboard newName:"EmacsServicesPboard"];
CHECK_STRING (service, 0);
ns_string_to_pasteboard(pb,send);
if (NXPerformService(XSTRING(service)->data, pb)==NO)
Fsignal (Qerror, Fcons (build_string ("service not available"), Qnil));
return ns_string_from_pasteboard(pb);
}
DEFUN ("ns-show-ps", Fns_show_ps, Sns_show_ps,
1, 1, 0, "Turn postscript logging on or off depending of the value of flag.")
(flag)
Lisp_Object flag;
{
check_ns();
DPSTraceContext(DPS_ALLCONTEXTS,!NILP(flag));
return Qnil;
}
DEFUN ("ns-show-events", Fns_show_events, Sns_show_events,
1, 1, 0, "Turn event logging on or off depending of the value of flag.")
(flag)
Lisp_Object flag;
{
check_ns();
DPSTraceEvents(DPS_ALLCONTEXTS,!NILP(flag));
return Qnil;
}
DEFUN ("ns-gdb-break", Fns_gdb_break, Sns_gdb_break, 2, 2,
"sBreak in: \nnBreak at: ",
"Tell gdb connected to emacs to do corresponding function.")
(file,line)
Lisp_Object file,line;
{
check_ns();
if (ns_gdb_controller==nil)
Fsignal (Qerror, Fcons (build_string ("no debugger connected"), Qnil));
if (STRINGP(ns_gdb_status) && !strcmp(XSTRING(ns_gdb_status)->data,"running"))
Fsignal (Qerror, Fcons (build_string ("debugger still running"), Qnil));
CHECK_STRING(file,0);
CHECK_NUMBER(line,0);
NX_DURING
[ns_gdb_controller breakInFile:XSTRING(file)->data atLine:XINT(line)];
NX_HANDLER
ns_gdb_controller=nil;
ns_gdb_name=Qnil;
NX_ENDHANDLER
if (ns_gdb_controller==nil)
Fsignal (Qerror, Fcons (build_string ("debugger doesn't respond", Qnil)));
return Qnil;
}
DEFUN ("ns-gdb-until", Fns_gdb_until, Sns_gdb_until, 2, 2,
"sUntil in: \nnUntil at: ",
"Tell gdb connected to emacs to do corresponding function.")
(file,line)
Lisp_Object file,line;
{
check_ns();
if (ns_gdb_controller==nil)
Fsignal (Qerror, Fcons (build_string ("no debugger connected"), Qnil));
if (STRINGP(ns_gdb_status) && !strcmp(XSTRING(ns_gdb_status)->data,"running"))
Fsignal (Qerror, Fcons (build_string ("debugger still running"), Qnil));
CHECK_STRING(file,0);
CHECK_NUMBER(line,0);
NX_DURING
[ns_gdb_controller untilInFile:XSTRING(file)->data atLine:XINT(line)];
NX_HANDLER
ns_gdb_controller=nil;
ns_gdb_name=Qnil;
NX_ENDHANDLER
if (ns_gdb_controller==nil)
Fsignal (Qerror, Fcons (build_string ("debugger doesn't respond", Qnil)));
return Qnil;
}
DEFUN ("ns-gdb-step", Fns_gdb_step, Sns_gdb_step, 0, 0, "",
"Tell gdb connected to emacs to do corresponding function.")
()
{
check_ns();
if (ns_gdb_controller==nil)
Fsignal (Qerror, Fcons (build_string ("no debugger connected"), Qnil));
if (STRINGP(ns_gdb_status) && !strcmp(XSTRING(ns_gdb_status)->data,"running"))
Fsignal (Qerror, Fcons (build_string ("debugger still running"), Qnil));
NX_DURING
[ns_gdb_controller step];
NX_HANDLER
ns_gdb_controller=nil;
ns_gdb_name=Qnil;
NX_ENDHANDLER
if (ns_gdb_controller==nil)
Fsignal (Qerror, Fcons (build_string ("debugger doesn't respond", Qnil)));
return Qnil;
}
DEFUN ("ns-gdb-next", Fns_gdb_next, Sns_gdb_next, 0, 0, "",
"Tell gdb connected to emacs to do corresponding function.")
()
{
check_ns();
if (ns_gdb_controller==nil)
Fsignal (Qerror, Fcons (build_string ("no debugger connected"), Qnil));
if (STRINGP(ns_gdb_status) && !strcmp(XSTRING(ns_gdb_status)->data,"running"))
Fsignal (Qerror, Fcons (build_string ("debugger still running"), Qnil));
NX_DURING
[ns_gdb_controller next];
NX_HANDLER
ns_gdb_controller=nil;
ns_gdb_name=Qnil;
NX_ENDHANDLER
if (ns_gdb_controller==nil)
Fsignal (Qerror, Fcons (build_string ("debugger doesn't respond", Qnil)));
return Qnil;
}
DEFUN ("ns-gdb-continue", Fns_gdb_continue, Sns_gdb_continue, 0, 0, "",
"Tell gdb connected to emacs to do corresponding function.")
()
{
check_ns();
if (ns_gdb_controller==nil)
Fsignal (Qerror, Fcons (build_string ("no debugger connected"), Qnil));
if (STRINGP(ns_gdb_status) && !strcmp(XSTRING(ns_gdb_status)->data,"running"))
Fsignal (Qerror, Fcons (build_string ("debugger still running"), Qnil));
NX_DURING
[ns_gdb_controller continue];
NX_HANDLER
ns_gdb_controller=nil;
ns_gdb_name=Qnil;
NX_ENDHANDLER
if (ns_gdb_controller==nil)
Fsignal (Qerror, Fcons (build_string ("debugger doesn't respond", Qnil)));
return Qnil;
}
DEFUN ("ns-gdb-up", Fns_gdb_up, Sns_gdb_up, 0, 0, "",
"Tell gdb connected to emacs to do corresponding function.")
()
{
check_ns();
if (ns_gdb_controller==nil)
Fsignal (Qerror, Fcons (build_string ("no debugger connected"), Qnil));
if (STRINGP(ns_gdb_status) && !strcmp(XSTRING(ns_gdb_status)->data,"running"))
Fsignal (Qerror, Fcons (build_string ("debugger still running"), Qnil));
NX_DURING
[ns_gdb_controller up];
NX_HANDLER
ns_gdb_controller=nil;
ns_gdb_name=Qnil;
NX_ENDHANDLER
if (ns_gdb_controller==nil)
Fsignal (Qerror, Fcons (build_string ("debugger doesn't respond", Qnil)));
return Qnil;
}
DEFUN ("ns-gdb-frame", Fns_gdb_frame, Sns_gdb_frame, 0, 0, "",
"Tell gdb connected to emacs to do corresponding function.")
()
{
check_ns();
if (ns_gdb_controller==nil)
Fsignal (Qerror, Fcons (build_string ("no debugger connected"), Qnil));
if (STRINGP(ns_gdb_status) && !strcmp(XSTRING(ns_gdb_status)->data,"running"))
Fsignal (Qerror, Fcons (build_string ("debugger still running"), Qnil));
NX_DURING
[ns_gdb_controller frame];
NX_HANDLER
ns_gdb_controller=nil;
ns_gdb_name=Qnil;
NX_ENDHANDLER
if (ns_gdb_controller==nil)
Fsignal (Qerror, Fcons (build_string ("debugger doesn't respond", Qnil)));
return Qnil;
}
DEFUN ("ns-gdb-down", Fns_gdb_down, Sns_gdb_down, 0, 0, "",
"Tell gdb connected to emacs to do corresponding function.")
()
{
check_ns();
if (ns_gdb_controller==nil)
Fsignal (Qerror, Fcons (build_string ("no debugger connected"), Qnil));
if (STRINGP(ns_gdb_status) && !strcmp(XSTRING(ns_gdb_status)->data,"running"))
Fsignal (Qerror, Fcons (build_string ("debugger still running"), Qnil));
NX_DURING
[ns_gdb_controller down];
NX_HANDLER
ns_gdb_controller=nil;
ns_gdb_name=Qnil;
NX_ENDHANDLER
if (ns_gdb_controller==nil)
Fsignal (Qerror, Fcons (build_string ("debugger doesn't respond", Qnil)));
return Qnil;
}
DEFUN ("ns-gdb-finish", Fns_gdb_finish, Sns_gdb_finish, 0, 0, "",
"Tell gdb connected to emacs to do corresponding function.")
()
{
check_ns();
if (ns_gdb_controller==nil)
Fsignal (Qerror, Fcons (build_string ("no debugger connected"), Qnil));
if (STRINGP(ns_gdb_status) && !strcmp(XSTRING(ns_gdb_status)->data,"running"))
Fsignal (Qerror, Fcons (build_string ("debugger still running"), Qnil));
NX_DURING
[ns_gdb_controller finish];
NX_HANDLER
ns_gdb_controller=nil;
ns_gdb_name=Qnil;
NX_ENDHANDLER
if (ns_gdb_controller==nil)
Fsignal (Qerror, Fcons (build_string ("debugger doesn't respond", Qnil)));
return Qnil;
}
DEFUN ("ns-gdb-run", Fns_gdb_run, Sns_gdb_run, 0, 0, "",
"Tell gdb connected to emacs to do corresponding function.")
()
{
check_ns();
if (ns_gdb_controller==nil)
Fsignal (Qerror, Fcons (build_string ("no debugger connected"), Qnil));
if (STRINGP(ns_gdb_status) && !strcmp(XSTRING(ns_gdb_status)->data,"running"))
Fsignal (Qerror, Fcons (build_string ("debugger still running"), Qnil));
NX_DURING
[ns_gdb_controller run];
NX_HANDLER
ns_gdb_controller=nil;
ns_gdb_name=Qnil;
NX_ENDHANDLER
if (ns_gdb_controller==nil)
Fsignal (Qerror, Fcons (build_string ("debugger doesn't respond", Qnil)));
return Qnil;
}
DEFUN ("ns-gdb-quit", Fns_gdb_quit, Sns_gdb_quit, 0, 0, "",
"Tell gdb connected to emacs to do corresponding function.")
()
{
check_ns();
if (ns_gdb_controller==nil)
Fsignal (Qerror, Fcons (build_string ("no debugger connected"), Qnil));
if (STRINGP(ns_gdb_status) && !strcmp(XSTRING(ns_gdb_status)->data,"running"))
Fsignal (Qerror, Fcons (build_string ("debugger still running"), Qnil));
NX_DURING
[ns_gdb_controller quit];
NX_HANDLER
ns_gdb_controller=nil;
ns_gdb_name=Qnil;
NX_ENDHANDLER
if (ns_gdb_controller==nil)
Fsignal (Qerror, Fcons (build_string ("debugger doesn't respond", Qnil)));
return Qnil;
}
DEFUN ("ns-gdb-print", Fns_gdb_print, Sns_gdb_print, 1, 1,
"sValue of: ",
"Tell gdb connected to emacs to do corresponding function.")
(var)
Lisp_Object var;
{
check_ns();
if (ns_gdb_controller==nil)
Fsignal (Qerror, Fcons (build_string ("no debugger connected"), Qnil));
if (STRINGP(ns_gdb_status) && !strcmp(XSTRING(ns_gdb_status)->data,"running"))
Fsignal (Qerror, Fcons (build_string ("debugger still running"), Qnil));
CHECK_STRING(var,0);
NX_DURING
[ns_gdb_controller printExpression:XSTRING(var)->data];
NX_HANDLER
ns_gdb_controller=nil;
ns_gdb_name=Qnil;
NX_ENDHANDLER
if (ns_gdb_controller==nil)
Fsignal (Qerror, Fcons (build_string ("debugger doesn't respond", Qnil)));
return Qnil;
}
DEFUN ("ns-gdb-print-indirect", Fns_gdb_print_indirect, Sns_gdb_print_indirect,
1, 1, "sValue pointed to by: ",
"Tell gdb connected to emacs to do corresponding function.")
(var)
Lisp_Object var;
{
check_ns();
if (ns_gdb_controller==nil)
Fsignal (Qerror, Fcons (build_string ("no debugger connected"), Qnil));
if (STRINGP(ns_gdb_status) && !strcmp(XSTRING(ns_gdb_status)->data,"running"))
Fsignal (Qerror, Fcons (build_string ("debugger still running"), Qnil));
CHECK_STRING(var,0);
NX_DURING
[ns_gdb_controller printExpressionIndirect:XSTRING(var)->data];
NX_HANDLER
ns_gdb_controller=nil;
ns_gdb_name=Qnil;
NX_ENDHANDLER
if (ns_gdb_controller==nil)
Fsignal (Qerror, Fcons (build_string ("debugger doesn't respond", Qnil)));
return Qnil;
}
DEFUN ("ns-gdb-select-frame", Fns_gdb_select_frame, Sns_gdb_select_frame,
1, 1, "nFrame number: ",
"Tell gdb connected to emacs to do corresponding function.")
(frame)
Lisp_Object frame;
{
check_ns();
if (ns_gdb_controller==nil)
Fsignal (Qerror, Fcons (build_string ("no debugger connected"), Qnil));
if (STRINGP(ns_gdb_status) && !strcmp(XSTRING(ns_gdb_status)->data,"running"))
Fsignal (Qerror, Fcons (build_string ("debugger still running"), Qnil));
CHECK_NUMBER(frame,0);
NX_DURING
[ns_gdb_controller selectFrame:XINT(frame)];
NX_HANDLER
ns_gdb_controller=nil;
ns_gdb_name=Qnil;
NX_ENDHANDLER
if (ns_gdb_controller==nil)
Fsignal (Qerror, Fcons (build_string ("debugger doesn't respond", Qnil)));
return Qnil;
}
DEFUN ("ns-gdb-interrupt", Fns_gdb_interrupt, Sns_gdb_interrupt, 0, 0, "",
"Interrupt gdb connected to emacs.")
()
{
check_ns();
if (ns_gdb_controller==nil)
Fsignal (Qerror, Fcons (build_string ("no debugger connected"), Qnil));
NX_DURING
[ns_gdb_interrupt_controller interrupt];
NX_HANDLER
ns_gdb_controller=nil;
ns_gdb_name=Qnil;
NX_ENDHANDLER
if (ns_gdb_controller==nil)
Fsignal (Qerror, Fcons (build_string ("debugger doesn't respond", Qnil)));
return Qnil;
}
/* -(int)getFramesUpTo: (int)maxFrames selFrame: (out int *)sel;
-(id)frameAt: (int)frameIndex functionName: (out char **)pFunctionName from: (out unsigned int *)pFrom;
-(id)frameAt: (int)frameIndex from: (out unsigned int *)pFrom;
-(char *)functionNameAt: (int)frameIndex;
-(char *)functionNameAt: (int)frameIndex hasSymbols: (int *)hasSymbols;
-(oneway void)errorOpeningFile: (char *)filename fromLine: (int)start to: (int)end; */
void ns_sync(Lisp_Object frame)
{
/* XXX Not implemented XXX */
return;
}
syms_of_nsfns ()
{
int i;
ns_current_display=0;
Qns_frame_parameter = intern ("ns-frame-parameter");
staticpro (&Qns_frame_parameter);
for (i = 0; i< sizeof (ns_frame_parms)/ sizeof (ns_frame_parms[0]); i++)
Fput (intern (ns_frame_parms[i].name), Qns_frame_parameter,
make_number (i));
DEFVAR_INT ("ns-mouse-buffer-offset", &ns_mouse_buffer_offset,
"The buffer offset of the character under the pointer.");
ns_mouse_buffer_offset = 0;
DEFVAR_LISP ("ns-icon-type-alist", &Vns_icon_type_alist,
"Alist of elements (REGEXP . IMAGE) for images of icons associated to\n\
frames. If the title of a frame matches REGEXP, then IMAGE.tiff is\n\
selected as the image of the icon representing the frame when it's\n\
miniaturized.\n\
\n\
The images have to be installed in a folder called English.lproj in the\n\
Emacs.app folder. You have to restart Emacs after installing new icons.\n\
\n\
Example: Install an icon Gnus.tiff and execute the following code\n\
\n\
(setq ns-icon-type-alist\n\
(append ns-icon-type-alist\n\
'((\"^\\\\*\\\\(Group\\\\*$\\\\|Summary \\\\|Article\\\\*$\\\\)\"\n\
. \"Gnus\"))))\n\
\n\
When you miniaturize a Group, Summary or Article frame, Gnus.tiff will\n\
be used as the image of the icon representing the frame.");
Vns_icon_type_alist = Qnil;
defsubr (&Sns_read_file_name);
defsubr (&Sns_get_resource);
defsubr (&Sns_set_resource);
defsubr (&Sns_display_color_p);
defsubr (&Sns_list_fonts);
defsubr (&Sns_color_defined_p);
defsubr (&Sns_color_values);
defsubr (&Sns_server_max_request_size);
defsubr (&Sns_server_vendor);
defsubr (&Sns_server_version);
defsubr (&Sns_display_pixel_width);
defsubr (&Sns_display_pixel_height);
defsubr (&Sns_display_mm_width);
defsubr (&Sns_display_mm_height);
defsubr (&Sns_display_screens);
defsubr (&Sns_display_planes);
defsubr (&Sns_display_color_cells);
defsubr (&Sns_display_visual_class);
defsubr (&Sns_display_backing_store);
defsubr (&Sns_display_save_under);
defsubr (&Sns_create_frame);
defsubr (&Sns_open_connection);
defsubr (&Sns_close_current_connection);
defsubr (&Sns_synchronize);
defsubr (&Sns_hide_emacs);
defsubr (&Sns_list_command_keys);
defsubr (&Sns_list_services);
defsubr (&Sns_perform_service);
defsubr (&Sns_show_ps);
defsubr (&Sns_show_events);
defsubr (&Sns_popup_font_panel);
defsubr (&Sns_popup_color_panel);
defsubr (&Sns_gdb_break);
defsubr (&Sns_gdb_until);
defsubr (&Sns_gdb_step);
defsubr (&Sns_gdb_next);
defsubr (&Sns_gdb_continue);
defsubr (&Sns_gdb_up);
defsubr (&Sns_gdb_frame);
defsubr (&Sns_gdb_down);
defsubr (&Sns_gdb_finish);
defsubr (&Sns_gdb_run);
defsubr (&Sns_gdb_quit);
defsubr (&Sns_gdb_print);
defsubr (&Sns_gdb_print_indirect);
defsubr (&Sns_gdb_select_frame);
defsubr (&Sns_gdb_interrupt);
}
@implementation EmacsFilePanel
- (BOOL)_validateNames:(char *)name checkBrowser:(BOOL)check
{
Lisp_Object path;
char buf[MAXPATHLEN];
sprintf(buf, "%s/%s", directory, name);
path=build_string(buf);
if (NILP(Ffile_exists_p(path)))
{
if (!allowCreate) return NO;
}
else
{
if (!allowOld) return NO;
}
if (!allowDir && !NILP(Ffile_directory_p(path))) return NO;
filename = NXCopyStringBuffer(buf);
return YES;
}
- setAllowCreate:(BOOL)ifAllowCreate
{
allowCreate = ifAllowCreate;
return self;
}
- setAllowOld:(BOOL)ifAllowOld
{
allowOld = ifAllowOld;
return self;
}
- setAllowDir:(BOOL)ifAllowDir
{
allowDir = ifAllowDir;
return self;
}
@end
#endif
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.