* nsfns.m (ns-read-file-name): BLOCK_INPUT while showing dialog. \n \n* nsmenu.m...
[bpt/emacs.git] / src / nsfns.m
index ac12b08..963445b 100644 (file)
@@ -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 <signal.h>
 #include <math.h>
-#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"
 
@@ -86,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;
 
@@ -332,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;
 
@@ -357,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;
@@ -383,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
@@ -414,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;
 
@@ -424,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))
     {
@@ -437,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;
@@ -583,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);
 }
@@ -616,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;
@@ -741,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)
 {
@@ -846,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))
     {
@@ -885,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)
@@ -905,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;
 }
 
@@ -919,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;
+}
+\f
 
+/* 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;
 }
 
 
@@ -989,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 +1045,17 @@ frame_parm_handler ns_frame_parm_handlers[] =
   0, /* x_set_wait_for_wm, will ignore */
   0,  /* x_set_fullscreen will ignore */
   x_set_font_backend, /* generic OK */
-  0
+  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.
@@ -1291,7 +1319,7 @@ be shared by the new frame.  */)
                       RES_TYPE_SYMBOL);
   x_default_parameter (f, parms, Qscroll_bar_width, Qnil, "scrollBarWidth",
                       "ScrollBarWidth", RES_TYPE_NUMBER);
-  x_default_parameter (f, parms, Qalpha, Qt, "alpha", "Alpha",
+  x_default_parameter (f, parms, Qalpha, Qnil, "alpha", "Alpha",
                       RES_TYPE_NUMBER);
 
   width = FRAME_COLS (f);
@@ -1330,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.  */)
@@ -1427,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)];
@@ -1448,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];
 
@@ -1460,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];
@@ -1470,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;
 }
 
 
@@ -1584,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
@@ -1594,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)));
 }
 
 
@@ -1996,11 +2031,21 @@ 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]);
 }
 
@@ -2037,8 +2082,10 @@ ns_do_applescript (script, result)
          *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]))
            {
@@ -2099,14 +2146,15 @@ t.  In case the execution fails, an error is signaled. */)
    ========================================================================== */
 
 
-/* 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)
 {
@@ -2114,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;
@@ -2126,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)
 {
@@ -2140,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));
@@ -2415,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)
@@ -2428,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;
 }
 
 
@@ -2597,6 +2647,7 @@ Value is t if tooltip was open, nil otherwise.  */)
 
 #endif
 
+
 /* ==========================================================================
 
     Lisp interface declaration
@@ -2611,6 +2662,8 @@ syms_of_nsfns ()
 
   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");
@@ -2637,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);