extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
Lisp_Object Qnone;
-Lisp_Object Qns_frame_parameter;
Lisp_Object Qbuffered;
Lisp_Object Qfontsize;
/* Alist of elements (REGEXP . IMAGE) for images of icons associated
to frames.*/
-Lisp_Object Vns_icon_type_alist;
+static Lisp_Object Vns_icon_type_alist;
+
+/* Toolkit version support. */
+static Lisp_Object Vns_version_string;
EmacsTooltip *ns_tooltip;
-------------------------------------------------------------------------- */
{
int i, count;
- id<NSMenuItem> item;
+ NSMenuItem *item;
const char *name;
Lisp_Object nameStr;
unsigned short key;
error ("Unknown color");
}
- [f->output_data.ns->desired_cursor_color release];
- f->output_data.ns->desired_cursor_color = [col retain];
+ [FRAME_CURSOR_COLOR (f) release];
+ FRAME_CURSOR_COLOR (f) = [col retain];
if (FRAME_VISIBLE_P (f))
{
else if (XTYPE (arg) == Lisp_Symbol)
str = SDATA (SYMBOL_NAME (arg));
else return -1;
- if (!strcmp (str, "box")) return filled_box;
- if (!strcmp (str, "hollow")) return hollow_box;
- if (!strcmp (str, "underscore")) return underscore;
- if (!strcmp (str, "bar")) return bar;
- if (!strcmp (str, "no")) return no_highlight;
+ if (!strcmp (str, "box")) return FILLED_BOX_CURSOR;
+ if (!strcmp (str, "hollow")) return HOLLOW_BOX_CURSOR;
+ if (!strcmp (str, "hbar")) return HBAR_CURSOR;
+ if (!strcmp (str, "bar")) return BAR_CURSOR;
+ if (!strcmp (str, "no")) return NO_CURSOR;
return -1;
}
{
switch (arg)
{
- case filled_box: return Qbox;
- case hollow_box: return intern ("hollow");
- case underscore: return intern ("underscore");
- case bar: return intern ("bar");
- case no_highlight:
- default: return intern ("no");
+ case FILLED_BOX_CURSOR: return Qbox;
+ case HOLLOW_BOX_CURSOR: return intern ("hollow");
+ case HBAR_CURSOR: return intern ("hbar");
+ case BAR_CURSOR: return intern ("bar");
+ case NO_CURSOR:
+ default: return intern ("no");
}
}
-
-static void
-ns_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
+/* this is like x_set_cursor_type defined in xfns.c */
+void
+ns_set_cursor_type (f, arg, oldval)
+ FRAME_PTR f;
+ Lisp_Object arg, oldval;
{
- int val;
-
- val = ns_lisp_to_cursor_type (arg);
- if (val >= 0)
- {
- f->output_data.ns->desired_cursor =val;
- }
- else
- {
- store_frame_param (f, Qcursor_type, oldval);
- error ("the `cursor-type' frame parameter should be either `no', `box', \
-`hollow', `underscore' or `bar'.");
- }
+ set_frame_cursor_types (f, arg);
- update_mode_lines++;
+ /* Make sure the cursor gets redrawn. */
+ cursor_type_changed = 1;
}
-
+\f
/* 23: called to set mouse pointer color, but all other terms use it to
initialize pointer types (and don't set the color ;) */
}
+#define Str(x) #x
+#define Xstr(x) Str(x)
+
+static Lisp_Object
+ns_appkit_version ()
+{
+ char tmp[80];
+
+#ifdef NS_IMPL_GNUSTEP
+ sprintf(tmp, "gnustep-gui-%s", Xstr(GNUSTEP_GUI_VERSION));
+#elif defined(NS_IMPL_COCOA)
+ sprintf(tmp, "apple-appkit-%.2f", NSAppKitVersionNumber);
+#else
+ tmp = "ns-unknown";
+#endif
+ return build_string (tmp);
+}
+
+
static void
x_icon (struct frame *f, Lisp_Object parms)
/* --------------------------------------------------------------------------
x_set_fringe_width, /* generic OK */
0, /* x_set_wait_for_wm, will ignore */
0, /* x_set_fullscreen will ignore */
- x_set_font_backend /* generic OK */
+ x_set_font_backend, /* generic OK */
+ 0
};
+
+/* ==========================================================================
+
+ Lisp definitions
+
+ ========================================================================== */
+
DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
1, 1, 0,
doc: /* Make a new Nextstep window, called a \"frame\" in Emacs terms.
check_ns ();
+ /* Seems a little strange, but other terms do it. Perhaps the code below
+ is modifying something? */
+ parms = Fcopy_alist (parms);
+
display = x_get_arg (dpyinfo, parms, Qterminal, 0, 0, RES_TYPE_STRING);
if (EQ (display, Qunbound))
display = Qnil;
if (STRINGP (name))
Vx_resource_name = name;
+ else
+ Vx_resource_name = Vinvocation_name;
parent = x_get_arg (dpyinfo, parms, Qparent_id, 0, 0, RES_TYPE_NUMBER);
if (EQ (parent, Qunbound))
f->icon_name = x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title",
RES_TYPE_STRING);
- if (EQ (f->icon_name, Qunbound) || (XTYPE (f->icon_name) != Lisp_String))
+ if (! STRINGP (f->icon_name))
f->icon_name = Qnil;
FRAME_NS_DISPLAY_INFO (f) = dpyinfo;
Vframe_list = Fcons (frame, Vframe_list);
/*FRAME_NS_DISPLAY_INFO (f)->reference_count++; */
- x_default_parameter (f, parms, Qcursor_type, Qbox, "cursorType", "CursorType",
- RES_TYPE_SYMBOL);
- x_default_parameter (f, parms, Qscroll_bar_width, Qnil, "scrollBarWidth",
- "ScrollBarWidth", RES_TYPE_NUMBER);
x_default_parameter (f, parms, Qicon_type, Qnil, "bitmapIcon", "BitmapIcon",
RES_TYPE_SYMBOL);
- x_default_parameter (f, parms, Qauto_raise, Qnil, "autoRaise", "AutoRaise",
+ x_default_parameter (f, parms, Qauto_raise, Qnil, "autoRaise", "AutoRaiseLower",
RES_TYPE_BOOLEAN);
x_default_parameter (f, parms, Qauto_lower, Qnil, "autoLower", "AutoLower",
RES_TYPE_BOOLEAN);
- x_default_parameter (f, parms, Qbuffered, Qt, "buffered", "Buffered",
- RES_TYPE_BOOLEAN);
+ x_default_parameter (f, parms, Qcursor_type, Qbox, "cursorType", "CursorType",
+ RES_TYPE_SYMBOL);
+ x_default_parameter (f, parms, Qscroll_bar_width, Qnil, "scrollBarWidth",
+ "ScrollBarWidth", RES_TYPE_NUMBER);
+ x_default_parameter (f, parms, Qalpha, Qnil, "alpha", "Alpha",
+ RES_TYPE_NUMBER);
width = FRAME_COLS (f);
height = FRAME_LINES (f);
}
-/* ==========================================================================
-
- Lisp definitions
-
- ========================================================================== */
-
DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0,
doc: /* Set the input focus to FRAME.
FRAME nil means use the selected frame. */)
dirS = [dirS stringByExpandingTildeInPath];
panel = NILP (isLoad) ?
- [EmacsSavePanel savePanel] : [EmacsOpenPanel openPanel];
+ (id)[EmacsSavePanel savePanel] : (id)[EmacsOpenPanel openPanel];
[panel setTitle: promptS];
(display)
Lisp_Object display;
{
- check_ns ();
#ifdef NS_IMPL_GNUSTEP
return build_string ("GNU");
#else
(display)
Lisp_Object display;
{
- /* FIXME: return GUI version on GNUSTEP, ?? on OS X */
- return build_string ("1.0");
+ return ns_appkit_version ();
}
(str)
Lisp_Object str;
{
+/* TODO: If GNUstep ever implements precomposedStringWithCanonicalMapping,
+ remove this. */
NSString *utfStr;
CHECK_STRING (str);
- utfStr = [[NSString stringWithUTF8String: SDATA (str)]
- precomposedStringWithCanonicalMapping];
+ utfStr = [NSString stringWithUTF8String: SDATA (str)];
+ if (![utfStr respondsToSelector:
+ @selector (precomposedStringWithCanonicalMapping)])
+ {
+ message1
+ ("Warning: ns-convert-utf8-nfd-to-nfc unsupported under GNUstep.\n");
+ return Qnil;
+ }
+ else
+ utfStr = [utfStr precomposedStringWithCanonicalMapping];
return build_string ([utfStr UTF8String]);
}
+#ifdef NS_IMPL_COCOA
+
+/* Compile and execute the AppleScript SCRIPT and return the error
+ status as function value. A zero is returned if compilation and
+ execution is successful, in which case *RESULT is set to a Lisp
+ string or a number containing the resulting script value. Otherwise,
+ 1 is returned. */
+static int
+ns_do_applescript (script, result)
+ Lisp_Object script, *result;
+{
+ NSAppleEventDescriptor *desc;
+ NSDictionary* errorDict;
+ NSAppleEventDescriptor* returnDescriptor = NULL;
+
+ NSAppleScript* scriptObject =
+ [[NSAppleScript alloc] initWithSource:
+ [NSString stringWithUTF8String: SDATA (script)]];
+
+ returnDescriptor = [scriptObject executeAndReturnError: &errorDict];
+ [scriptObject release];
+
+ *result = Qnil;
+
+ if (returnDescriptor != NULL)
+ {
+ // successful execution
+ if (kAENullEvent != [returnDescriptor descriptorType])
+ {
+ *result = Qt;
+ // script returned an AppleScript result
+ if ((typeUnicodeText == [returnDescriptor descriptorType]) ||
+ (typeUTF16ExternalRepresentation
+ == [returnDescriptor descriptorType]) ||
+ (typeUTF8Text == [returnDescriptor descriptorType]) ||
+ (typeCString == [returnDescriptor descriptorType]))
+ {
+ desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
+ if (desc)
+ *result = build_string([[desc stringValue] UTF8String]);
+ }
+ else
+ {
+ /* use typeUTF16ExternalRepresentation? */
+ // coerce the result to the appropriate ObjC type
+ desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
+ if (desc)
+ *result = make_number([desc int32Value]);
+ }
+ }
+ }
+ else
+ {
+ // no script result, return error
+ return 1;
+ }
+ return 0;
+}
+
+DEFUN ("ns-do-applescript", Fns_do_applescript, Sns_do_applescript, 1, 1, 0,
+ doc: /* Execute AppleScript SCRIPT and return the result. If
+compilation and execution are successful, the resulting script value
+is returned as a string, a number or, in the case of other constructs,
+t. In case the execution fails, an error is signaled. */)
+ (script)
+ Lisp_Object script;
+{
+ Lisp_Object result;
+ long status;
+
+ CHECK_STRING (script);
+ check_ns ();
+
+ BLOCK_INPUT;
+ status = ns_do_applescript (script, &result);
+ UNBLOCK_INPUT;
+ if (status == 0)
+ return result;
+ else if (!STRINGP (result))
+ error ("AppleScript error %d", status);
+ else
+ error ("%s", SDATA (result));
+}
+#endif
+
+
+
/* ==========================================================================
Miscellaneous functions not called through hooks
========================================================================== */
-#ifdef NS_IMPL_COCOA
-
-/* Compile and execute the AppleScript SCRIPT and return the error
- status as function value. A zero is returned if compilation and
- execution is successful, in which case *RESULT is set to a Lisp
- string or a number containing the resulting script value. Otherwise,
- 1 is returned. */
-
-static int
-do_applescript (script, result)
- Lisp_Object script, *result;
-{
- NSAppleEventDescriptor *desc;
- NSDictionary* errorDict;
- NSAppleEventDescriptor* returnDescriptor = NULL;
-
- NSAppleScript* scriptObject =
- [[NSAppleScript alloc] initWithSource:
- [NSString stringWithUTF8String: SDATA (script)]];
-
- returnDescriptor = [scriptObject executeAndReturnError: &errorDict];
- [scriptObject release];
-
- *result = Qnil;
-
- if (returnDescriptor != NULL)
- {
- // successful execution
- if (kAENullEvent != [returnDescriptor descriptorType])
- {
- *result = Qt;
- // script returned an AppleScript result
- if ((typeUnicodeText == [returnDescriptor descriptorType]) ||
- (typeUTF16ExternalRepresentation
- == [returnDescriptor descriptorType]) ||
- (typeUTF8Text == [returnDescriptor descriptorType]) ||
- (typeCString == [returnDescriptor descriptorType]))
- {
- desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
- if (desc)
- *result = build_string([[desc stringValue] UTF8String]);
- }
- else
- {
- /* use typeUTF16ExternalRepresentation? */
- // coerce the result to the appropriate ObjC type
- desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
- if (desc)
- *result = make_number([desc int32Value]);
- }
- }
- }
- else
- {
- // no script result, return error
- return 1;
- }
- return 0;
-}
-
-DEFUN ("do-applescript", Fdo_applescript, Sdo_applescript, 1, 1, 0,
- doc: /* Execute AppleScript SCRIPT and return the result. If
-compilation and execution are successful, the resulting script value
-is returned as a string, a number or, in the case of other constructs,
-t. In case the execution fails, an error is signaled. */)
- (script)
- Lisp_Object script;
-{
- Lisp_Object result;
- long status;
-
- CHECK_STRING (script);
- check_ns ();
-
- BLOCK_INPUT;
- status = do_applescript (script, &result);
- UNBLOCK_INPUT;
- if (status == 0)
- return result;
- else if (!STRINGP (result))
- error ("AppleScript error %d", status);
- else
- error ("%s", SDATA (result));
-}
-#endif
-
DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
doc: /* Return t if the current Nextstep display supports the color COLOR.
The optional argument FRAME is currently ignored. */)
return make_number ((int) [ns_get_screen (display) frame].size.height);
}
+
DEFUN ("display-usable-bounds", Fns_display_usable_bounds,
Sns_display_usable_bounds, 0, 1, 0,
doc: /*Return the bounds of the usable part of the screen.
/* Ensure in bounds. (Note, screen origin = lower left.) */
if (pt.x + XINT (dx) <= 0)
*root_x = 0; /* Can happen for negative dx */
- else if (pt.x + XINT (dx) + width <= FRAME_NS_DISPLAY_INFO (f)->width)
+ else if (pt.x + XINT (dx) + width
+ <= x_display_pixel_width (FRAME_NS_DISPLAY_INFO (f)))
/* It fits to the right of the pointer. */
*root_x = pt.x + XINT (dx);
else if (width + XINT (dx) <= pt.x)
if (pt.y - XINT (dy) - height >= 0)
/* It fits below the pointer. */
*root_y = pt.y - height - XINT (dy);
- else if (pt.y + XINT (dy) + height <= FRAME_NS_DISPLAY_INFO (f)->height)
+ else if (pt.y + XINT (dy) + height
+ <= x_display_pixel_height (FRAME_NS_DISPLAY_INFO (f)))
/* It fits above the pointer */
*root_y = pt.y + XINT (dy);
else
/* Put it on the top. */
- *root_y = FRAME_NS_DISPLAY_INFO (f)->height - height;
+ *root_y = x_display_pixel_height (FRAME_NS_DISPLAY_INFO (f)) - height;
}
{
int i;
- Qns_frame_parameter = intern ("ns-frame-parameter");
- staticpro (&Qns_frame_parameter);
Qnone = intern ("none");
staticpro (&Qnone);
Qbuffered = intern ("bufferd");
be used as the image of the icon representing the frame. */);
Vns_icon_type_alist = Fcons (Qt, Qnil);
+ DEFVAR_LISP ("ns-version-string", &Vns_version_string,
+ doc: /* Toolkit version for NS Windowing. */);
+ Vns_version_string = ns_appkit_version ();
+
defsubr (&Sns_read_file_name);
defsubr (&Sns_get_resource);
defsubr (&Sns_set_resource);
defsubr (&Sns_font_name);
defsubr (&Sns_list_colors);
#ifdef NS_IMPL_COCOA
- defsubr (&Sdo_applescript);
+ defsubr (&Sns_do_applescript);
#endif
defsubr (&Sxw_color_defined_p);
defsubr (&Sxw_color_values);
HCoop / bpt / emacs.git / blobdiff