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