src/nsfns.m

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