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