src/nsfns.m

   1 /* Functions for the NeXT/Open/GNUstep and MacOSX window system.
   2
   3 Copyright (C) 1989, 1992-1994, 2005-2006, 2008-2015 Free Software
   4 Foundation, Inc.
   5
   6 This file is part of GNU Emacs.
   7
   8 GNU Emacs is free software: you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation, either version 3 of the License, or
  11 (at your option) any later version.
  12
  13 GNU Emacs is distributed in the hope that it will be useful,
  14 but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 GNU General Public License for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
  20
  21 /*
  22 Originally by Carl Edman
  23 Updated by Christian Limpach (chris@nice.ch)
  24 OpenStep/Rhapsody port by Scott Bender (sbender@harmony-ds.com)
  25 MacOSX/Aqua port by Christophe de Dinechin (descubes@earthlink.net)
  26 GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu)
  27 */
  28
  29 /* This should be the first include, as it may set up #defines affecting
  30    interpretation of even the system includes. */
  31 #include <config.h>
  32
  33 #include <math.h>
  34 #include <c-strcase.h>
  35
  36 #include "lisp.h"
  37 #include "blockinput.h"
  38 #include "nsterm.h"
  39 #include "window.h"
  40 #include "character.h"
  41 #include "buffer.h"
  42 #include "keyboard.h"
  43 #include "termhooks.h"
  44 #include "fontset.h"
  45 #include "font.h"
  46
  47 #ifdef NS_IMPL_COCOA
  48 #include <IOKit/graphics/IOGraphicsLib.h>
  49 #include "macfont.h"
  50 #endif
  51
  52 #if 0
  53 int fns_trace_num = 1;
  54 #define NSTRACE(x)        fprintf (stderr, "%s:%d: [%d] " #x "\n",        \
  55                                   __FILE__, __LINE__, ++fns_trace_num)
  56 #else
  57 #define NSTRACE(x)
  58 #endif
  59
  60 #ifdef HAVE_NS
  61
  62 extern NSArray *ns_send_types, *ns_return_types, *ns_drag_types;
  63
  64 EmacsTooltip *ns_tooltip = nil;
  65
  66 /* Need forward declaration here to preserve organizational integrity of file */
  67 Lisp_Object Fx_open_connection (Lisp_Object, Lisp_Object, Lisp_Object);
  68
  69 /* Static variables to handle applescript execution.  */
  70 static Lisp_Object as_script, *as_result;
  71 static int as_status;
  72
  73 static ptrdiff_t image_cache_refcount;
  74
  75
  76 /* ==========================================================================
  77
  78     Internal utility functions
  79
  80    ========================================================================== */
  81
  82 /* Let the user specify a Nextstep display with a Lisp object.
  83    OBJECT may be nil, a frame or a terminal object.
  84    nil stands for the selected frame--or, if that is not a Nextstep frame,
  85    the first Nextstep display on the list.  */
  86
  87 static struct ns_display_info *
  88 check_ns_display_info (Lisp_Object object)
  89 {
  90   struct ns_display_info *dpyinfo = NULL;
  91
  92   if (NILP (object))
  93     {
  94       struct frame *sf = XFRAME (selected_frame);
  95
  96       if (FRAME_NS_P (sf) && FRAME_LIVE_P (sf))
  97         dpyinfo = FRAME_DISPLAY_INFO (sf);
  98       else if (x_display_list != 0)
  99         dpyinfo = x_display_list;
 100       else
 101         error ("Nextstep windows are not in use or not initialized");
 102     }
 103   else if (TERMINALP (object))
 104     {
 105       struct terminal *t = decode_live_terminal (object);
 106
 107       if (t->type != output_ns)
 108         error ("Terminal %d is not a Nextstep display", t->id);
 109
 110       dpyinfo = t->display_info.ns;
 111     }
 112   else if (STRINGP (object))
 113     dpyinfo = ns_display_info_for_name (object);
 114   else
 115     {
 116       struct frame *f = decode_window_system_frame (object);
 117       dpyinfo = FRAME_DISPLAY_INFO (f);
 118     }
 119
 120   return dpyinfo;
 121 }
 122
 123
 124 static id
 125 ns_get_window (Lisp_Object maybeFrame)
 126 {
 127   id view =nil, window =nil;
 128
 129   if (!FRAMEP (maybeFrame) || !FRAME_NS_P (XFRAME (maybeFrame)))
 130     maybeFrame = selected_frame;/*wrong_type_argument (Qframep, maybeFrame); */
 131
 132   if (!NILP (maybeFrame))
 133     view = FRAME_NS_VIEW (XFRAME (maybeFrame));
 134   if (view) window =[view window];
 135
 136   return window;
 137 }
 138
 139
 140 /* Return the X display structure for the display named NAME.
 141    Open a new connection if necessary.  */
 142 struct ns_display_info *
 143 ns_display_info_for_name (Lisp_Object name)
 144 {
 145   struct ns_display_info *dpyinfo;
 146
 147   CHECK_STRING (name);
 148
 149   for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next)
 150     if (!NILP (Fstring_equal (XCAR (dpyinfo->name_list_element), name)))
 151       return dpyinfo;
 152
 153   error ("Emacs for Nextstep does not yet support multi-display");
 154
 155   Fx_open_connection (name, Qnil, Qnil);
 156   dpyinfo = x_display_list;
 157
 158   if (dpyinfo == 0)
 159     error ("Display on %s not responding.\n", SDATA (name));
 160
 161   return dpyinfo;
 162 }
 163
 164 static NSString *
 165 ns_filename_from_panel (NSSavePanel *panel)
 166 {
 167 #ifdef NS_IMPL_COCOA
 168   NSURL *url = [panel URL];
 169   NSString *str = [url path];
 170   return str;
 171 #else
 172   return [panel filename];
 173 #endif
 174 }
 175
 176 static NSString *
 177 ns_directory_from_panel (NSSavePanel *panel)
 178 {
 179 #ifdef NS_IMPL_COCOA
 180   NSURL *url = [panel directoryURL];
 181   NSString *str = [url path];
 182   return str;
 183 #else
 184   return [panel directory];
 185 #endif
 186 }
 187
 188 static Lisp_Object
 189 interpret_services_menu (NSMenu *menu, Lisp_Object prefix, Lisp_Object old)
 190 /* --------------------------------------------------------------------------
 191    Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
 192    -------------------------------------------------------------------------- */
 193 {
 194   int i, count;
 195   NSMenuItem *item;
 196   const char *name;
 197   Lisp_Object nameStr;
 198   unsigned short key;
 199   NSString *keys;
 200   Lisp_Object res;
 201
 202   count = [menu numberOfItems];
 203   for (i = 0; i<count; i++)
 204     {
 205       item = [menu itemAtIndex: i];
 206       name = [[item title] UTF8String];
 207       if (!name) continue;
 208
 209       nameStr = build_string (name);
 210
 211       if ([item hasSubmenu])
 212         {
 213           old = interpret_services_menu ([item submenu],
 214                                         Fcons (nameStr, prefix), old);
 215         }
 216       else
 217         {
 218           keys = [item keyEquivalent];
 219           if (keys && [keys length] )
 220             {
 221               key = [keys characterAtIndex: 0];
 222               res = make_number (key|super_modifier);
 223             }
 224           else
 225             {
 226               res = Qundefined;
 227             }
 228           old = Fcons (Fcons (res,
 229                             Freverse (Fcons (nameStr,
 230                                            prefix))),
 231                     old);
 232         }
 233     }
 234   return old;
 235 }
 236
 237
 238
 239 /* ==========================================================================
 240
 241     Frame parameter setters
 242
 243    ========================================================================== */
 244
 245
 246 static void
 247 x_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
 248 {
 249   NSColor *col;
 250   EmacsCGFloat r, g, b, alpha;
 251
 252   /* Must block_input, because ns_lisp_to_color does block/unblock_input
 253      which means that col may be deallocated in its unblock_input if there
 254      is user input, unless we also block_input.  */
 255   block_input ();
 256   if (ns_lisp_to_color (arg, &col))
 257     {
 258       store_frame_param (f, Qforeground_color, oldval);
 259       unblock_input ();
 260       error ("Unknown color");
 261     }
 262
 263   [col retain];
 264   [f->output_data.ns->foreground_color release];
 265   f->output_data.ns->foreground_color = col;
 266
 267   [col getRed: &r green: &g blue: &b alpha: &alpha];
 268   FRAME_FOREGROUND_PIXEL (f) =
 269     ARGB_TO_ULONG ((int)(alpha*0xff), (int)(r*0xff), (int)(g*0xff), (int)(b*0xff));
 270
 271   if (FRAME_NS_VIEW (f))
 272     {
 273       update_face_from_frame_parameter (f, Qforeground_color, arg);
 274       /*recompute_basic_faces (f); */
 275       if (FRAME_VISIBLE_P (f))
 276         SET_FRAME_GARBAGED (f);
 277     }
 278   unblock_input ();
 279 }
 280
 281
 282 static void
 283 x_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
 284 {
 285   struct face *face;
 286   NSColor *col;
 287   NSView *view = FRAME_NS_VIEW (f);
 288   EmacsCGFloat r, g, b, alpha;
 289
 290   block_input ();
 291   if (ns_lisp_to_color (arg, &col))
 292     {
 293       store_frame_param (f, Qbackground_color, oldval);
 294       unblock_input ();
 295       error ("Unknown color");
 296     }
 297
 298   /* clear the frame; in some instances the NS-internal GC appears not to
 299      update, or it does update and cannot clear old text properly */
 300   if (FRAME_VISIBLE_P (f))
 301     ns_clear_frame (f);
 302
 303   [col retain];
 304   [f->output_data.ns->background_color release];
 305   f->output_data.ns->background_color = col;
 306
 307   [col getRed: &r green: &g blue: &b alpha: &alpha];
 308   FRAME_BACKGROUND_PIXEL (f) =
 309     ARGB_TO_ULONG ((int)(alpha*0xff), (int)(r*0xff), (int)(g*0xff), (int)(b*0xff));
 310
 311   if (view != nil)
 312     {
 313       [[view window] setBackgroundColor: col];
 314
 315       if (alpha != (EmacsCGFloat) 1.0)
 316           [[view window] setOpaque: NO];
 317       else
 318           [[view window] setOpaque: YES];
 319
 320       face = FRAME_DEFAULT_FACE (f);
 321       if (face)
 322         {
 323           col = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f);
 324           face->background = ns_index_color
 325             ([col colorWithAlphaComponent: alpha], f);
 326
 327           update_face_from_frame_parameter (f, Qbackground_color, arg);
 328         }
 329
 330       if (FRAME_VISIBLE_P (f))
 331         SET_FRAME_GARBAGED (f);
 332     }
 333   unblock_input ();
 334 }
 335
 336
 337 static void
 338 x_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
 339 {
 340   NSColor *col;
 341
 342   block_input ();
 343   if (ns_lisp_to_color (arg, &col))
 344     {
 345       store_frame_param (f, Qcursor_color, oldval);
 346       unblock_input ();
 347       error ("Unknown color");
 348     }
 349
 350   [FRAME_CURSOR_COLOR (f) release];
 351   FRAME_CURSOR_COLOR (f) = [col retain];
 352
 353   if (FRAME_VISIBLE_P (f))
 354     {
 355       x_update_cursor (f, 0);
 356       x_update_cursor (f, 1);
 357     }
 358   update_face_from_frame_parameter (f, Qcursor_color, arg);
 359   unblock_input ();
 360 }
 361
 362
 363 static void
 364 x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
 365 {
 366   NSView *view = FRAME_NS_VIEW (f);
 367   NSTRACE (x_set_icon_name);
 368
 369   /* see if it's changed */
 370   if (STRINGP (arg))
 371     {
 372       if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
 373         return;
 374     }
 375   else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
 376     return;
 377
 378   fset_icon_name (f, arg);
 379
 380   if (NILP (arg))
 381     {
 382       if (!NILP (f->title))
 383         arg = f->title;
 384       else
 385         /* Explicit name and no icon-name -> explicit_name.  */
 386         if (f->explicit_name)
 387           arg = f->name;
 388         else
 389           {
 390             /* No explicit name and no icon-name ->
 391                name has to be rebuild from icon_title_format.  */
 392             windows_or_buffers_changed = 62;
 393             return;
 394           }
 395     }
 396
 397   /* Don't change the name if it's already NAME.  */
 398   if ([[view window] miniwindowTitle]
 399       && ([[[view window] miniwindowTitle]
 400              isEqualToString: [NSString stringWithUTF8String:
 401                                           SSDATA (arg)]]))
 402     return;
 403
 404   [[view window] setMiniwindowTitle:
 405         [NSString stringWithUTF8String: SSDATA (arg)]];
 406 }
 407
 408 static void
 409 ns_set_name_internal (struct frame *f, Lisp_Object name)
 410 {
 411   Lisp_Object encoded_name, encoded_icon_name;
 412   NSString *str;
 413   NSView *view = FRAME_NS_VIEW (f);
 414
 415   encoded_name = ENCODE_UTF_8 (name);
 416
 417   str = [NSString stringWithUTF8String: SSDATA (encoded_name)];
 418
 419   /* Don't change the name if it's already NAME.  */
 420   if (! [[[view window] title] isEqualToString: str])
 421     [[view window] setTitle: str];
 422
 423   if (!STRINGP (f->icon_name))
 424     encoded_icon_name = encoded_name;
 425   else
 426     encoded_icon_name = ENCODE_UTF_8 (f->icon_name);
 427
 428   str = [NSString stringWithUTF8String: SSDATA (encoded_icon_name)];
 429
 430   if ([[view window] miniwindowTitle]
 431       && ! [[[view window] miniwindowTitle] isEqualToString: str])
 432     [[view window] setMiniwindowTitle: str];
 433
 434 }
 435
 436 static void
 437 ns_set_name (struct frame *f, Lisp_Object name, int explicit)
 438 {
 439   NSTRACE (ns_set_name);
 440
 441   /* Make sure that requests from lisp code override requests from
 442      Emacs redisplay code.  */
 443   if (explicit)
 444     {
 445       /* If we're switching from explicit to implicit, we had better
 446          update the mode lines and thereby update the title.  */
 447       if (f->explicit_name && NILP (name))
 448         update_mode_lines = 21;
 449
 450       f->explicit_name = ! NILP (name);
 451     }
 452   else if (f->explicit_name)
 453     return;
 454
 455   if (NILP (name))
 456     name = build_string ([ns_app_name UTF8String]);
 457   else
 458     CHECK_STRING (name);
 459
 460   /* Don't change the name if it's already NAME.  */
 461   if (! NILP (Fstring_equal (name, f->name)))
 462     return;
 463
 464   fset_name (f, name);
 465
 466   /* Title overrides explicit name.  */
 467   if (! NILP (f->title))
 468     name = f->title;
 469
 470   ns_set_name_internal (f, name);
 471 }
 472
 473
 474 /* This function should be called when the user's lisp code has
 475    specified a name for the frame; the name will override any set by the
 476    redisplay code.  */
 477 static void
 478 x_explicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
 479 {
 480   NSTRACE (x_explicitly_set_name);
 481   ns_set_name (f, arg, 1);
 482 }
 483
 484
 485 /* This function should be called by Emacs redisplay code to set the
 486    name; names set this way will never override names set by the user's
 487    lisp code.  */
 488 void
 489 x_implicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
 490 {
 491   NSTRACE (x_implicitly_set_name);
 492
 493   /* Deal with NS specific format t.  */
 494   if (FRAME_NS_P (f) && ((FRAME_ICONIFIED_P (f) && EQ (Vicon_title_format, Qt))
 495                          || EQ (Vframe_title_format, Qt)))
 496     ns_set_name_as_filename (f);
 497   else
 498     ns_set_name (f, arg, 0);
 499 }
 500
 501
 502 /* Change the title of frame F to NAME.
 503    If NAME is nil, use the frame name as the title.  */
 504
 505 static void
 506 x_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name)
 507 {
 508   NSTRACE (x_set_title);
 509   /* Don't change the title if it's already NAME.  */
 510   if (EQ (name, f->title))
 511     return;
 512
 513   update_mode_lines = 22;
 514
 515   fset_title (f, name);
 516
 517   if (NILP (name))
 518     name = f->name;
 519   else
 520     CHECK_STRING (name);
 521
 522   ns_set_name_internal (f, name);
 523 }
 524
 525
 526 void
 527 ns_set_name_as_filename (struct frame *f)
 528 {
 529   NSView *view;
 530   Lisp_Object name, filename;
 531   Lisp_Object buf = XWINDOW (f->selected_window)->contents;
 532   const char *title;
 533   NSAutoreleasePool *pool;
 534   Lisp_Object encoded_name, encoded_filename;
 535   NSString *str;
 536   NSTRACE (ns_set_name_as_filename);
 537
 538   if (f->explicit_name || ! NILP (f->title))
 539     return;
 540
 541   block_input ();
 542   pool = [[NSAutoreleasePool alloc] init];
 543   filename = BVAR (XBUFFER (buf), filename);
 544   name = BVAR (XBUFFER (buf), name);
 545
 546   if (NILP (name))
 547     {
 548       if (! NILP (filename))
 549         name = Ffile_name_nondirectory (filename);
 550       else
 551         name = build_string ([ns_app_name UTF8String]);
 552     }
 553
 554   encoded_name = ENCODE_UTF_8 (name);
 555
 556   view = FRAME_NS_VIEW (f);
 557
 558   title = FRAME_ICONIFIED_P (f) ? [[[view window] miniwindowTitle] UTF8String]
 559                                 : [[[view window] title] UTF8String];
 560
 561   if (title && (! strcmp (title, SSDATA (encoded_name))))
 562     {
 563       [pool release];
 564       unblock_input ();
 565       return;
 566     }
 567
 568   str = [NSString stringWithUTF8String: SSDATA (encoded_name)];
 569   if (str == nil) str = @"Bad coding";
 570
 571   if (FRAME_ICONIFIED_P (f))
 572     [[view window] setMiniwindowTitle: str];
 573   else
 574     {
 575       NSString *fstr;
 576
 577       if (! NILP (filename))
 578         {
 579           encoded_filename = ENCODE_UTF_8 (filename);
 580
 581           fstr = [NSString stringWithUTF8String: SSDATA (encoded_filename)];
 582           if (fstr == nil) fstr = @"";
 583         }
 584       else
 585         fstr = @"";
 586
 587       ns_set_represented_filename (fstr, f);
 588       [[view window] setTitle: str];
 589       fset_name (f, name);
 590     }
 591
 592   [pool release];
 593   unblock_input ();
 594 }
 595
 596
 597 void
 598 ns_set_doc_edited (void)
 599 {
 600   NSAutoreleasePool *pool;
 601   Lisp_Object tail, frame;
 602   block_input ();
 603   pool = [[NSAutoreleasePool alloc] init];
 604   FOR_EACH_FRAME (tail, frame)
 605     {
 606       BOOL edited = NO;
 607       struct frame *f = XFRAME (frame);
 608       struct window *w;
 609       NSView *view;
 610
 611       if (! FRAME_NS_P (f)) continue;
 612       w = XWINDOW (FRAME_SELECTED_WINDOW (f));
 613       view = FRAME_NS_VIEW (f);
 614       if (!MINI_WINDOW_P (w))
 615         edited = ! NILP (Fbuffer_modified_p (w->contents)) &&
 616           ! NILP (Fbuffer_file_name (w->contents));
 617       [[view window] setDocumentEdited: edited];
 618     }
 619
 620   [pool release];
 621   unblock_input ();
 622 }
 623
 624
 625 void
 626 x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
 627 {
 628   int nlines;
 629   if (FRAME_MINIBUF_ONLY_P (f))
 630     return;
 631
 632   if (TYPE_RANGED_INTEGERP (int, value))
 633     nlines = XINT (value);
 634   else
 635     nlines = 0;
 636
 637   FRAME_MENU_BAR_LINES (f) = 0;
 638   if (nlines)
 639     {
 640       FRAME_EXTERNAL_MENU_BAR (f) = 1;
 641       /* does for all frames, whereas we just want for one frame
 642          [NSMenu setMenuBarVisible: YES]; */
 643     }
 644   else
 645     {
 646       if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
 647         free_frame_menubar (f);
 648       /*      [NSMenu setMenuBarVisible: NO]; */
 649       FRAME_EXTERNAL_MENU_BAR (f) = 0;
 650     }
 651 }
 652
 653
 654 /* toolbar support */
 655 void
 656 x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
 657 {
 658   int nlines;
 659
 660   if (FRAME_MINIBUF_ONLY_P (f))
 661     return;
 662
 663   if (RANGED_INTEGERP (0, value, INT_MAX))
 664     nlines = XFASTINT (value);
 665   else
 666     nlines = 0;
 667
 668   if (nlines)
 669     {
 670       FRAME_EXTERNAL_TOOL_BAR (f) = 1;
 671       update_frame_tool_bar (f);
 672     }
 673   else
 674     {
 675       if (FRAME_EXTERNAL_TOOL_BAR (f))
 676         {
 677           free_frame_tool_bar (f);
 678           FRAME_EXTERNAL_TOOL_BAR (f) = 0;
 679         }
 680     }
 681
 682   x_set_window_size (f, 0, f->text_cols, f->text_lines, 0);
 683 }
 684
 685
 686 void
 687 x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
 688 {
 689   int old_width = FRAME_INTERNAL_BORDER_WIDTH (f);
 690
 691   CHECK_TYPE_RANGED_INTEGER (int, arg);
 692   FRAME_INTERNAL_BORDER_WIDTH (f) = XINT (arg);
 693   if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
 694     FRAME_INTERNAL_BORDER_WIDTH (f) = 0;
 695
 696   if (FRAME_INTERNAL_BORDER_WIDTH (f) == old_width)
 697     return;
 698
 699   if (FRAME_X_WINDOW (f) != 0)
 700     adjust_frame_size (f, -1, -1, 3, 0, Qinternal_border_width);
 701
 702   SET_FRAME_GARBAGED (f);
 703 }
 704
 705
 706 static void
 707 ns_implicitly_set_icon_type (struct frame *f)
 708 {
 709   Lisp_Object tem;
 710   EmacsView *view = FRAME_NS_VIEW (f);
 711   id image = nil;
 712   Lisp_Object chain, elt;
 713   NSAutoreleasePool *pool;
 714   BOOL setMini = YES;
 715
 716   NSTRACE (ns_implicitly_set_icon_type);
 717
 718   block_input ();
 719   pool = [[NSAutoreleasePool alloc] init];
 720   if (f->output_data.ns->miniimage
 721       && [[NSString stringWithUTF8String: SSDATA (f->name)]
 722                isEqualToString: [(NSImage *)f->output_data.ns->miniimage name]])
 723     {
 724       [pool release];
 725       unblock_input ();
 726       return;
 727     }
 728
 729   tem = assq_no_quit (Qicon_type, f->param_alist);
 730   if (CONSP (tem) && ! NILP (XCDR (tem)))
 731     {
 732       [pool release];
 733       unblock_input ();
 734       return;
 735     }
 736
 737   for (chain = Vns_icon_type_alist;
 738        image == nil && CONSP (chain);
 739        chain = XCDR (chain))
 740     {
 741       elt = XCAR (chain);
 742       /* special case: t means go by file type */
 743       if (SYMBOLP (elt) && EQ (elt, Qt) && SSDATA (f->name)[0] == '/')
 744         {
 745           NSString *str
 746              = [NSString stringWithUTF8String: SSDATA (f->name)];
 747           if ([[NSFileManager defaultManager] fileExistsAtPath: str])
 748             image = [[[NSWorkspace sharedWorkspace] iconForFile: str] retain];
 749         }
 750       else if (CONSP (elt) &&
 751                STRINGP (XCAR (elt)) &&
 752                STRINGP (XCDR (elt)) &&
 753                fast_string_match (XCAR (elt), f->name) >= 0)
 754         {
 755           image = [EmacsImage allocInitFromFile: XCDR (elt)];
 756           if (image == nil)
 757             image = [[NSImage imageNamed:
 758                                [NSString stringWithUTF8String:
 759                                             SSDATA (XCDR (elt))]] retain];
 760         }
 761     }
 762
 763   if (image == nil)
 764     {
 765       image = [[[NSWorkspace sharedWorkspace] iconForFileType: @"text"] retain];
 766       setMini = NO;
 767     }
 768
 769   [f->output_data.ns->miniimage release];
 770   f->output_data.ns->miniimage = image;
 771   [view setMiniwindowImage: setMini];
 772   [pool release];
 773   unblock_input ();
 774 }
 775
 776
 777 static void
 778 x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
 779 {
 780   EmacsView *view = FRAME_NS_VIEW (f);
 781   id image = nil;
 782   BOOL setMini = YES;
 783
 784   NSTRACE (x_set_icon_type);
 785
 786   if (!NILP (arg) && SYMBOLP (arg))
 787     {
 788       arg =build_string (SSDATA (SYMBOL_NAME (arg)));
 789       store_frame_param (f, Qicon_type, arg);
 790     }
 791
 792   /* do it the implicit way */
 793   if (NILP (arg))
 794     {
 795       ns_implicitly_set_icon_type (f);
 796       return;
 797     }
 798
 799   CHECK_STRING (arg);
 800
 801   image = [EmacsImage allocInitFromFile: arg];
 802   if (image == nil)
 803     image =[NSImage imageNamed: [NSString stringWithUTF8String:
 804                                             SSDATA (arg)]];
 805
 806   if (image == nil)
 807     {
 808       image = [NSImage imageNamed: @"text"];
 809       setMini = NO;
 810     }
 811
 812   f->output_data.ns->miniimage = image;
 813   [view setMiniwindowImage: setMini];
 814 }
 815
 816
 817 /* TODO: move to nsterm? */
 818 int
 819 ns_lisp_to_cursor_type (Lisp_Object arg)
 820 {
 821   char *str;
 822   if (XTYPE (arg) == Lisp_String)
 823     str = SSDATA (arg);
 824   else if (XTYPE (arg) == Lisp_Symbol)
 825     str = SSDATA (SYMBOL_NAME (arg));
 826   else return -1;
 827   if (!strcmp (str, "box"))     return FILLED_BOX_CURSOR;
 828   if (!strcmp (str, "hollow"))  return HOLLOW_BOX_CURSOR;
 829   if (!strcmp (str, "hbar"))    return HBAR_CURSOR;
 830   if (!strcmp (str, "bar"))     return BAR_CURSOR;
 831   if (!strcmp (str, "no"))      return NO_CURSOR;
 832   return -1;
 833 }
 834
 835
 836 Lisp_Object
 837 ns_cursor_type_to_lisp (int arg)
 838 {
 839   switch (arg)
 840     {
 841     case FILLED_BOX_CURSOR: return Qbox;
 842     case HOLLOW_BOX_CURSOR: return Qhollow;
 843     case HBAR_CURSOR:       return Qhbar;
 844     case BAR_CURSOR:        return Qbar;
 845     case NO_CURSOR:
 846     default:                return intern ("no");
 847     }
 848 }
 849
 850 /* This is the same as the xfns.c definition.  */
 851 static void
 852 x_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
 853 {
 854   set_frame_cursor_types (f, arg);
 855 }
 856
 857 /* called to set mouse pointer color, but all other terms use it to
 858    initialize pointer types (and don't set the color ;) */
 859 static void
 860 x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
 861 {
 862   /* don't think we can do this on Nextstep */
 863 }
 864
 865
 866 #define Str(x) #x
 867 #define Xstr(x) Str(x)
 868
 869 static Lisp_Object
 870 ns_appkit_version_str (void)
 871 {
 872   char tmp[256];
 873
 874 #ifdef NS_IMPL_GNUSTEP
 875   sprintf(tmp, "gnustep-gui-%s", Xstr(GNUSTEP_GUI_VERSION));
 876 #elif defined (NS_IMPL_COCOA)
 877   NSString *osversion
 878     = [[NSProcessInfo processInfo] operatingSystemVersionString];
 879   sprintf(tmp, "appkit-%.2f %s",
 880           NSAppKitVersionNumber,
 881           [osversion UTF8String]);
 882 #else
 883   tmp = "ns-unknown";
 884 #endif
 885   return build_string (tmp);
 886 }
 887
 888
 889 /* This is for use by x-server-version and collapses all version info we
 890    have into a single int.  For a better picture of the implementation
 891    running, use ns_appkit_version_str.*/
 892 static int
 893 ns_appkit_version_int (void)
 894 {
 895 #ifdef NS_IMPL_GNUSTEP
 896   return GNUSTEP_GUI_MAJOR_VERSION * 100 + GNUSTEP_GUI_MINOR_VERSION;
 897 #elif defined (NS_IMPL_COCOA)
 898   return (int)NSAppKitVersionNumber;
 899 #endif
 900   return 0;
 901 }
 902
 903
 904 static void
 905 x_icon (struct frame *f, Lisp_Object parms)
 906 /* --------------------------------------------------------------------------
 907    Strangely-named function to set icon position parameters in frame.
 908    This is irrelevant under OS X, but might be needed under GNUstep,
 909    depending on the window manager used.  Note, this is not a standard
 910    frame parameter-setter; it is called directly from x-create-frame.
 911    -------------------------------------------------------------------------- */
 912 {
 913   Lisp_Object icon_x, icon_y;
 914   struct ns_display_info *dpyinfo = check_ns_display_info (Qnil);
 915
 916   f->output_data.ns->icon_top = -1;
 917   f->output_data.ns->icon_left = -1;
 918
 919   /* Set the position of the icon.  */
 920   icon_x = x_get_arg (dpyinfo, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
 921   icon_y = x_get_arg (dpyinfo, parms, Qicon_top, 0, 0,  RES_TYPE_NUMBER);
 922   if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
 923     {
 924       CHECK_NUMBER (icon_x);
 925       CHECK_NUMBER (icon_y);
 926       f->output_data.ns->icon_top = XINT (icon_y);
 927       f->output_data.ns->icon_left = XINT (icon_x);
 928     }
 929   else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
 930     error ("Both left and top icon corners of icon must be specified");
 931 }
 932
 933
 934 /* Note: see frame.c for template, also where generic functions are impl */
 935 frame_parm_handler ns_frame_parm_handlers[] =
 936 {
 937   x_set_autoraise, /* generic OK */
 938   x_set_autolower, /* generic OK */
 939   x_set_background_color,
 940   0, /* x_set_border_color,  may be impossible under Nextstep */
 941   0, /* x_set_border_width,  may be impossible under Nextstep */
 942   x_set_cursor_color,
 943   x_set_cursor_type,
 944   x_set_font, /* generic OK */
 945   x_set_foreground_color,
 946   x_set_icon_name,
 947   x_set_icon_type,
 948   x_set_internal_border_width, /* generic OK */
 949   0, /* x_set_right_divider_width */
 950   0, /* x_set_bottom_divider_width */
 951   x_set_menu_bar_lines,
 952   x_set_mouse_color,
 953   x_explicitly_set_name,
 954   x_set_scroll_bar_width, /* generic OK */
 955   x_set_scroll_bar_height, /* generic OK */
 956   x_set_title,
 957   x_set_unsplittable, /* generic OK */
 958   x_set_vertical_scroll_bars, /* generic OK */
 959   x_set_horizontal_scroll_bars, /* generic OK */
 960   x_set_visibility, /* generic OK */
 961   x_set_tool_bar_lines,
 962   0, /* x_set_scroll_bar_foreground, will ignore (not possible on NS) */
 963   0, /* x_set_scroll_bar_background,  will ignore (not possible on NS) */
 964   x_set_screen_gamma, /* generic OK */
 965   x_set_line_spacing, /* generic OK, sets f->extra_line_spacing to int */
 966   x_set_left_fringe, /* generic OK */
 967   x_set_right_fringe, /* generic OK */
 968   0, /* x_set_wait_for_wm, will ignore */
 969   x_set_fullscreen, /* generic OK */
 970   x_set_font_backend, /* generic OK */
 971   x_set_alpha,
 972   0, /* x_set_sticky */
 973   0, /* x_set_tool_bar_position */
 974 };
 975
 976
 977 /* Handler for signals raised during x_create_frame.
 978    FRAME is the frame which is partially constructed.  */
 979
 980 static void
 981 unwind_create_frame (Lisp_Object frame)
 982 {
 983   struct frame *f = XFRAME (frame);
 984
 985   /* If frame is already dead, nothing to do.  This can happen if the
 986      display is disconnected after the frame has become official, but
 987      before x_create_frame removes the unwind protect.  */
 988   if (!FRAME_LIVE_P (f))
 989     return;
 990
 991   /* If frame is ``official'', nothing to do.  */
 992   if (NILP (Fmemq (frame, Vframe_list)))
 993     {
 994 #if defined GLYPH_DEBUG && defined ENABLE_CHECKING
 995       struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
 996 #endif
 997
 998       /* If the frame's image cache refcount is still the same as our
 999          private shadow variable, it means we are unwinding a frame
1000          for which we didn't yet call init_frame_faces, where the
1001          refcount is incremented.  Therefore, we increment it here, so
1002          that free_frame_faces, called in x_free_frame_resources
1003          below, will not mistakenly decrement the counter that was not
1004          incremented yet to account for this new frame.  */
1005       if (FRAME_IMAGE_CACHE (f) != NULL
1006           && FRAME_IMAGE_CACHE (f)->refcount == image_cache_refcount)
1007         FRAME_IMAGE_CACHE (f)->refcount++;
1008
1009       x_free_frame_resources (f);
1010       free_glyphs (f);
1011
1012 #if defined GLYPH_DEBUG && defined ENABLE_CHECKING
1013       /* Check that reference counts are indeed correct.  */
1014       eassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount);
1015 #endif
1016     }
1017 }
1018
1019 /*
1020  * Read geometry related parameters from preferences if not in PARMS.
1021  * Returns the union of parms and any preferences read.
1022  */
1023
1024 static Lisp_Object
1025 get_geometry_from_preferences (struct ns_display_info *dpyinfo,
1026                                Lisp_Object parms)
1027 {
1028   struct {
1029     const char *val;
1030     const char *cls;
1031     Lisp_Object tem;
1032   } r[] = {
1033     { "width",  "Width", Qwidth },
1034     { "height", "Height", Qheight },
1035     { "left", "Left", Qleft },
1036     { "top", "Top", Qtop },
1037   };
1038
1039   int i;
1040   for (i = 0; i < ARRAYELTS (r); ++i)
1041     {
1042       if (NILP (Fassq (r[i].tem, parms)))
1043         {
1044           Lisp_Object value
1045             = x_get_arg (dpyinfo, parms, r[i].tem, r[i].val, r[i].cls,
1046                          RES_TYPE_NUMBER);
1047           if (! EQ (value, Qunbound))
1048             parms = Fcons (Fcons (r[i].tem, value), parms);
1049         }
1050     }
1051
1052   return parms;
1053 }
1054
1055 /* ==========================================================================
1056
1057     Lisp definitions
1058
1059    ========================================================================== */
1060
1061 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
1062        1, 1, 0,
1063        doc: /* Make a new Nextstep window, called a "frame" in Emacs terms.
1064 Return an Emacs frame object.
1065 PARMS is an alist of frame parameters.
1066 If the parameters specify that the frame should not have a minibuffer,
1067 and do not specify a specific minibuffer window to use,
1068 then `default-minibuffer-frame' must be a frame whose minibuffer can
1069 be shared by the new frame.
1070
1071 This function is an internal primitive--use `make-frame' instead.  */)
1072      (Lisp_Object parms)
1073 {
1074   struct frame *f;
1075   Lisp_Object frame, tem;
1076   Lisp_Object name;
1077   int minibuffer_only = 0;
1078   long window_prompting = 0;
1079   ptrdiff_t count = specpdl_ptr - specpdl;
1080   Lisp_Object display;
1081   struct ns_display_info *dpyinfo = NULL;
1082   Lisp_Object parent;
1083   struct kboard *kb;
1084   static int desc_ctr = 1;
1085
1086   /* x_get_arg modifies parms.  */
1087   parms = Fcopy_alist (parms);
1088
1089   /* Use this general default value to start with
1090      until we know if this frame has a specified name.  */
1091   Vx_resource_name = Vinvocation_name;
1092
1093   display = x_get_arg (dpyinfo, parms, Qterminal, 0, 0, RES_TYPE_STRING);
1094   if (EQ (display, Qunbound))
1095     display = Qnil;
1096   dpyinfo = check_ns_display_info (display);
1097   kb = dpyinfo->terminal->kboard;
1098
1099   if (!dpyinfo->terminal->name)
1100     error ("Terminal is not live, can't create new frames on it");
1101
1102   name = x_get_arg (dpyinfo, parms, Qname, 0, 0, RES_TYPE_STRING);
1103   if (!STRINGP (name)
1104       && ! EQ (name, Qunbound)
1105       && ! NILP (name))
1106     error ("Invalid frame name--not a string or nil");
1107
1108   if (STRINGP (name))
1109     Vx_resource_name = name;
1110
1111   parent = x_get_arg (dpyinfo, parms, Qparent_id, 0, 0, RES_TYPE_NUMBER);
1112   if (EQ (parent, Qunbound))
1113     parent = Qnil;
1114   if (! NILP (parent))
1115     CHECK_NUMBER (parent);
1116
1117   /* make_frame_without_minibuffer can run Lisp code and garbage collect.  */
1118   /* No need to protect DISPLAY because that's not used after passing
1119      it to make_frame_without_minibuffer.  */
1120   frame = Qnil;
1121   tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer",
1122                   RES_TYPE_SYMBOL);
1123   if (EQ (tem, Qnone) || NILP (tem))
1124       f = make_frame_without_minibuffer (Qnil, kb, display);
1125   else if (EQ (tem, Qonly))
1126     {
1127       f = make_minibuffer_frame ();
1128       minibuffer_only = 1;
1129     }
1130   else if (WINDOWP (tem))
1131       f = make_frame_without_minibuffer (tem, kb, display);
1132   else
1133       f = make_frame (1);
1134
1135   XSETFRAME (frame, f);
1136
1137   f->terminal = dpyinfo->terminal;
1138
1139   f->output_method = output_ns;
1140   f->output_data.ns = xzalloc (sizeof *f->output_data.ns);
1141
1142   FRAME_FONTSET (f) = -1;
1143
1144   fset_icon_name (f, x_get_arg (dpyinfo, parms, Qicon_name,
1145                                 "iconName", "Title",
1146                                 RES_TYPE_STRING));
1147   if (! STRINGP (f->icon_name))
1148     fset_icon_name (f, Qnil);
1149
1150   FRAME_DISPLAY_INFO (f) = dpyinfo;
1151
1152   /* With FRAME_DISPLAY_INFO set up, this unwind-protect is safe.  */
1153   record_unwind_protect (unwind_create_frame, frame);
1154
1155   f->output_data.ns->window_desc = desc_ctr++;
1156   if (TYPE_RANGED_INTEGERP (Window, parent))
1157     {
1158       f->output_data.ns->parent_desc = XFASTINT (parent);
1159       f->output_data.ns->explicit_parent = 1;
1160     }
1161   else
1162     {
1163       f->output_data.ns->parent_desc = FRAME_DISPLAY_INFO (f)->root_window;
1164       f->output_data.ns->explicit_parent = 0;
1165     }
1166
1167   /* Set the name; the functions to which we pass f expect the name to
1168      be set.  */
1169   if (EQ (name, Qunbound) || NILP (name) || ! STRINGP (name))
1170     {
1171       fset_name (f, build_string ([ns_app_name UTF8String]));
1172       f->explicit_name = 0;
1173     }
1174   else
1175     {
1176       fset_name (f, name);
1177       f->explicit_name = 1;
1178       specbind (Qx_resource_name, name);
1179     }
1180
1181   block_input ();
1182
1183 #ifdef NS_IMPL_COCOA
1184     mac_register_font_driver (f);
1185 #else
1186     register_font_driver (&nsfont_driver, f);
1187 #endif
1188
1189   image_cache_refcount =
1190     FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
1191
1192   x_default_parameter (f, parms, Qfont_backend, Qnil,
1193                         "fontBackend", "FontBackend", RES_TYPE_STRING);
1194
1195   {
1196     /* use for default font name */
1197     id font = [NSFont userFixedPitchFontOfSize: -1.0]; /* default */
1198     x_default_parameter (f, parms, Qfontsize,
1199                                     make_number (0 /*(int)[font pointSize]*/),
1200                                     "fontSize", "FontSize", RES_TYPE_NUMBER);
1201     // Remove ' Regular', not handled by backends.
1202     char *fontname = xstrdup ([[font displayName] UTF8String]);
1203     int len = strlen (fontname);
1204     if (len > 8 && strcmp (fontname + len - 8, " Regular") == 0)
1205       fontname[len-8] = '\0';
1206     x_default_parameter (f, parms, Qfont,
1207                                  build_string (fontname),
1208                                  "font", "Font", RES_TYPE_STRING);
1209     xfree (fontname);
1210   }
1211   unblock_input ();
1212
1213   x_default_parameter (f, parms, Qborder_width, make_number (0),
1214                        "borderwidth", "BorderWidth", RES_TYPE_NUMBER);
1215   x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
1216                       "internalBorderWidth", "InternalBorderWidth",
1217                       RES_TYPE_NUMBER);
1218
1219   /* default vertical scrollbars on right on Mac */
1220   {
1221       Lisp_Object spos
1222 #ifdef NS_IMPL_GNUSTEP
1223           = Qt;
1224 #else
1225           = Qright;
1226 #endif
1227       x_default_parameter (f, parms, Qvertical_scroll_bars, spos,
1228                            "verticalScrollBars", "VerticalScrollBars",
1229                            RES_TYPE_SYMBOL);
1230   }
1231   x_default_parameter (f, parms, Qhorizontal_scroll_bars, Qnil,
1232                        "horizontalScrollBars", "HorizontalScrollBars",
1233                        RES_TYPE_SYMBOL);
1234   x_default_parameter (f, parms, Qforeground_color, build_string ("Black"),
1235                       "foreground", "Foreground", RES_TYPE_STRING);
1236   x_default_parameter (f, parms, Qbackground_color, build_string ("White"),
1237                       "background", "Background", RES_TYPE_STRING);
1238   /* FIXME: not supported yet in Nextstep */
1239   x_default_parameter (f, parms, Qline_spacing, Qnil,
1240                        "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
1241   x_default_parameter (f, parms, Qleft_fringe, Qnil,
1242                        "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
1243   x_default_parameter (f, parms, Qright_fringe, Qnil,
1244                        "rightFringe", "RightFringe", RES_TYPE_NUMBER);
1245
1246   init_frame_faces (f);
1247
1248   /* Read comment about this code in corresponding place in xfns.c.  */
1249   adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f),
1250                      FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, 1,
1251                      Qx_create_frame_1);
1252
1253   /* The resources controlling the menu-bar and tool-bar are
1254      processed specially at startup, and reflected in the mode
1255      variables; ignore them here.  */
1256   x_default_parameter (f, parms, Qmenu_bar_lines,
1257                        NILP (Vmenu_bar_mode)
1258                        ? make_number (0) : make_number (1),
1259                        NULL, NULL, RES_TYPE_NUMBER);
1260   x_default_parameter (f, parms, Qtool_bar_lines,
1261                        NILP (Vtool_bar_mode)
1262                        ? make_number (0) : make_number (1),
1263                        NULL, NULL, RES_TYPE_NUMBER);
1264
1265   x_default_parameter (f, parms, Qbuffer_predicate, Qnil, "bufferPredicate",
1266                        "BufferPredicate", RES_TYPE_SYMBOL);
1267   x_default_parameter (f, parms, Qtitle, Qnil, "title", "Title",
1268                        RES_TYPE_STRING);
1269
1270   parms = get_geometry_from_preferences (dpyinfo, parms);
1271   window_prompting = x_figure_window_size (f, parms, 1);
1272
1273   tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
1274   f->no_split = minibuffer_only || (!EQ (tem, Qunbound) && !EQ (tem, Qnil));
1275
1276   /* NOTE: on other terms, this is done in set_mouse_color, however this
1277      was not getting called under Nextstep */
1278   f->output_data.ns->text_cursor = [NSCursor IBeamCursor];
1279   f->output_data.ns->nontext_cursor = [NSCursor arrowCursor];
1280   f->output_data.ns->modeline_cursor = [NSCursor pointingHandCursor];
1281   f->output_data.ns->hand_cursor = [NSCursor pointingHandCursor];
1282   f->output_data.ns->hourglass_cursor = [NSCursor disappearingItemCursor];
1283   f->output_data.ns->horizontal_drag_cursor = [NSCursor resizeLeftRightCursor];
1284   f->output_data.ns->vertical_drag_cursor = [NSCursor resizeUpDownCursor];
1285   FRAME_DISPLAY_INFO (f)->vertical_scroll_bar_cursor
1286      = [NSCursor arrowCursor];
1287   FRAME_DISPLAY_INFO (f)->horizontal_scroll_bar_cursor
1288      = [NSCursor arrowCursor];
1289   f->output_data.ns->current_pointer = f->output_data.ns->text_cursor;
1290
1291   [[EmacsView alloc] initFrameFromEmacs: f];
1292
1293   x_icon (f, parms);
1294
1295   /* ns_display_info does not have a reference_count.  */
1296   f->terminal->reference_count++;
1297
1298   /* It is now ok to make the frame official even if we get an error below.
1299      The frame needs to be on Vframe_list or making it visible won't work. */
1300   Vframe_list = Fcons (frame, Vframe_list);
1301
1302   x_default_parameter (f, parms, Qicon_type, Qnil,
1303                        "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
1304
1305   x_default_parameter (f, parms, Qauto_raise, Qnil,
1306                        "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
1307   x_default_parameter (f, parms, Qauto_lower, Qnil,
1308                        "autoLower", "AutoLower", RES_TYPE_BOOLEAN);
1309   x_default_parameter (f, parms, Qcursor_type, Qbox,
1310                        "cursorType", "CursorType", RES_TYPE_SYMBOL);
1311   x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
1312                        "scrollBarWidth", "ScrollBarWidth",
1313                        RES_TYPE_NUMBER);
1314   x_default_parameter (f, parms, Qscroll_bar_height, Qnil,
1315                        "scrollBarHeight", "ScrollBarHeight",
1316                        RES_TYPE_NUMBER);
1317   x_default_parameter (f, parms, Qalpha, Qnil,
1318                        "alpha", "Alpha", RES_TYPE_NUMBER);
1319   x_default_parameter (f, parms, Qfullscreen, Qnil,
1320                        "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
1321
1322   /* Allow x_set_window_size, now.  */
1323   f->can_x_set_window_size = true;
1324
1325   adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), 0, 1,
1326                      Qx_create_frame_2);
1327
1328   if (! f->output_data.ns->explicit_parent)
1329     {
1330       Lisp_Object visibility;
1331
1332       visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0,
1333                               RES_TYPE_SYMBOL);
1334       if (EQ (visibility, Qunbound))
1335         visibility = Qt;
1336
1337       if (EQ (visibility, Qicon))
1338         x_iconify_frame (f);
1339       else if (! NILP (visibility))
1340         {
1341           x_make_frame_visible (f);
1342           [[FRAME_NS_VIEW (f) window] makeKeyWindow];
1343         }
1344       else
1345         {
1346           /* Must have been Qnil.  */
1347         }
1348     }
1349
1350   if (FRAME_HAS_MINIBUF_P (f)
1351       && (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame))
1352           || !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame)))))
1353     kset_default_minibuffer_frame (kb, frame);
1354
1355   /* All remaining specified parameters, which have not been "used"
1356      by x_get_arg and friends, now go in the misc. alist of the frame.  */
1357   for (tem = parms; CONSP (tem); tem = XCDR (tem))
1358     if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
1359       fset_param_alist (f, Fcons (XCAR (tem), f->param_alist));
1360
1361   if (window_prompting & USPosition)
1362     x_set_offset (f, f->left_pos, f->top_pos, 1);
1363
1364   /* Make sure windows on this frame appear in calls to next-window
1365      and similar functions.  */
1366   Vwindow_list = Qnil;
1367
1368   return unbind_to (count, frame);
1369 }
1370
1371 void
1372 x_focus_frame (struct frame *f)
1373 {
1374   struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
1375
1376   if (dpyinfo->x_focus_frame != f)
1377     {
1378       EmacsView *view = FRAME_NS_VIEW (f);
1379       block_input ();
1380       [NSApp activateIgnoringOtherApps: YES];
1381       [[view window] makeKeyAndOrderFront: view];
1382       unblock_input ();
1383     }
1384 }
1385
1386
1387 DEFUN ("ns-popup-font-panel", Fns_popup_font_panel, Sns_popup_font_panel,
1388        0, 1, "",
1389        doc: /* Pop up the font panel. */)
1390      (Lisp_Object frame)
1391 {
1392   struct frame *f = decode_window_system_frame (frame);
1393   id fm = [NSFontManager sharedFontManager];
1394   struct font *font = f->output_data.ns->font;
1395   NSFont *nsfont;
1396 #ifdef NS_IMPL_GNUSTEP
1397   nsfont = ((struct nsfont_info *)font)->nsfont;
1398 #endif
1399 #ifdef NS_IMPL_COCOA
1400   nsfont = (NSFont *) macfont_get_nsctfont (font);
1401 #endif
1402   [fm setSelectedFont: nsfont isMultiple: NO];
1403   [fm orderFrontFontPanel: NSApp];
1404   return Qnil;
1405 }
1406
1407
1408 DEFUN ("ns-popup-color-panel", Fns_popup_color_panel, Sns_popup_color_panel,
1409        0, 1, "",
1410        doc: /* Pop up the color panel.  */)
1411      (Lisp_Object frame)
1412 {
1413   check_window_system (NULL);
1414   [NSApp orderFrontColorPanel: NSApp];
1415   return Qnil;
1416 }
1417
1418 static struct
1419 {
1420   id panel;
1421   BOOL ret;
1422 #ifdef NS_IMPL_GNUSTEP
1423   NSString *dirS, *initS;
1424   BOOL no_types;
1425 #endif
1426 } ns_fd_data;
1427
1428 void
1429 ns_run_file_dialog (void)
1430 {
1431   if (ns_fd_data.panel == nil) return;
1432 #ifdef NS_IMPL_COCOA
1433   ns_fd_data.ret = [ns_fd_data.panel runModal];
1434 #else
1435   if (ns_fd_data.no_types)
1436     {
1437       ns_fd_data.ret = [ns_fd_data.panel
1438                            runModalForDirectory: ns_fd_data.dirS
1439                            file: ns_fd_data.initS];
1440     }
1441   else
1442     {
1443       ns_fd_data.ret = [ns_fd_data.panel
1444                            runModalForDirectory: ns_fd_data.dirS
1445                            file: ns_fd_data.initS
1446                            types: nil];
1447     }
1448 #endif
1449   ns_fd_data.panel = nil;
1450 }
1451
1452 #ifdef NS_IMPL_COCOA
1453 #if MAC_OS_X_VERSION_MAX_ALLOWED > MAC_OS_X_VERSION_10_9
1454 #define MODAL_OK_RESPONSE NSModalResponseOK
1455 #endif
1456 #endif
1457 #ifndef MODAL_OK_RESPONSE
1458 #define MODAL_OK_RESPONSE NSOKButton
1459 #endif
1460
1461 DEFUN ("ns-read-file-name", Fns_read_file_name, Sns_read_file_name, 1, 5, 0,
1462        doc: /* Use a graphical panel to read a file name, using prompt PROMPT.
1463 Optional arg DIR, if non-nil, supplies a default directory.
1464 Optional arg MUSTMATCH, if non-nil, means the returned file or
1465 directory must exist.
1466 Optional arg INIT, if non-nil, provides a default file name to use.
1467 Optional arg DIR_ONLY_P, if non-nil, means choose only directories.  */)
1468   (Lisp_Object prompt, Lisp_Object dir, Lisp_Object mustmatch,
1469    Lisp_Object init, Lisp_Object dir_only_p)
1470 {
1471   static id fileDelegate = nil;
1472   BOOL isSave = NILP (mustmatch) && NILP (dir_only_p);
1473   id panel;
1474   Lisp_Object fname = Qnil;
1475
1476   NSString *promptS = NILP (prompt) || !STRINGP (prompt) ? nil :
1477     [NSString stringWithUTF8String: SSDATA (prompt)];
1478   NSString *dirS = NILP (dir) || !STRINGP (dir) ?
1479     [NSString stringWithUTF8String: SSDATA (BVAR (current_buffer, directory))] :
1480     [NSString stringWithUTF8String: SSDATA (dir)];
1481   NSString *initS = NILP (init) || !STRINGP (init) ? nil :
1482     [NSString stringWithUTF8String: SSDATA (init)];
1483   NSEvent *nxev;
1484
1485   check_window_system (NULL);
1486
1487   if (fileDelegate == nil)
1488     fileDelegate = [EmacsFileDelegate new];
1489
1490   [NSCursor setHiddenUntilMouseMoves: NO];
1491
1492   if ([dirS characterAtIndex: 0] == '~')
1493     dirS = [dirS stringByExpandingTildeInPath];
1494
1495   panel = isSave ?
1496     (id)[EmacsSavePanel savePanel] : (id)[EmacsOpenPanel openPanel];
1497
1498   [panel setTitle: promptS];
1499
1500   [panel setAllowsOtherFileTypes: YES];
1501   [panel setTreatsFilePackagesAsDirectories: YES];
1502   [panel setDelegate: fileDelegate];
1503
1504   if (! NILP (dir_only_p))
1505     {
1506       [panel setCanChooseDirectories: YES];
1507       [panel setCanChooseFiles: NO];
1508     }
1509   else if (! isSave)
1510     {
1511       /* This is not quite what the documentation says, but it is compatible
1512          with the Gtk+ code.  Also, the menu entry says "Open File...".  */
1513       [panel setCanChooseDirectories: NO];
1514       [panel setCanChooseFiles: YES];
1515     }
1516
1517   block_input ();
1518   ns_fd_data.panel = panel;
1519   ns_fd_data.ret = NO;
1520 #ifdef NS_IMPL_COCOA
1521   if (! NILP (mustmatch) || ! NILP (dir_only_p))
1522     [panel setAllowedFileTypes: nil];
1523   if (dirS) [panel setDirectoryURL: [NSURL fileURLWithPath: dirS]];
1524   if (initS && NILP (Ffile_directory_p (init)))
1525     [panel setNameFieldStringValue: [initS lastPathComponent]];
1526   else
1527     [panel setNameFieldStringValue: @""];
1528
1529 #else
1530   ns_fd_data.no_types = NILP (mustmatch) && NILP (dir_only_p);
1531   ns_fd_data.dirS = dirS;
1532   ns_fd_data.initS = initS;
1533 #endif
1534
1535   /* runModalForDirectory/runModal restarts the main event loop when done,
1536      so we must start an event loop and then pop up the file dialog.
1537      The file dialog may pop up a confirm dialog after Ok has been pressed,
1538      so we can not simply pop down on the Ok/Cancel press.
1539    */
1540   nxev = [NSEvent otherEventWithType: NSApplicationDefined
1541                             location: NSMakePoint (0, 0)
1542                        modifierFlags: 0
1543                            timestamp: 0
1544                         windowNumber: [[NSApp mainWindow] windowNumber]
1545                              context: [NSApp context]
1546                              subtype: 0
1547                                data1: 0
1548                                data2: NSAPP_DATA2_RUNFILEDIALOG];
1549
1550   [NSApp postEvent: nxev atStart: NO];
1551   while (ns_fd_data.panel != nil)
1552     [NSApp run];
1553
1554   if (ns_fd_data.ret == MODAL_OK_RESPONSE)
1555     {
1556       NSString *str = ns_filename_from_panel (panel);
1557       if (! str) str = ns_directory_from_panel (panel);
1558       if (str) fname = build_string ([str UTF8String]);
1559     }
1560
1561   [[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow];
1562   unblock_input ();
1563
1564   return fname;
1565 }
1566
1567 const char *
1568 ns_get_defaults_value (const char *key)
1569 {
1570   NSObject *obj = [[NSUserDefaults standardUserDefaults]
1571                     objectForKey: [NSString stringWithUTF8String: key]];
1572
1573   if (!obj) return NULL;
1574
1575   return [[NSString stringWithFormat: @"%@", obj] UTF8String];
1576 }
1577
1578
1579 DEFUN ("ns-get-resource", Fns_get_resource, Sns_get_resource, 2, 2, 0,
1580        doc: /* Return the value of the property NAME of OWNER from the defaults database.
1581 If OWNER is nil, Emacs is assumed.  */)
1582      (Lisp_Object owner, Lisp_Object name)
1583 {
1584   const char *value;
1585
1586   check_window_system (NULL);
1587   if (NILP (owner))
1588     owner = build_string([ns_app_name UTF8String]);
1589   CHECK_STRING (name);
1590
1591   value = ns_get_defaults_value (SSDATA (name));
1592
1593   if (value)
1594     return build_string (value);
1595   return Qnil;
1596 }
1597
1598
1599 DEFUN ("ns-set-resource", Fns_set_resource, Sns_set_resource, 3, 3, 0,
1600        doc: /* Set property NAME of OWNER to VALUE, from the defaults database.
1601 If OWNER is nil, Emacs is assumed.
1602 If VALUE is nil, the default is removed.  */)
1603      (Lisp_Object owner, Lisp_Object name, Lisp_Object value)
1604 {
1605   check_window_system (NULL);
1606   if (NILP (owner))
1607     owner = build_string ([ns_app_name UTF8String]);
1608   CHECK_STRING (name);
1609   if (NILP (value))
1610     {
1611       [[NSUserDefaults standardUserDefaults] removeObjectForKey:
1612                          [NSString stringWithUTF8String: SSDATA (name)]];
1613     }
1614   else
1615     {
1616       CHECK_STRING (value);
1617       [[NSUserDefaults standardUserDefaults] setObject:
1618                 [NSString stringWithUTF8String: SSDATA (value)]
1619                                         forKey: [NSString stringWithUTF8String:
1620                                                          SSDATA (name)]];
1621     }
1622
1623   return Qnil;
1624 }
1625
1626
1627 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
1628        Sx_server_max_request_size,
1629        0, 1, 0,
1630        doc: /* This function is a no-op.  It is only present for completeness.  */)
1631      (Lisp_Object terminal)
1632 {
1633   check_ns_display_info (terminal);
1634   /* This function has no real equivalent under NeXTstep.  Return nil to
1635      indicate this. */
1636   return Qnil;
1637 }
1638
1639
1640 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
1641        doc: /* Return the "vendor ID" string of Nextstep display server TERMINAL.
1642 (Labeling every distributor as a "vendor" embodies the false assumption
1643 that operating systems cannot be developed and distributed noncommercially.)
1644 The optional argument TERMINAL specifies which display to ask about.
1645 TERMINAL should be a terminal object, a frame or a display name (a string).
1646 If omitted or nil, that stands for the selected frame's display.  */)
1647   (Lisp_Object terminal)
1648 {
1649   check_ns_display_info (terminal);
1650 #ifdef NS_IMPL_GNUSTEP
1651   return build_string ("GNU");
1652 #else
1653   return build_string ("Apple");
1654 #endif
1655 }
1656
1657
1658 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
1659        doc: /* Return the version numbers of the server of display TERMINAL.
1660 The value is a list of three integers: the major and minor
1661 version numbers of the X Protocol in use, and the distributor-specific release
1662 number.  See also the function `x-server-vendor'.
1663
1664 The optional argument TERMINAL specifies which display to ask about.
1665 TERMINAL should be a terminal object, a frame or a display name (a string).
1666 If omitted or nil, that stands for the selected frame's display.  */)
1667   (Lisp_Object terminal)
1668 {
1669   check_ns_display_info (terminal);
1670   /*NOTE: it is unclear what would best correspond with "protocol";
1671           we return 10.3, meaning Panther, since this is roughly the
1672           level that GNUstep's APIs correspond to.
1673           The last number is where we distinguish between the Apple
1674           and GNUstep implementations ("distributor-specific release
1675           number") and give int'ized versions of major.minor. */
1676   return list3i (10, 3, ns_appkit_version_int ());
1677 }
1678
1679
1680 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
1681        doc: /* Return the number of screens on Nextstep display server TERMINAL.
1682 The optional argument TERMINAL specifies which display to ask about.
1683 TERMINAL should be a terminal object, a frame or a display name (a string).
1684 If omitted or nil, that stands for the selected frame's display.
1685
1686 Note: "screen" here is not in Nextstep terminology but in X11's.  For
1687 the number of physical monitors, use `(length
1688 (display-monitor-attributes-list TERMINAL))' instead.  */)
1689   (Lisp_Object terminal)
1690 {
1691   check_ns_display_info (terminal);
1692   return make_number (1);
1693 }
1694
1695
1696 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
1697        doc: /* Return the height in millimeters of the Nextstep display TERMINAL.
1698 The optional argument TERMINAL specifies which display to ask about.
1699 TERMINAL should be a terminal object, a frame or a display name (a string).
1700 If omitted or nil, that stands for the selected frame's display.
1701
1702 On \"multi-monitor\" setups this refers to the height in millimeters for
1703 all physical monitors associated with TERMINAL.  To get information
1704 for each physical monitor, use `display-monitor-attributes-list'.  */)
1705   (Lisp_Object terminal)
1706 {
1707   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
1708
1709   return make_number (x_display_pixel_height (dpyinfo) / (92.0/25.4));
1710 }
1711
1712
1713 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
1714        doc: /* Return the width in millimeters of the Nextstep display TERMINAL.
1715 The optional argument TERMINAL specifies which display to ask about.
1716 TERMINAL should be a terminal object, a frame or a display name (a string).
1717 If omitted or nil, that stands for the selected frame's display.
1718
1719 On \"multi-monitor\" setups this refers to the width in millimeters for
1720 all physical monitors associated with TERMINAL.  To get information
1721 for each physical monitor, use `display-monitor-attributes-list'.  */)
1722   (Lisp_Object terminal)
1723 {
1724   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
1725
1726   return make_number (x_display_pixel_width (dpyinfo) / (92.0/25.4));
1727 }
1728
1729
1730 DEFUN ("x-display-backing-store", Fx_display_backing_store,
1731        Sx_display_backing_store, 0, 1, 0,
1732        doc: /* Return an indication of whether the Nextstep display TERMINAL does backing store.
1733 The value may be `buffered', `retained', or `non-retained'.
1734 The optional argument TERMINAL specifies which display to ask about.
1735 TERMINAL should be a terminal object, a frame or a display name (a string).
1736 If omitted or nil, that stands for the selected frame's display.  */)
1737   (Lisp_Object terminal)
1738 {
1739   check_ns_display_info (terminal);
1740   switch ([ns_get_window (terminal) backingType])
1741     {
1742     case NSBackingStoreBuffered:
1743       return intern ("buffered");
1744     case NSBackingStoreRetained:
1745       return intern ("retained");
1746     case NSBackingStoreNonretained:
1747       return intern ("non-retained");
1748     default:
1749       error ("Strange value for backingType parameter of frame");
1750     }
1751   return Qnil;  /* not reached, shut compiler up */
1752 }
1753
1754
1755 DEFUN ("x-display-visual-class", Fx_display_visual_class,
1756        Sx_display_visual_class, 0, 1, 0,
1757        doc: /* Return the visual class of the Nextstep display TERMINAL.
1758 The value is one of the symbols `static-gray', `gray-scale',
1759 `static-color', `pseudo-color', `true-color', or `direct-color'.
1760
1761 The optional argument TERMINAL specifies which display to ask about.
1762 TERMINAL should a terminal object, a frame or a display name (a string).
1763 If omitted or nil, that stands for the selected frame's display.  */)
1764   (Lisp_Object terminal)
1765 {
1766   NSWindowDepth depth;
1767
1768   check_ns_display_info (terminal);
1769   depth = [[[NSScreen screens] objectAtIndex:0] depth];
1770
1771   if ( depth == NSBestDepth (NSCalibratedWhiteColorSpace, 2, 2, YES, NULL))
1772     return intern ("static-gray");
1773   else if (depth == NSBestDepth (NSCalibratedWhiteColorSpace, 8, 8, YES, NULL))
1774     return intern ("gray-scale");
1775   else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 8, YES, NULL))
1776     return intern ("pseudo-color");
1777   else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 4, 12, NO, NULL))
1778     return intern ("true-color");
1779   else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 24, NO, NULL))
1780     return intern ("direct-color");
1781   else
1782     /* color mgmt as far as we do it is really handled by Nextstep itself anyway */
1783     return intern ("direct-color");
1784 }
1785
1786
1787 DEFUN ("x-display-save-under", Fx_display_save_under,
1788        Sx_display_save_under, 0, 1, 0,
1789        doc: /* Return t if TERMINAL supports the save-under feature.
1790 The optional argument TERMINAL specifies which display to ask about.
1791 TERMINAL should be a terminal object, a frame or a display name (a string).
1792 If omitted or nil, that stands for the selected frame's display.  */)
1793   (Lisp_Object terminal)
1794 {
1795   check_ns_display_info (terminal);
1796   switch ([ns_get_window (terminal) backingType])
1797     {
1798     case NSBackingStoreBuffered:
1799       return Qt;
1800
1801     case NSBackingStoreRetained:
1802     case NSBackingStoreNonretained:
1803       return Qnil;
1804
1805     default:
1806       error ("Strange value for backingType parameter of frame");
1807     }
1808   return Qnil;  /* not reached, shut compiler up */
1809 }
1810
1811
1812 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
1813        1, 3, 0,
1814        doc: /* Open a connection to a display server.
1815 DISPLAY is the name of the display to connect to.
1816 Optional second arg XRM-STRING is a string of resources in xrdb format.
1817 If the optional third arg MUST-SUCCEED is non-nil,
1818 terminate Emacs if we can't open the connection.
1819 (In the Nextstep version, the last two arguments are currently ignored.)  */)
1820      (Lisp_Object display, Lisp_Object resource_string, Lisp_Object must_succeed)
1821 {
1822   struct ns_display_info *dpyinfo;
1823
1824   CHECK_STRING (display);
1825
1826   nxatoms_of_nsselect ();
1827   dpyinfo = ns_term_init (display);
1828   if (dpyinfo == 0)
1829     {
1830       if (!NILP (must_succeed))
1831         fatal ("Display on %s not responding.\n",
1832                SSDATA (display));
1833       else
1834         error ("Display on %s not responding.\n",
1835                SSDATA (display));
1836     }
1837
1838   return Qnil;
1839 }
1840
1841
1842 DEFUN ("x-close-connection", Fx_close_connection, Sx_close_connection,
1843        1, 1, 0,
1844        doc: /* Close the connection to TERMINAL's Nextstep display server.
1845 For TERMINAL, specify a terminal object, a frame or a display name (a
1846 string).  If TERMINAL is nil, that stands for the selected frame's
1847 terminal.  */)
1848      (Lisp_Object terminal)
1849 {
1850   check_ns_display_info (terminal);
1851   [NSApp terminate: NSApp];
1852   return Qnil;
1853 }
1854
1855
1856 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
1857        doc: /* Return the list of display names that Emacs has connections to.  */)
1858      (void)
1859 {
1860   Lisp_Object result = Qnil;
1861   struct ns_display_info *ndi;
1862
1863   for (ndi = x_display_list; ndi; ndi = ndi->next)
1864     result = Fcons (XCAR (ndi->name_list_element), result);
1865
1866   return result;
1867 }
1868
1869
1870 DEFUN ("ns-hide-others", Fns_hide_others, Sns_hide_others,
1871        0, 0, 0,
1872        doc: /* Hides all applications other than Emacs.  */)
1873      (void)
1874 {
1875   check_window_system (NULL);
1876   [NSApp hideOtherApplications: NSApp];
1877   return Qnil;
1878 }
1879
1880 DEFUN ("ns-hide-emacs", Fns_hide_emacs, Sns_hide_emacs,
1881        1, 1, 0,
1882        doc: /* If ON is non-nil, the entire Emacs application is hidden.
1883 Otherwise if Emacs is hidden, it is unhidden.
1884 If ON is equal to `activate', Emacs is unhidden and becomes
1885 the active application.  */)
1886      (Lisp_Object on)
1887 {
1888   check_window_system (NULL);
1889   if (EQ (on, intern ("activate")))
1890     {
1891       [NSApp unhide: NSApp];
1892       [NSApp activateIgnoringOtherApps: YES];
1893     }
1894   else if (NILP (on))
1895     [NSApp unhide: NSApp];
1896   else
1897     [NSApp hide: NSApp];
1898   return Qnil;
1899 }
1900
1901
1902 DEFUN ("ns-emacs-info-panel", Fns_emacs_info_panel, Sns_emacs_info_panel,
1903        0, 0, 0,
1904        doc: /* Shows the 'Info' or 'About' panel for Emacs.  */)
1905      (void)
1906 {
1907   check_window_system (NULL);
1908   [NSApp orderFrontStandardAboutPanel: nil];
1909   return Qnil;
1910 }
1911
1912
1913 DEFUN ("ns-font-name", Fns_font_name, Sns_font_name, 1, 1, 0,
1914        doc: /* Determine font PostScript or family name for font NAME.
1915 NAME should be a string containing either the font name or an XLFD
1916 font descriptor.  If string contains `fontset' and not
1917 `fontset-startup', it is left alone. */)
1918      (Lisp_Object name)
1919 {
1920   char *nm;
1921   CHECK_STRING (name);
1922   nm = SSDATA (name);
1923
1924   if (nm[0] != '-')
1925     return name;
1926   if (strstr (nm, "fontset") && !strstr (nm, "fontset-startup"))
1927     return name;
1928
1929   return build_string (ns_xlfd_to_fontname (SSDATA (name)));
1930 }
1931
1932
1933 DEFUN ("ns-list-colors", Fns_list_colors, Sns_list_colors, 0, 1, 0,
1934        doc: /* Return a list of all available colors.
1935 The optional argument FRAME is currently ignored.  */)
1936      (Lisp_Object frame)
1937 {
1938   Lisp_Object list = Qnil;
1939   NSEnumerator *colorlists;
1940   NSColorList *clist;
1941
1942   if (!NILP (frame))
1943     {
1944       CHECK_FRAME (frame);
1945       if (! FRAME_NS_P (XFRAME (frame)))
1946         error ("non-Nextstep frame used in `ns-list-colors'");
1947     }
1948
1949   block_input ();
1950
1951   colorlists = [[NSColorList availableColorLists] objectEnumerator];
1952   while ((clist = [colorlists nextObject]))
1953     {
1954       if ([[clist name] length] < 7 ||
1955           [[clist name] rangeOfString: @"PANTONE"].location == 0)
1956         {
1957           NSEnumerator *cnames = [[clist allKeys] reverseObjectEnumerator];
1958           NSString *cname;
1959           while ((cname = [cnames nextObject]))
1960             list = Fcons (build_string ([cname UTF8String]), list);
1961 /*           for (i = [[clist allKeys] count] - 1; i >= 0; i--)
1962                list = Fcons (build_string ([[[clist allKeys] objectAtIndex: i]
1963                                              UTF8String]), list); */
1964         }
1965     }
1966
1967   unblock_input ();
1968
1969   return list;
1970 }
1971
1972
1973 DEFUN ("ns-list-services", Fns_list_services, Sns_list_services, 0, 0, 0,
1974        doc: /* List available Nextstep services by querying NSApp.  */)
1975      (void)
1976 {
1977 #ifdef NS_IMPL_COCOA
1978   /* You can't get services like this in 10.6+.  */
1979   return Qnil;
1980 #else
1981   Lisp_Object ret = Qnil;
1982   NSMenu *svcs;
1983 #ifdef NS_IMPL_COCOA
1984   id delegate;
1985 #endif
1986
1987   check_window_system (NULL);
1988   svcs = [[NSMenu alloc] initWithTitle: @"Services"];
1989   [NSApp setServicesMenu: svcs];
1990   [NSApp registerServicesMenuSendTypes: ns_send_types
1991                            returnTypes: ns_return_types];
1992
1993 /* On Tiger, services menu updating was made lazier (waits for user to
1994    actually click on the menu), so we have to force things along: */
1995 #ifdef NS_IMPL_COCOA
1996   delegate = [svcs delegate];
1997   if (delegate != nil)
1998     {
1999       if ([delegate respondsToSelector: @selector (menuNeedsUpdate:)])
2000         [delegate menuNeedsUpdate: svcs];
2001       if ([delegate respondsToSelector:
2002                        @selector (menu:updateItem:atIndex:shouldCancel:)])
2003         {
2004           int i, len = [delegate numberOfItemsInMenu: svcs];
2005           for (i =0; i<len; i++)
2006             [svcs addItemWithTitle: @"" action: NULL keyEquivalent: @""];
2007           for (i =0; i<len; i++)
2008             if (![delegate menu: svcs
2009                      updateItem: (NSMenuItem *)[svcs itemAtIndex: i]
2010                         atIndex: i shouldCancel: NO])
2011               break;
2012         }
2013     }
2014 #endif
2015
2016   [svcs setAutoenablesItems: NO];
2017 #ifdef NS_IMPL_COCOA
2018   [svcs update]; /* on OS X, converts from '/' structure */
2019 #endif
2020
2021   ret = interpret_services_menu (svcs, Qnil, ret);
2022   return ret;
2023 #endif
2024 }
2025
2026
2027 DEFUN ("ns-perform-service", Fns_perform_service, Sns_perform_service,
2028        2, 2, 0,
2029        doc: /* Perform Nextstep SERVICE on SEND.
2030 SEND should be either a string or nil.
2031 The return value is the result of the service, as string, or nil if
2032 there was no result.  */)
2033      (Lisp_Object service, Lisp_Object send)
2034 {
2035   id pb;
2036   NSString *svcName;
2037   char *utfStr;
2038
2039   CHECK_STRING (service);
2040   check_window_system (NULL);
2041
2042   utfStr = SSDATA (service);
2043   svcName = [NSString stringWithUTF8String: utfStr];
2044
2045   pb =[NSPasteboard pasteboardWithUniqueName];
2046   ns_string_to_pasteboard (pb, send);
2047
2048   if (NSPerformService (svcName, pb) == NO)
2049     Fsignal (Qquit, list1 (build_string ("service not available")));
2050
2051   if ([[pb types] count] == 0)
2052     return build_string ("");
2053   return ns_string_from_pasteboard (pb);
2054 }
2055
2056
2057 DEFUN ("ns-convert-utf8-nfd-to-nfc", Fns_convert_utf8_nfd_to_nfc,
2058        Sns_convert_utf8_nfd_to_nfc, 1, 1, 0,
2059        doc: /* Return an NFC string that matches the UTF-8 NFD string STR.  */)
2060      (Lisp_Object str)
2061 {
2062 /* TODO: If GNUstep ever implements precomposedStringWithCanonicalMapping,
2063          remove this. */
2064   NSString *utfStr;
2065   Lisp_Object ret = Qnil;
2066   NSAutoreleasePool *pool;
2067
2068   CHECK_STRING (str);
2069   pool = [[NSAutoreleasePool alloc] init];
2070   utfStr = [NSString stringWithUTF8String: SSDATA (str)];
2071 #ifdef NS_IMPL_COCOA
2072   if (utfStr)
2073     utfStr = [utfStr precomposedStringWithCanonicalMapping];
2074 #endif
2075   if (utfStr)
2076     {
2077       const char *cstr = [utfStr UTF8String];
2078       if (cstr)
2079         ret = build_string (cstr);
2080     }
2081
2082   [pool release];
2083   if (NILP (ret))
2084     error ("Invalid UTF-8");
2085
2086   return ret;
2087 }
2088
2089
2090 #ifdef NS_IMPL_COCOA
2091
2092 /* Compile and execute the AppleScript SCRIPT and return the error
2093    status as function value.  A zero is returned if compilation and
2094    execution is successful, in which case *RESULT is set to a Lisp
2095    string or a number containing the resulting script value.  Otherwise,
2096    1 is returned. */
2097 static int
2098 ns_do_applescript (Lisp_Object script, Lisp_Object *result)
2099 {
2100   NSAppleEventDescriptor *desc;
2101   NSDictionary* errorDict;
2102   NSAppleEventDescriptor* returnDescriptor = NULL;
2103
2104   NSAppleScript* scriptObject =
2105     [[NSAppleScript alloc] initWithSource:
2106                              [NSString stringWithUTF8String: SSDATA (script)]];
2107
2108   returnDescriptor = [scriptObject executeAndReturnError: &errorDict];
2109   [scriptObject release];
2110   *result = Qnil;
2111
2112   if (returnDescriptor != NULL)
2113     {
2114       // successful execution
2115       if (kAENullEvent != [returnDescriptor descriptorType])
2116         {
2117           *result = Qt;
2118           // script returned an AppleScript result
2119           if ((typeUnicodeText == [returnDescriptor descriptorType]) ||
2120 #if defined (NS_IMPL_COCOA)
2121               (typeUTF16ExternalRepresentation
2122                == [returnDescriptor descriptorType]) ||
2123 #endif
2124               (typeUTF8Text == [returnDescriptor descriptorType]) ||
2125               (typeCString == [returnDescriptor descriptorType]))
2126             {
2127               desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
2128               if (desc)
2129                 *result = build_string([[desc stringValue] UTF8String]);
2130             }
2131           else
2132             {
2133               /* use typeUTF16ExternalRepresentation? */
2134               // coerce the result to the appropriate ObjC type
2135               desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
2136               if (desc)
2137                 *result = make_number([desc int32Value]);
2138             }
2139         }
2140     }
2141   else
2142     {
2143       // no script result, return error
2144       return 1;
2145     }
2146   return 0;
2147 }
2148
2149 /* Helper function called from sendEvent to run applescript
2150    from within the main event loop.  */
2151
2152 void
2153 ns_run_ascript (void)
2154 {
2155   if (! NILP (as_script))
2156     as_status = ns_do_applescript (as_script, as_result);
2157   as_script = Qnil;
2158 }
2159
2160 DEFUN ("ns-do-applescript", Fns_do_applescript, Sns_do_applescript, 1, 1, 0,
2161        doc: /* Execute AppleScript SCRIPT and return the result.
2162 If compilation and execution are successful, the resulting script value
2163 is returned as a string, a number or, in the case of other constructs, t.
2164 In case the execution fails, an error is signaled. */)
2165      (Lisp_Object script)
2166 {
2167   Lisp_Object result;
2168   int status;
2169   NSEvent *nxev;
2170   struct input_event ev;
2171
2172   CHECK_STRING (script);
2173   check_window_system (NULL);
2174
2175   block_input ();
2176
2177   as_script = script;
2178   as_result = &result;
2179
2180   /* executing apple script requires the event loop to run, otherwise
2181      errors aren't returned and executeAndReturnError hangs forever.
2182      Post an event that runs applescript and then start the event loop.
2183      The event loop is exited when the script is done.  */
2184   nxev = [NSEvent otherEventWithType: NSApplicationDefined
2185                             location: NSMakePoint (0, 0)
2186                        modifierFlags: 0
2187                            timestamp: 0
2188                         windowNumber: [[NSApp mainWindow] windowNumber]
2189                              context: [NSApp context]
2190                              subtype: 0
2191                                data1: 0
2192                                data2: NSAPP_DATA2_RUNASSCRIPT];
2193
2194   [NSApp postEvent: nxev atStart: NO];
2195
2196   // If there are other events, the event loop may exit.  Keep running
2197   // until the script has been handled.  */
2198   ns_init_events (&ev);
2199   while (! NILP (as_script))
2200     [NSApp run];
2201   ns_finish_events ();
2202
2203   status = as_status;
2204   as_status = 0;
2205   as_result = 0;
2206   unblock_input ();
2207   if (status == 0)
2208     return result;
2209   else if (!STRINGP (result))
2210     error ("AppleScript error %d", status);
2211   else
2212     error ("%s", SSDATA (result));
2213 }
2214 #endif
2215
2216
2217
2218 /* ==========================================================================
2219
2220     Miscellaneous functions not called through hooks
2221
2222    ========================================================================== */
2223
2224 /* called from frame.c */
2225 struct ns_display_info *
2226 check_x_display_info (Lisp_Object frame)
2227 {
2228   return check_ns_display_info (frame);
2229 }
2230
2231
2232 void
2233 x_set_scroll_bar_default_width (struct frame *f)
2234 {
2235   int wid = FRAME_COLUMN_WIDTH (f);
2236   FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = NS_SCROLL_BAR_WIDTH_DEFAULT;
2237   FRAME_CONFIG_SCROLL_BAR_COLS (f) = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) +
2238                                       wid - 1) / wid;
2239 }
2240
2241 void
2242 x_set_scroll_bar_default_height (struct frame *f)
2243 {
2244   int height = FRAME_LINE_HEIGHT (f);
2245   FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) = NS_SCROLL_BAR_WIDTH_DEFAULT;
2246   FRAME_CONFIG_SCROLL_BAR_LINES (f) = (FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) +
2247                                        height - 1) / height;
2248 }
2249
2250 /* terms impl this instead of x-get-resource directly */
2251 char *
2252 x_get_string_resource (XrmDatabase rdb, const char *name, const char *class)
2253 {
2254   /* remove appname prefix; TODO: allow for !="Emacs" */
2255   const char *res, *toCheck = class + (!strncmp (class, "Emacs.", 6) ? 6 : 0);
2256
2257   check_window_system (NULL);
2258
2259   if (inhibit_x_resources)
2260     /* --quick was passed, so this is a no-op.  */
2261     return NULL;
2262
2263   res = ns_get_defaults_value (toCheck);
2264   return (!res ? NULL :
2265           (!c_strncasecmp (res, "YES", 3) ? "true" :
2266            (!c_strncasecmp (res, "NO", 2) ? "false" : (char *) res)));
2267 }
2268
2269
2270 Lisp_Object
2271 x_get_focus_frame (struct frame *frame)
2272 {
2273   struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (frame);
2274   Lisp_Object nsfocus;
2275
2276   if (!dpyinfo->x_focus_frame)
2277     return Qnil;
2278
2279   XSETFRAME (nsfocus, dpyinfo->x_focus_frame);
2280   return nsfocus;
2281 }
2282
2283 /* ==========================================================================
2284
2285     Lisp definitions that, for whatever reason, we can't alias as 'ns-XXX'.
2286
2287    ========================================================================== */
2288
2289
2290 DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
2291        doc: /* Internal function called by `color-defined-p', which see.
2292 (Note that the Nextstep version of this function ignores FRAME.)  */)
2293      (Lisp_Object color, Lisp_Object frame)
2294 {
2295   NSColor * col;
2296   check_window_system (NULL);
2297   return ns_lisp_to_color (color, &col) ? Qnil : Qt;
2298 }
2299
2300
2301 DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
2302        doc: /* Internal function called by `color-values', which see.  */)
2303      (Lisp_Object color, Lisp_Object frame)
2304 {
2305   NSColor * col;
2306   EmacsCGFloat red, green, blue, alpha;
2307
2308   check_window_system (NULL);
2309   CHECK_STRING (color);
2310
2311   block_input ();
2312   if (ns_lisp_to_color (color, &col))
2313     {
2314       unblock_input ();
2315       return Qnil;
2316     }
2317
2318   [[col colorUsingDefaultColorSpace]
2319         getRed: &red green: &green blue: &blue alpha: &alpha];
2320   unblock_input ();
2321   return list3i (lrint (red * 65280), lrint (green * 65280),
2322                  lrint (blue * 65280));
2323 }
2324
2325
2326 DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
2327        doc: /* Internal function called by `display-color-p', which see.  */)
2328      (Lisp_Object terminal)
2329 {
2330   NSWindowDepth depth;
2331   NSString *colorSpace;
2332
2333   check_ns_display_info (terminal);
2334   depth = [[[NSScreen screens] objectAtIndex:0] depth];
2335   colorSpace = NSColorSpaceFromDepth (depth);
2336
2337   return    [colorSpace isEqualToString: NSDeviceWhiteColorSpace]
2338          || [colorSpace isEqualToString: NSCalibratedWhiteColorSpace]
2339       ? Qnil : Qt;
2340 }
2341
2342
2343 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
2344        0, 1, 0,
2345        doc: /* Return t if the Nextstep display supports shades of gray.
2346 Note that color displays do support shades of gray.
2347 The optional argument TERMINAL specifies which display to ask about.
2348 TERMINAL should be a terminal object, a frame or a display name (a string).
2349 If omitted or nil, that stands for the selected frame's display.  */)
2350   (Lisp_Object terminal)
2351 {
2352   NSWindowDepth depth;
2353
2354   check_ns_display_info (terminal);
2355   depth = [[[NSScreen screens] objectAtIndex:0] depth];
2356
2357   return NSBitsPerPixelFromDepth (depth) > 1 ? Qt : Qnil;
2358 }
2359
2360
2361 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
2362        0, 1, 0,
2363        doc: /* Return the width in pixels of the Nextstep display TERMINAL.
2364 The optional argument TERMINAL specifies which display to ask about.
2365 TERMINAL should be a terminal object, a frame or a display name (a string).
2366 If omitted or nil, that stands for the selected frame's display.
2367
2368 On \"multi-monitor\" setups this refers to the pixel width for all
2369 physical monitors associated with TERMINAL.  To get information for
2370 each physical monitor, use `display-monitor-attributes-list'.  */)
2371   (Lisp_Object terminal)
2372 {
2373   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
2374
2375   return make_number (x_display_pixel_width (dpyinfo));
2376 }
2377
2378
2379 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
2380        Sx_display_pixel_height, 0, 1, 0,
2381        doc: /* Return the height in pixels of the Nextstep display TERMINAL.
2382 The optional argument TERMINAL specifies which display to ask about.
2383 TERMINAL should be a terminal object, a frame or a display name (a string).
2384 If omitted or nil, that stands for the selected frame's display.
2385
2386 On \"multi-monitor\" setups this refers to the pixel height for all
2387 physical monitors associated with TERMINAL.  To get information for
2388 each physical monitor, use `display-monitor-attributes-list'.  */)
2389   (Lisp_Object terminal)
2390 {
2391   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
2392
2393   return make_number (x_display_pixel_height (dpyinfo));
2394 }
2395
2396 #ifdef NS_IMPL_COCOA
2397
2398 /* Returns the name for the screen that OBJ represents, or NULL.
2399    Caller must free return value.
2400 */
2401
2402 static char *
2403 ns_get_name_from_ioreg (io_object_t obj)
2404 {
2405   char *name = NULL;
2406
2407   NSDictionary *info = (NSDictionary *)
2408     IODisplayCreateInfoDictionary (obj, kIODisplayOnlyPreferredName);
2409   NSDictionary *names = [info objectForKey:
2410                                 [NSString stringWithUTF8String:
2411                                             kDisplayProductName]];
2412
2413   if ([names count] > 0)
2414     {
2415       NSString *n = [names objectForKey: [[names allKeys]
2416                                                  objectAtIndex:0]];
2417       if (n != nil) name = xstrdup ([n UTF8String]);
2418     }
2419
2420   [info release];
2421
2422   return name;
2423 }
2424
2425 /* Returns the name for the screen that DID came from, or NULL.
2426    Caller must free return value.
2427 */
2428
2429 static char *
2430 ns_screen_name (CGDirectDisplayID did)
2431 {
2432   char *name = NULL;
2433
2434 #if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_9
2435   mach_port_t masterPort;
2436   io_iterator_t it;
2437   io_object_t obj;
2438
2439   // CGDisplayIOServicePort is deprecated.  Do it another (harder) way.
2440
2441   if (IOMasterPort (MACH_PORT_NULL, &masterPort) != kIOReturnSuccess
2442       || IOServiceGetMatchingServices (masterPort,
2443                                        IOServiceMatching ("IONDRVDevice"),
2444                                        &it) != kIOReturnSuccess)
2445     return name;
2446
2447   /* Must loop until we find a name.  Many devices can have the same unit
2448      number (represents different GPU parts), but only one has a name.  */
2449   while (! name && (obj = IOIteratorNext (it)))
2450     {
2451       CFMutableDictionaryRef props;
2452       const void *val;
2453
2454       if (IORegistryEntryCreateCFProperties (obj,
2455                                              &props,
2456                                              kCFAllocatorDefault,
2457                                              kNilOptions) == kIOReturnSuccess
2458           && props != nil
2459           && (val = CFDictionaryGetValue(props, @"IOFBDependentIndex")))
2460         {
2461           unsigned nr = [(NSNumber *)val unsignedIntegerValue];
2462           if (nr == CGDisplayUnitNumber (did))
2463             name = ns_get_name_from_ioreg (obj);
2464         }
2465
2466       CFRelease (props);
2467       IOObjectRelease (obj);
2468     }
2469
2470   IOObjectRelease (it);
2471
2472 #else
2473
2474   name = ns_get_name_from_ioreg (CGDisplayIOServicePort (did));
2475
2476 #endif
2477   return name;
2478 }
2479 #endif
2480
2481 static Lisp_Object
2482 ns_make_monitor_attribute_list (struct MonitorInfo *monitors,
2483                                 int n_monitors,
2484                                 int primary_monitor,
2485                                 const char *source)
2486 {
2487   Lisp_Object monitor_frames = Fmake_vector (make_number (n_monitors), Qnil);
2488   Lisp_Object frame, rest;
2489   NSArray *screens = [NSScreen screens];
2490   int i;
2491
2492   FOR_EACH_FRAME (rest, frame)
2493     {
2494       struct frame *f = XFRAME (frame);
2495
2496       if (FRAME_NS_P (f))
2497         {
2498           NSView *view = FRAME_NS_VIEW (f);
2499           NSScreen *screen = [[view window] screen];
2500           NSUInteger k;
2501
2502           i = -1;
2503           for (k = 0; i == -1 && k < [screens count]; ++k)
2504             {
2505               if ([screens objectAtIndex: k] == screen)
2506                 i = (int)k;
2507             }
2508
2509           if (i > -1)
2510             ASET (monitor_frames, i, Fcons (frame, AREF (monitor_frames, i)));
2511         }
2512     }
2513
2514   return make_monitor_attribute_list (monitors, n_monitors, primary_monitor,
2515                                       monitor_frames, source);
2516 }
2517
2518 DEFUN ("ns-display-monitor-attributes-list",
2519        Fns_display_monitor_attributes_list,
2520        Sns_display_monitor_attributes_list,
2521        0, 1, 0,
2522        doc: /* Return a list of physical monitor attributes on the X display TERMINAL.
2523
2524 The optional argument TERMINAL specifies which display to ask about.
2525 TERMINAL should be a terminal object, a frame or a display name (a string).
2526 If omitted or nil, that stands for the selected frame's display.
2527
2528 In addition to the standard attribute keys listed in
2529 `display-monitor-attributes-list', the following keys are contained in
2530 the attributes:
2531
2532  source -- String describing the source from which multi-monitor
2533            information is obtained, \"NS\" is always the source."
2534
2535 Internal use only, use `display-monitor-attributes-list' instead.  */)
2536   (Lisp_Object terminal)
2537 {
2538   struct terminal *term = decode_live_terminal (terminal);
2539   NSArray *screens;
2540   NSUInteger i, n_monitors;
2541   struct MonitorInfo *monitors;
2542   Lisp_Object attributes_list = Qnil;
2543   CGFloat primary_display_height = 0;
2544
2545   if (term->type != output_ns)
2546     return Qnil;
2547
2548   screens = [NSScreen screens];
2549   n_monitors = [screens count];
2550   if (n_monitors == 0)
2551     return Qnil;
2552
2553   monitors = xzalloc (n_monitors * sizeof *monitors);
2554
2555   for (i = 0; i < [screens count]; ++i)
2556     {
2557       NSScreen *s = [screens objectAtIndex:i];
2558       struct MonitorInfo *m = &monitors[i];
2559       NSRect fr = [s frame];
2560       NSRect vfr = [s visibleFrame];
2561       short y, vy;
2562
2563 #ifdef NS_IMPL_COCOA
2564       NSDictionary *dict = [s deviceDescription];
2565       NSNumber *nid = [dict objectForKey:@"NSScreenNumber"];
2566       CGDirectDisplayID did = [nid unsignedIntValue];
2567 #endif
2568       if (i == 0)
2569         {
2570           primary_display_height = fr.size.height;
2571           y = (short) fr.origin.y;
2572           vy = (short) vfr.origin.y;
2573         }
2574       else
2575         {
2576           // Flip y coordinate as NS has y starting from the bottom.
2577           y = (short) (primary_display_height - fr.size.height - fr.origin.y);
2578           vy = (short) (primary_display_height -
2579                         vfr.size.height - vfr.origin.y);
2580         }
2581
2582       m->geom.x = (short) fr.origin.x;
2583       m->geom.y = y;
2584       m->geom.width = (unsigned short) fr.size.width;
2585       m->geom.height = (unsigned short) fr.size.height;
2586
2587       m->work.x = (short) vfr.origin.x;
2588       // y is flipped on NS, so vy - y are pixels missing at the bottom,
2589       // and fr.size.height - vfr.size.height are pixels missing in total.
2590       // Pixels missing at top are
2591       // fr.size.height - vfr.size.height - vy + y.
2592       // work.y is then pixels missing at top + y.
2593       m->work.y = (short) (fr.size.height - vfr.size.height) - vy + y + y;
2594       m->work.width = (unsigned short) vfr.size.width;
2595       m->work.height = (unsigned short) vfr.size.height;
2596
2597 #ifdef NS_IMPL_COCOA
2598       m->name = ns_screen_name (did);
2599
2600       {
2601         CGSize mms = CGDisplayScreenSize (did);
2602         m->mm_width = (int) mms.width;
2603         m->mm_height = (int) mms.height;
2604       }
2605
2606 #else
2607       // Assume 92 dpi as x-display-mm-height/x-display-mm-width does.
2608       m->mm_width = (int) (25.4 * fr.size.width / 92.0);
2609       m->mm_height = (int) (25.4 * fr.size.height / 92.0);
2610 #endif
2611     }
2612
2613   // Primary monitor is always first for NS.
2614   attributes_list = ns_make_monitor_attribute_list (monitors, n_monitors,
2615                                                     0, "NS");
2616
2617   free_monitors (monitors, n_monitors);
2618   return attributes_list;
2619 }
2620
2621
2622 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
2623        0, 1, 0,
2624        doc: /* Return the number of bitplanes of the Nextstep display TERMINAL.
2625 The optional argument TERMINAL specifies which display to ask about.
2626 TERMINAL should be a terminal object, a frame or a display name (a string).
2627 If omitted or nil, that stands for the selected frame's display.  */)
2628   (Lisp_Object terminal)
2629 {
2630   check_ns_display_info (terminal);
2631   return make_number
2632     (NSBitsPerPixelFromDepth ([[[NSScreen screens] objectAtIndex:0] depth]));
2633 }
2634
2635
2636 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
2637        0, 1, 0,
2638        doc: /* Returns the number of color cells of the Nextstep display TERMINAL.
2639 The optional argument TERMINAL specifies which display to ask about.
2640 TERMINAL should be a terminal object, a frame or a display name (a string).
2641 If omitted or nil, that stands for the selected frame's display.  */)
2642   (Lisp_Object terminal)
2643 {
2644   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
2645   /* We force 24+ bit depths to 24-bit to prevent an overflow.  */
2646   return make_number (1 << min (dpyinfo->n_planes, 24));
2647 }
2648
2649
2650 /* Unused dummy def needed for compatibility. */
2651 Lisp_Object tip_frame;
2652
2653 /* TODO: move to xdisp or similar */
2654 static void
2655 compute_tip_xy (struct frame *f,
2656                 Lisp_Object parms,
2657                 Lisp_Object dx,
2658                 Lisp_Object dy,
2659                 int width,
2660                 int height,
2661                 int *root_x,
2662                 int *root_y)
2663 {
2664   Lisp_Object left, top, right, bottom;
2665   EmacsView *view = FRAME_NS_VIEW (f);
2666   struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
2667   NSPoint pt;
2668
2669   /* Start with user-specified or mouse position.  */
2670   left = Fcdr (Fassq (Qleft, parms));
2671   top = Fcdr (Fassq (Qtop, parms));
2672   right = Fcdr (Fassq (Qright, parms));
2673   bottom = Fcdr (Fassq (Qbottom, parms));
2674
2675   if ((!INTEGERP (left) && !INTEGERP (right))
2676       || (!INTEGERP (top) && !INTEGERP (bottom)))
2677     {
2678       pt.x = dpyinfo->last_mouse_motion_x;
2679       pt.y = dpyinfo->last_mouse_motion_y;
2680       /* Convert to screen coordinates */
2681       pt = [view convertPoint: pt toView: nil];
2682 #if !defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MAX_ALLOWED < MAC_OS_X_VERSION_10_7
2683       pt = [[view window] convertBaseToScreen: pt];
2684 #else
2685       {
2686         NSRect r = NSMakeRect (pt.x, pt.y, 0, 0);
2687         r = [[view window] convertRectToScreen: r];
2688         pt.x = r.origin.x;
2689         pt.y = r.origin.y;
2690       }
2691 #endif
2692     }
2693   else
2694     {
2695       /* Absolute coordinates.  */
2696       pt.x = INTEGERP (left) ? XINT (left) : XINT (right);
2697       pt.y = (x_display_pixel_height (FRAME_DISPLAY_INFO (f))
2698               - (INTEGERP (top) ? XINT (top) : XINT (bottom))
2699               - height);
2700     }
2701
2702   /* Ensure in bounds.  (Note, screen origin = lower left.) */
2703   if (INTEGERP (left) || INTEGERP (right))
2704     *root_x = pt.x;
2705   else if (pt.x + XINT (dx) <= 0)
2706     *root_x = 0; /* Can happen for negative dx */
2707   else if (pt.x + XINT (dx) + width
2708            <= x_display_pixel_width (FRAME_DISPLAY_INFO (f)))
2709     /* It fits to the right of the pointer.  */
2710     *root_x = pt.x + XINT (dx);
2711   else if (width + XINT (dx) <= pt.x)
2712     /* It fits to the left of the pointer.  */
2713     *root_x = pt.x - width - XINT (dx);
2714   else
2715     /* Put it left justified on the screen -- it ought to fit that way.  */
2716     *root_x = 0;
2717
2718   if (INTEGERP (top) || INTEGERP (bottom))
2719     *root_y = pt.y;
2720   else if (pt.y - XINT (dy) - height >= 0)
2721     /* It fits below the pointer.  */
2722     *root_y = pt.y - height - XINT (dy);
2723   else if (pt.y + XINT (dy) + height
2724            <= x_display_pixel_height (FRAME_DISPLAY_INFO (f)))
2725     /* It fits above the pointer */
2726       *root_y = pt.y + XINT (dy);
2727   else
2728     /* Put it on the top.  */
2729     *root_y = x_display_pixel_height (FRAME_DISPLAY_INFO (f)) - height;
2730 }
2731
2732
2733 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
2734        doc: /* Show STRING in a \"tooltip\" window on frame FRAME.
2735 A tooltip window is a small window displaying a string.
2736
2737 This is an internal function; Lisp code should call `tooltip-show'.
2738
2739 FRAME nil or omitted means use the selected frame.
2740
2741 PARMS is an optional list of frame parameters which can be used to
2742 change the tooltip's appearance.
2743
2744 Automatically hide the tooltip after TIMEOUT seconds.  TIMEOUT nil
2745 means use the default timeout of 5 seconds.
2746
2747 If the list of frame parameters PARMS contains a `left' parameter,
2748 display the tooltip at that x-position.  If the list of frame parameters
2749 PARMS contains no `left' but a `right' parameter, display the tooltip
2750 right-adjusted at that x-position. Otherwise display it at the
2751 x-position of the mouse, with offset DX added (default is 5 if DX isn't
2752 specified).
2753
2754 Likewise for the y-position: If a `top' frame parameter is specified, it
2755 determines the position of the upper edge of the tooltip window.  If a
2756 `bottom' parameter but no `top' frame parameter is specified, it
2757 determines the position of the lower edge of the tooltip window.
2758 Otherwise display the tooltip window at the y-position of the mouse,
2759 with offset DY added (default is -10).
2760
2761 A tooltip's maximum size is specified by `x-max-tooltip-size'.
2762 Text larger than the specified size is clipped.  */)
2763      (Lisp_Object string, Lisp_Object frame, Lisp_Object parms, Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy)
2764 {
2765   int root_x, root_y;
2766   ptrdiff_t count = SPECPDL_INDEX ();
2767   struct frame *f;
2768   char *str;
2769   NSSize size;
2770
2771   specbind (Qinhibit_redisplay, Qt);
2772
2773   CHECK_STRING (string);
2774   str = SSDATA (string);
2775   f = decode_window_system_frame (frame);
2776   if (NILP (timeout))
2777     timeout = make_number (5);
2778   else
2779     CHECK_NATNUM (timeout);
2780
2781   if (NILP (dx))
2782     dx = make_number (5);
2783   else
2784     CHECK_NUMBER (dx);
2785
2786   if (NILP (dy))
2787     dy = make_number (-10);
2788   else
2789     CHECK_NUMBER (dy);
2790
2791   block_input ();
2792   if (ns_tooltip == nil)
2793     ns_tooltip = [[EmacsTooltip alloc] init];
2794   else
2795     Fx_hide_tip ();
2796
2797   [ns_tooltip setText: str];
2798   size = [ns_tooltip frame].size;
2799
2800   /* Move the tooltip window where the mouse pointer is.  Resize and
2801      show it.  */
2802   compute_tip_xy (f, parms, dx, dy, (int)size.width, (int)size.height,
2803                   &root_x, &root_y);
2804
2805   [ns_tooltip showAtX: root_x Y: root_y for: XINT (timeout)];
2806   unblock_input ();
2807
2808   return unbind_to (count, Qnil);
2809 }
2810
2811
2812 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
2813        doc: /* Hide the current tooltip window, if there is any.
2814 Value is t if tooltip was open, nil otherwise.  */)
2815      (void)
2816 {
2817   if (ns_tooltip == nil || ![ns_tooltip isActive])
2818     return Qnil;
2819   [ns_tooltip hide];
2820   return Qt;
2821 }
2822
2823 /* Return geometric attributes of FRAME.  According to the value of
2824    ATTRIBUTES return the outer edges of FRAME (Qouter_edges), the inner
2825    edges of FRAME, the root window edges of frame (Qroot_edges).  Any
2826    other value means to return the geometry as returned by
2827    Fx_frame_geometry.  */
2828 static Lisp_Object
2829 frame_geometry (Lisp_Object frame, Lisp_Object attribute)
2830 {
2831   struct frame *f = decode_live_frame (frame);
2832   Lisp_Object fullscreen_symbol = Fframe_parameter (frame, Qfullscreen);
2833   bool fullscreen = (EQ (fullscreen_symbol, Qfullboth)
2834                      || EQ (fullscreen_symbol, Qfullscreen));
2835   int border = fullscreen ? 0 : f->border_width;
2836   int title_height = fullscreen ? 0 : FRAME_NS_TITLEBAR_HEIGHT (f);
2837   int native_width = FRAME_PIXEL_WIDTH (f);
2838   int native_height = FRAME_PIXEL_HEIGHT (f);
2839   int outer_width = native_width + 2 * border;
2840   int outer_height = native_height + 2 * border + title_height;
2841   int native_left = f->left_pos + border;
2842   int native_top = f->top_pos + border + title_height;
2843   int native_right = f->left_pos + outer_width - border;
2844   int native_bottom = f->top_pos + outer_height - border;
2845   int internal_border_width = FRAME_INTERNAL_BORDER_WIDTH (f);
2846   int tool_bar_height = FRAME_TOOLBAR_HEIGHT (f);
2847   int tool_bar_width = (tool_bar_height
2848                         ? outer_width - 2 * internal_border_width
2849                         : 0);
2850
2851   /* Construct list.  */
2852   if (EQ (attribute, Qouter_edges))
2853     return list4 (make_number (f->left_pos), make_number (f->top_pos),
2854                   make_number (f->left_pos + outer_width),
2855                   make_number (f->top_pos + outer_height));
2856   else if (EQ (attribute, Qnative_edges))
2857     return list4 (make_number (native_left), make_number (native_top),
2858                   make_number (native_right), make_number (native_bottom));
2859   else if (EQ (attribute, Qinner_edges))
2860     return list4 (make_number (native_left + internal_border_width),
2861                   make_number (native_top
2862                                + tool_bar_height
2863                                + internal_border_width),
2864                   make_number (native_right - internal_border_width),
2865                   make_number (native_bottom - internal_border_width));
2866   else
2867     return
2868       listn (CONSTYPE_HEAP, 10,
2869              Fcons (Qouter_position,
2870                     Fcons (make_number (f->left_pos),
2871                            make_number (f->top_pos))),
2872              Fcons (Qouter_size,
2873                     Fcons (make_number (outer_width),
2874                            make_number (outer_height))),
2875              Fcons (Qexternal_border_size,
2876                     (fullscreen
2877                      ? Fcons (make_number (0), make_number (0))
2878                      : Fcons (make_number (border), make_number (border)))),
2879              Fcons (Qtitle_bar_size,
2880                     Fcons (make_number (0), make_number (title_height))),
2881              Fcons (Qmenu_bar_external, Qnil),
2882              Fcons (Qmenu_bar_size, Fcons (make_number (0), make_number (0))),
2883              Fcons (Qtool_bar_external,
2884                     FRAME_EXTERNAL_TOOL_BAR (f) ? Qt : Qnil),
2885              Fcons (Qtool_bar_position, FRAME_TOOL_BAR_POSITION (f)),
2886              Fcons (Qtool_bar_size,
2887                     Fcons (make_number (tool_bar_width),
2888                            make_number (tool_bar_height))),
2889              Fcons (Qinternal_border_width,
2890                     make_number (internal_border_width)));
2891 }
2892
2893 DEFUN ("ns-frame-geometry", Fns_frame_geometry, Sns_frame_geometry, 0, 1, 0,
2894        doc: /* Return geometric attributes of FRAME.
2895 FRAME must be a live frame and defaults to the selected one.  The return
2896 value is an association list of the attributes listed below.  All height
2897 and width values are in pixels.
2898
2899 `outer-position' is a cons of the outer left and top edges of FRAME
2900   relative to the origin - the position (0, 0) - of FRAME's display.
2901
2902 `outer-size' is a cons of the outer width and height of FRAME.  The
2903   outer size includes the title bar and the external borders as well as
2904   any menu and/or tool bar of frame.
2905
2906 `external-border-size' is a cons of the horizontal and vertical width of
2907   FRAME's external borders as supplied by the window manager.
2908
2909 `title-bar-size' is a cons of the width and height of the title bar of
2910   FRAME as supplied by the window manager.  If both of them are zero,
2911   FRAME has no title bar.  If only the width is zero, Emacs was not
2912   able to retrieve the width information.
2913
2914 `menu-bar-external', if non-nil, means the menu bar is external (never
2915   included in the inner edges of FRAME).
2916
2917 `menu-bar-size' is a cons of the width and height of the menu bar of
2918   FRAME.
2919
2920 `tool-bar-external', if non-nil, means the tool bar is external (never
2921   included in the inner edges of FRAME).
2922
2923 `tool-bar-position' tells on which side the tool bar on FRAME is and can
2924   be one of `left', `top', `right' or `bottom'.  If this is nil, FRAME
2925   has no tool bar.
2926
2927 `tool-bar-size' is a cons of the width and height of the tool bar of
2928   FRAME.
2929
2930 `internal-border-width' is the width of the internal border of
2931   FRAME.  */)
2932   (Lisp_Object frame)
2933 {
2934   return frame_geometry (frame, Qnil);
2935 }
2936
2937 DEFUN ("ns-frame-edges", Fns_frame_edges, Sns_frame_edges, 0, 2, 0,
2938        doc: /* Return edge coordinates of FRAME.
2939 FRAME must be a live frame and defaults to the selected one.  The return
2940 value is a list of the form (LEFT, TOP, RIGHT, BOTTOM).  All values are
2941 in pixels relative to the origin - the position (0, 0) - of FRAME's
2942 display.
2943
2944 If optional argument TYPE is the symbol `outer-edges', return the outer
2945 edges of FRAME.  The outer edges comprise the decorations of the window
2946 manager (like the title bar or external borders) as well as any external
2947 menu or tool bar of FRAME.  If optional argument TYPE is the symbol
2948 `native-edges' or nil, return the native edges of FRAME.  The native
2949 edges exclude the decorations of the window manager and any external
2950 menu or tool bar of FRAME.  If TYPE is the symbol `inner-edges', return
2951 the inner edges of FRAME.  These edges exclude title bar, any borders,
2952 menu bar or tool bar of FRAME.  */)
2953   (Lisp_Object frame, Lisp_Object type)
2954 {
2955   return frame_geometry (frame, ((EQ (type, Qouter_edges)
2956                                   || EQ (type, Qinner_edges))
2957                                  ? type
2958                                  : Qnative_edges));
2959 }
2960
2961 /* ==========================================================================
2962
2963     Class implementations
2964
2965    ========================================================================== */
2966
2967 /*
2968   Handle arrow/function/control keys and copy/paste/cut in file dialogs.
2969   Return YES if handled, NO if not.
2970  */
2971 static BOOL
2972 handlePanelKeys (NSSavePanel *panel, NSEvent *theEvent)
2973 {
2974   NSString *s;
2975   int i;
2976   BOOL ret = NO;
2977
2978   if ([theEvent type] != NSKeyDown) return NO;
2979   s = [theEvent characters];
2980
2981   for (i = 0; i < [s length]; ++i)
2982     {
2983       int ch = (int) [s characterAtIndex: i];
2984       switch (ch)
2985         {
2986         case NSHomeFunctionKey:
2987         case NSDownArrowFunctionKey:
2988         case NSUpArrowFunctionKey:
2989         case NSLeftArrowFunctionKey:
2990         case NSRightArrowFunctionKey:
2991         case NSPageUpFunctionKey:
2992         case NSPageDownFunctionKey:
2993         case NSEndFunctionKey:
2994           /* Don't send command modified keys, as those are handled in the
2995              performKeyEquivalent method of the super class.
2996           */
2997           if (! ([theEvent modifierFlags] & NSCommandKeyMask))
2998             {
2999               [panel sendEvent: theEvent];
3000               ret = YES;
3001             }
3002           break;
3003           /* As we don't have the standard key commands for
3004              copy/paste/cut/select-all in our edit menu, we must handle
3005              them here.  TODO: handle Emacs key bindings for copy/cut/select-all
3006              here, paste works, because we have that in our Edit menu.
3007              I.e. refactor out code in nsterm.m, keyDown: to figure out the
3008              correct modifier.
3009           */
3010         case 'x': // Cut
3011         case 'c': // Copy
3012         case 'v': // Paste
3013         case 'a': // Select all
3014           if ([theEvent modifierFlags] & NSCommandKeyMask)
3015             {
3016               [NSApp sendAction:
3017                        (ch == 'x'
3018                         ? @selector(cut:)
3019                         : (ch == 'c'
3020                            ? @selector(copy:)
3021                            : (ch == 'v'
3022                               ? @selector(paste:)
3023                               : @selector(selectAll:))))
3024                              to:nil from:panel];
3025               ret = YES;
3026             }
3027         default:
3028           // Send all control keys, as the text field supports C-a, C-f, C-e
3029           // C-b and more.
3030           if ([theEvent modifierFlags] & NSControlKeyMask)
3031             {
3032               [panel sendEvent: theEvent];
3033               ret = YES;
3034             }
3035           break;
3036         }
3037     }
3038
3039
3040   return ret;
3041 }
3042
3043 @implementation EmacsSavePanel
3044 - (BOOL)performKeyEquivalent:(NSEvent *)theEvent
3045 {
3046   BOOL ret = handlePanelKeys (self, theEvent);
3047   if (! ret)
3048     ret = [super performKeyEquivalent:theEvent];
3049   return ret;
3050 }
3051 @end
3052
3053
3054 @implementation EmacsOpenPanel
3055 - (BOOL)performKeyEquivalent:(NSEvent *)theEvent
3056 {
3057   // NSOpenPanel inherits NSSavePanel, so passing self is OK.
3058   BOOL ret = handlePanelKeys (self, theEvent);
3059   if (! ret)
3060     ret = [super performKeyEquivalent:theEvent];
3061   return ret;
3062 }
3063 @end
3064
3065
3066 @implementation EmacsFileDelegate
3067 /* --------------------------------------------------------------------------
3068    Delegate methods for Open/Save panels
3069    -------------------------------------------------------------------------- */
3070 - (BOOL)panel: (id)sender isValidFilename: (NSString *)filename
3071 {
3072   return YES;
3073 }
3074 - (BOOL)panel: (id)sender shouldShowFilename: (NSString *)filename
3075 {
3076   return YES;
3077 }
3078 - (NSString *)panel: (id)sender userEnteredFilename: (NSString *)filename
3079           confirmed: (BOOL)okFlag
3080 {
3081   return filename;
3082 }
3083 @end
3084
3085 #endif
3086
3087
3088 /* ==========================================================================
3089
3090     Lisp interface declaration
3091
3092    ========================================================================== */
3093
3094
3095 void
3096 syms_of_nsfns (void)
3097 {
3098   DEFSYM (Qfontsize, "fontsize");
3099
3100   DEFVAR_LISP ("ns-icon-type-alist", Vns_icon_type_alist,
3101                doc: /* Alist of elements (REGEXP . IMAGE) for images of icons associated to frames.
3102 If the title of a frame matches REGEXP, then IMAGE.tiff is
3103 selected as the image of the icon representing the frame when it's
3104 miniaturized.  If an element is t, then Emacs tries to select an icon
3105 based on the filetype of the visited file.
3106
3107 The images have to be installed in a folder called English.lproj in the
3108 Emacs folder.  You have to restart Emacs after installing new icons.
3109
3110 Example: Install an icon Gnus.tiff and execute the following code
3111
3112   (setq ns-icon-type-alist
3113         (append ns-icon-type-alist
3114                 '((\"^\\\\*\\\\(Group\\\\*$\\\\|Summary \\\\|Article\\\\*$\\\\)\"
3115                    . \"Gnus\"))))
3116
3117 When you miniaturize a Group, Summary or Article frame, Gnus.tiff will
3118 be used as the image of the icon representing the frame.  */);
3119   Vns_icon_type_alist = list1 (Qt);
3120
3121   DEFVAR_LISP ("ns-version-string", Vns_version_string,
3122                doc: /* Toolkit version for NS Windowing.  */);
3123   Vns_version_string = ns_appkit_version_str ();
3124
3125   defsubr (&Sns_read_file_name);
3126   defsubr (&Sns_get_resource);
3127   defsubr (&Sns_set_resource);
3128   defsubr (&Sxw_display_color_p); /* this and next called directly by C code */
3129   defsubr (&Sx_display_grayscale_p);
3130   defsubr (&Sns_font_name);
3131   defsubr (&Sns_list_colors);
3132 #ifdef NS_IMPL_COCOA
3133   defsubr (&Sns_do_applescript);
3134 #endif
3135   defsubr (&Sxw_color_defined_p);
3136   defsubr (&Sxw_color_values);
3137   defsubr (&Sx_server_max_request_size);
3138   defsubr (&Sx_server_vendor);
3139   defsubr (&Sx_server_version);
3140   defsubr (&Sx_display_pixel_width);
3141   defsubr (&Sx_display_pixel_height);
3142   defsubr (&Sns_display_monitor_attributes_list);
3143   defsubr (&Sns_frame_geometry);
3144   defsubr (&Sns_frame_edges);
3145   defsubr (&Sx_display_mm_width);
3146   defsubr (&Sx_display_mm_height);
3147   defsubr (&Sx_display_screens);
3148   defsubr (&Sx_display_planes);
3149   defsubr (&Sx_display_color_cells);
3150   defsubr (&Sx_display_visual_class);
3151   defsubr (&Sx_display_backing_store);
3152   defsubr (&Sx_display_save_under);
3153   defsubr (&Sx_create_frame);
3154   defsubr (&Sx_open_connection);
3155   defsubr (&Sx_close_connection);
3156   defsubr (&Sx_display_list);
3157
3158   defsubr (&Sns_hide_others);
3159   defsubr (&Sns_hide_emacs);
3160   defsubr (&Sns_emacs_info_panel);
3161   defsubr (&Sns_list_services);
3162   defsubr (&Sns_perform_service);
3163   defsubr (&Sns_convert_utf8_nfd_to_nfc);
3164   defsubr (&Sns_popup_font_panel);
3165   defsubr (&Sns_popup_color_panel);
3166
3167   defsubr (&Sx_show_tip);
3168   defsubr (&Sx_hide_tip);
3169
3170   as_status = 0;
3171   as_script = Qnil;
3172   as_result = 0;
3173 }