src/nsfns.m

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