code.delx.au - gnu-emacs/blob - src/nsfns.m

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