X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/712b2de134e18ebf4eb4a5d2154f875becc07d20..7087d5e9af41c8835c3a5090bd8e2c6893685466:/src/nsfns.m diff --git a/src/nsfns.m b/src/nsfns.m index b8e28f1d13..963445b624 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -1,5 +1,5 @@ /* Functions for the NeXT/Open/GNUstep and MacOSX window system. - Copyright (C) 1989, 1992, 1993, 1994, 2005, 2006, 2008 + Copyright (C) 1989, 1992, 1993, 1994, 2005, 2006, 2008, 2009 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -25,9 +25,13 @@ MacOSX/Aqua port by Christophe de Dinechin (descubes@earthlink.net) GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu) */ +/* This should be the first include, as it may set up #defines affecting + interpretation of even the system includes. */ +#include "config.h" + #include #include -#include "config.h" + #include "lisp.h" #include "blockinput.h" #include "nsterm.h" @@ -36,7 +40,6 @@ GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu) #include "keyboard.h" #include "termhooks.h" #include "fontset.h" - #include "character.h" #include "font.h" @@ -78,7 +81,6 @@ extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth; extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle; Lisp_Object Qnone; -Lisp_Object Qns_frame_parameter; Lisp_Object Qbuffered; Lisp_Object Qfontsize; @@ -87,7 +89,10 @@ char panelOK = 0; /* 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; @@ -281,7 +286,7 @@ interpret_services_menu (NSMenu *menu, Lisp_Object prefix, Lisp_Object old) -------------------------------------------------------------------------- */ { int i, count; - id item; + NSMenuItem *item; const char *name; Lisp_Object nameStr; unsigned short key; @@ -333,7 +338,7 @@ interpret_services_menu (NSMenu *menu, Lisp_Object prefix, Lisp_Object old) static void -ns_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +x_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { NSColor *col; @@ -358,7 +363,7 @@ ns_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) static void -ns_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +x_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { struct face *face; NSColor *col; @@ -384,14 +389,6 @@ ns_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) [[view window] setBackgroundColor: col]; alpha = [col alphaComponent]; -#ifdef NS_IMPL_COCOA - /* the alpha code below only works on 10.4, so we need to do something - else (albeit less good) otherwise. - Check NSApplication.h for useful NSAppKitVersionNumber values. */ - if (NSAppKitVersionNumber < 744.0) - [[view window] setAlphaValue: alpha]; -#endif - if (alpha != 1.0) [[view window] setOpaque: NO]; else @@ -415,7 +412,7 @@ ns_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) static void -ns_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +x_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { NSColor *col; @@ -425,8 +422,8 @@ ns_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) 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)) { @@ -438,10 +435,10 @@ ns_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) static void -ns_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { NSView *view = FRAME_NS_VIEW (f); - NSTRACE (ns_set_icon_name); + NSTRACE (x_set_icon_name); if (ns_in_resize) return; @@ -584,9 +581,9 @@ ns_set_name (struct frame *f, Lisp_Object name, int explicit) specified a name for the frame; the name will override any set by the redisplay code. */ static void -ns_explicitly_set_name (FRAME_PTR f, Lisp_Object arg, Lisp_Object oldval) +x_explicitly_set_name (FRAME_PTR f, Lisp_Object arg, Lisp_Object oldval) { - NSTRACE (ns_explicitly_set_name); + NSTRACE (x_explicitly_set_name); ns_set_name_iconic (f, arg, 1); ns_set_name (f, arg, 1); } @@ -617,9 +614,9 @@ x_implicitly_set_name (FRAME_PTR f, Lisp_Object arg, Lisp_Object oldval) suggesting a new name, which lisp code should override; if F->explicit_name is set, ignore the new name; otherwise, set it. */ static void -ns_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name) +x_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name) { - NSTRACE (ns_set_title); + NSTRACE (x_set_title); /* Don't change the title if it's already NAME. */ if (EQ (name, f->title)) return; @@ -742,7 +739,7 @@ x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) } -/* 23: toolbar support */ +/* toolbar support */ void x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) { @@ -847,13 +844,13 @@ ns_implicitly_set_icon_type (struct frame *f) static void -ns_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { EmacsView *view = FRAME_NS_VIEW (f); id image = nil; BOOL setMini = YES; - NSTRACE (ns_set_icon_type); + NSTRACE (x_set_icon_type); if (!NILP (arg) && SYMBOLP (arg)) { @@ -886,7 +883,7 @@ ns_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval) } -/* 23: added Xism; we stub out (we do implement this in ns-win.el) */ +/* Xism; we stub out (we do implement this in ns-win.el) */ int XParseGeometry (char *string, int *x, int *y, unsigned int *width, unsigned int *height) @@ -906,11 +903,11 @@ ns_lisp_to_cursor_type (Lisp_Object arg) 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; } @@ -920,43 +917,68 @@ ns_cursor_type_to_lisp (int arg) { 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"); } } +/* This is the same as the xfns.c definition. */ +void +x_set_cursor_type (f, arg, oldval) + FRAME_PTR f; + Lisp_Object arg, oldval; +{ + set_frame_cursor_types (f, arg); + + /* Make sure the cursor gets redrawn. */ + cursor_type_changed = 1; +} + +/* called to set mouse pointer color, but all other terms use it to + initialize pointer types (and don't set the color ;) */ static void -ns_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { - int val; + /* don't think we can do this on Nextstep */ +} - 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'."); - } - update_mode_lines++; +#define Str(x) #x +#define Xstr(x) Str(x) + +static Lisp_Object +ns_appkit_version_str () +{ + 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); } -/* 23: called to set mouse pointer color, but all other terms use it to - initialize pointer types (and don't set the color ;) */ -static void -ns_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +/* This is for use by x-server-version and collapses all version info we + have into a single int. For a better picture of the implementation + running, use ns_appkit_version_str.*/ +static int +ns_appkit_version_int () { - /* don't think we can do this on Nextstep */ +#ifdef NS_IMPL_GNUSTEP + return GNUSTEP_GUI_MAJOR_VERSION * 100 + GNUSTEP_GNU_MINOR_VERSION; +#elif defined(NS_IMPL_COCOA) + return (int)NSAppKitVersionNumber; +#endif + return 0; } @@ -990,28 +1012,26 @@ x_icon (struct frame *f, Lisp_Object parms) } -/* 23 Note: commented out ns_... entries are no longer used in 23. - commented out x_... entries have not been implemented yet. - see frame.c for template, also where all generic OK functions are impl */ +/* Note: see frame.c for template, also where generic functions are impl */ frame_parm_handler ns_frame_parm_handlers[] = { x_set_autoraise, /* generic OK */ x_set_autolower, /* generic OK */ - ns_set_background_color, + x_set_background_color, 0, /* x_set_border_color, may be impossible under Nextstep */ 0, /* x_set_border_width, may be impossible under Nextstep */ - ns_set_cursor_color, - ns_set_cursor_type, + x_set_cursor_color, + x_set_cursor_type, x_set_font, /* generic OK */ - ns_set_foreground_color, - ns_set_icon_name, - ns_set_icon_type, + x_set_foreground_color, + x_set_icon_name, + x_set_icon_type, x_set_internal_border_width, /* generic OK */ x_set_menu_bar_lines, - ns_set_mouse_color, - ns_explicitly_set_name, + x_set_mouse_color, + x_explicitly_set_name, x_set_scroll_bar_width, /* generic OK */ - ns_set_title, + x_set_title, x_set_unsplittable, /* generic OK */ x_set_vertical_scroll_bars, /* generic OK */ x_set_visibility, /* generic OK */ @@ -1024,10 +1044,18 @@ frame_parm_handler ns_frame_parm_handlers[] = 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 */ + x_set_alpha }; + +/* ========================================================================== + + 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. @@ -1057,6 +1085,10 @@ be shared by the new frame. */) 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; @@ -1075,6 +1107,8 @@ be shared by the new frame. */) 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)) @@ -1136,7 +1170,7 @@ be shared by the new frame. */) 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; @@ -1275,18 +1309,18 @@ be shared by the new frame. */) 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); @@ -1324,12 +1358,6 @@ be shared by the new frame. */) } -/* ========================================================================== - - 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. */) @@ -1421,7 +1449,7 @@ Optional arg INIT, if non-nil, provides a default file name to use. */) static id fileDelegate = nil; int ret; id panel; - NSString *fname; + Lisp_Object fname; NSString *promptS = NILP (prompt) || !STRINGP (prompt) ? nil : [NSString stringWithUTF8String: SDATA (prompt)]; @@ -1442,7 +1470,7 @@ Optional arg INIT, if non-nil, provides a default file name to use. */) dirS = [dirS stringByExpandingTildeInPath]; panel = NILP (isLoad) ? - [EmacsSavePanel savePanel] : [EmacsOpenPanel openPanel]; + (id)[EmacsSavePanel savePanel] : (id)[EmacsOpenPanel openPanel]; [panel setTitle: promptS]; @@ -1454,6 +1482,7 @@ Optional arg INIT, if non-nil, provides a default file name to use. */) [panel setDelegate: fileDelegate]; panelOK = 0; + BLOCK_INPUT; if (NILP (isLoad)) { ret = [panel runModalForDirectory: dirS file: initS]; @@ -1464,13 +1493,15 @@ Optional arg INIT, if non-nil, provides a default file name to use. */) ret = [panel runModalForDirectory: dirS file: initS types: nil]; } - ret = (ret = NSOKButton) || panelOK; - - fname = [panel filename]; + ret = (ret == NSOKButton) || panelOK; + if (ret) + fname = build_string ([[panel filename] UTF8String]); + [[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow]; + UNBLOCK_INPUT; - return ret ? build_string ([fname UTF8String]) : Qnil; + return ret ? fname : Qnil; } @@ -1578,7 +1609,6 @@ If omitted or nil, the selected frame's display is used. */) (display) Lisp_Object display; { - check_ns (); #ifdef NS_IMPL_GNUSTEP return build_string ("GNU"); #else @@ -1588,15 +1618,26 @@ If omitted or nil, the selected frame's display is used. */) DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0, - doc: /* Return the version number of Nextstep display server DISPLAY. + doc: /* Return the version numbers of the server of DISPLAY. +The value is a list of three integers: the major and minor +version numbers of the X Protocol in use, and the distributor-specific +release number. See also the function `x-server-vendor'. + +The optional argument DISPLAY specifies which display to ask about. DISPLAY should be either a frame or a display name (a string). -If omitted or nil, the selected frame's display is used. -See also the function `ns-server-vendor'. */) +If omitted or nil, that stands for the selected frame's display. */) (display) Lisp_Object display; { - /* FIXME: return GUI version on GNUSTEP, ?? on OS X */ - return build_string ("1.0"); + /*NOTE: it is unclear what would best correspond with "protocol"; + we return 10.3, meaning Panther, since this is roughly the + level that GNUstep's APIs correspond to. + The last number is where we distinguish between the Apple + and GNUstep implementations ("distributor-specific release + number") and give int'ized versions of major.minor. */ + return Fcons (make_number (10), + Fcons (make_number (3), + Fcons (make_number (ns_appkit_version_int()), Qnil))); } @@ -1990,15 +2031,114 @@ DEFUN ("ns-convert-utf8-nfd-to-nfc", Fns_convert_utf8_nfd_to_nfc, (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]) || +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_4 + (typeUTF16ExternalRepresentation + == [returnDescriptor descriptorType]) || +#endif + (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 @@ -2006,14 +2146,15 @@ DEFUN ("ns-convert-utf8-nfd-to-nfc", Fns_convert_utf8_nfd_to_nfc, ========================================================================== */ -/* 23: call in image.c */ +/* called from image.c */ FRAME_PTR check_x_frame (Lisp_Object frame) { return check_ns_frame (frame); } -/* 23: added, due to call in frame.c */ + +/* called from frame.c */ struct ns_display_info * check_x_display_info (Lisp_Object frame) { @@ -2021,7 +2162,6 @@ check_x_display_info (Lisp_Object frame) } -/* 23: new function; we don't have much in the way of flexibility though */ void x_set_scroll_bar_default_width (f) struct frame *f; @@ -2033,7 +2173,7 @@ x_set_scroll_bar_default_width (f) } -/* 23: terms now impl this instead of x-get-resource directly */ +/* terms impl this instead of x-get-resource directly */ const char * x_get_string_resource (XrmDatabase rdb, char *name, char *class) { @@ -2047,9 +2187,10 @@ x_get_string_resource (XrmDatabase rdb, char *name, char *class) toCheck = name + (!strncmp (name, "emacs.", 6) ? 6 : 0); /*fprintf (stderr, "Checking '%s'\n", toCheck); */ - - res = [[[NSUserDefaults standardUserDefaults] objectForKey: - [NSString stringWithUTF8String: toCheck]] UTF8String]; + + res = ns_no_defaults ? NULL : + [[[NSUserDefaults standardUserDefaults] objectForKey: + [NSString stringWithUTF8String: toCheck]] UTF8String]; return !res ? NULL : (!strncasecmp (res, "YES", 3) ? "true" : (!strncasecmp (res, "NO", 2) ? "false" : res)); @@ -2121,92 +2262,6 @@ x_sync (Lisp_Object frame) ========================================================================== */ -#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. */) @@ -2313,6 +2368,7 @@ If omitted or nil, that stands for the selected frame's display. */) 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. @@ -2407,7 +2463,8 @@ compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y) /* 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) @@ -2420,12 +2477,13 @@ compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y) 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; } @@ -2589,6 +2647,7 @@ Value is t if tooltip was open, nil otherwise. */) #endif + /* ========================================================================== Lisp interface declaration @@ -2601,10 +2660,10 @@ syms_of_nsfns () { int i; - Qns_frame_parameter = intern ("ns-frame-parameter"); - staticpro (&Qns_frame_parameter); Qnone = intern ("none"); staticpro (&Qnone); + /* FIXME: Because of the typo below, Qbuffered probably never did + anything useful, so it might as well be removed. */ Qbuffered = intern ("bufferd"); staticpro (&Qbuffered); Qfontsize = intern ("fontsize"); @@ -2631,6 +2690,10 @@ When you miniaturize a Group, Summary or Article frame, Gnus.tiff will 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_str (); + defsubr (&Sns_read_file_name); defsubr (&Sns_get_resource); defsubr (&Sns_set_resource); @@ -2639,7 +2702,7 @@ be used as the image of the icon representing the frame. */); 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);