nsfns.m 84.8 KB
Newer Older
1
/* Functions for the NeXT/Open/GNUstep and MacOSX window system.
Glenn Morris's avatar
Glenn Morris committed
2

3 4
Copyright (C) 1989, 1992-1994, 2005-2006, 2008-2013 Free Software
Foundation, Inc.
5 6 7

This file is part of GNU Emacs.

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 11
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
12 13 14 15 16 17 18

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
19
along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
20

21
/*
22 23 24 25 26 27 28
Originally by Carl Edman
Updated by Christian Limpach (chris@nice.ch)
OpenStep/Rhapsody port by Scott Bender (sbender@harmony-ds.com)
MacOSX/Aqua port by Christophe de Dinechin (descubes@earthlink.net)
GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu)
*/

29 30
/* This should be the first include, as it may set up #defines affecting
   interpretation of even the system includes. */
Dan Nicolaescu's avatar
Dan Nicolaescu committed
31
#include <config.h>
32

33
#include <math.h>
34
#include <c-strcase.h>
35

36 37 38 39
#include "lisp.h"
#include "blockinput.h"
#include "nsterm.h"
#include "window.h"
40
#include "character.h"
41 42 43 44 45 46
#include "buffer.h"
#include "keyboard.h"
#include "termhooks.h"
#include "fontset.h"
#include "font.h"

47 48 49 50
#ifdef NS_IMPL_COCOA
#include <IOKit/graphics/IOGraphicsLib.h>
#endif

51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87
#if 0
int fns_trace_num = 1;
#define NSTRACE(x)        fprintf (stderr, "%s:%d: [%d] " #x "\n",        \
                                  __FILE__, __LINE__, ++fns_trace_num)
#else
#define NSTRACE(x)
#endif

#ifdef HAVE_NS

extern NSArray *ns_send_types, *ns_return_types, *ns_drag_types;

extern Lisp_Object Qforeground_color;
extern Lisp_Object Qbackground_color;
extern Lisp_Object Qcursor_color;
extern Lisp_Object Qinternal_border_width;
extern Lisp_Object Qvisibility;
extern Lisp_Object Qcursor_type;
extern Lisp_Object Qicon_type;
extern Lisp_Object Qicon_name;
extern Lisp_Object Qicon_left;
extern Lisp_Object Qicon_top;
extern Lisp_Object Qleft;
extern Lisp_Object Qright;
extern Lisp_Object Qtop;
extern Lisp_Object Qdisplay;
extern Lisp_Object Qvertical_scroll_bars;
extern Lisp_Object Qauto_raise;
extern Lisp_Object Qauto_lower;
extern Lisp_Object Qbox;
extern Lisp_Object Qscroll_bar_width;
extern Lisp_Object Qx_resource_name;
extern Lisp_Object Qface_set_after_frame_default;
extern Lisp_Object Qunderline, Qundefined;
extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;

Jan D's avatar
Jan D committed
88

89 90 91 92 93 94
Lisp_Object Qbuffered;
Lisp_Object Qfontsize;

/* hack for OS X file panels */
char panelOK = 0;

95
EmacsTooltip *ns_tooltip = nil;
96 97

/* Need forward declaration here to preserve organizational integrity of file */
98
Lisp_Object Fx_open_connection (Lisp_Object, Lisp_Object, Lisp_Object);
99

100 101 102
/* Static variables to handle applescript execution.  */
static Lisp_Object as_script, *as_result;
static int as_status;
103

104
#ifdef GLYPH_DEBUG
105 106 107
static ptrdiff_t image_cache_refcount;
#endif

108

109 110 111 112 113 114
/* ==========================================================================

    Internal utility functions

   ========================================================================== */

115 116 117
/* Let the user specify a Nextstep display with a Lisp object.
   OBJECT may be nil, a frame or a terminal object.
   nil stands for the selected frame--or, if that is not a Nextstep frame,
118
   the first Nextstep display on the list.  */
119

120
static struct ns_display_info *
121
check_ns_display_info (Lisp_Object object)
122
{
123 124 125
  struct ns_display_info *dpyinfo = NULL;

  if (NILP (object))
126
    {
127 128 129 130
      struct frame *sf = XFRAME (selected_frame);

      if (FRAME_NS_P (sf) && FRAME_LIVE_P (sf))
	dpyinfo = FRAME_NS_DISPLAY_INFO (sf);
131
      else if (x_display_list != 0)
132
	dpyinfo = x_display_list;
133
      else
134
        error ("Nextstep windows are not in use or not initialized");
135
    }
136
  else if (TERMINALP (object))
137
    {
138
      struct terminal *t = get_terminal (object, 1);
139 140

      if (t->type != output_ns)
141
        error ("Terminal %d is not a Nextstep display", t->id);
142

143
      dpyinfo = t->display_info.ns;
144
    }
145 146
  else if (STRINGP (object))
    dpyinfo = ns_display_info_for_name (object);
147 148
  else
    {
149 150
      FRAME_PTR f = decode_window_system_frame (object);
      dpyinfo = FRAME_NS_DISPLAY_INFO (f);
151
    }
152 153

  return dpyinfo;
154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175
}


static id
ns_get_window (Lisp_Object maybeFrame)
{
  id view =nil, window =nil;

  if (!FRAMEP (maybeFrame) || !FRAME_NS_P (XFRAME (maybeFrame)))
    maybeFrame = selected_frame;/*wrong_type_argument (Qframep, maybeFrame); */

  if (!NILP (maybeFrame))
    view = FRAME_NS_VIEW (XFRAME (maybeFrame));
  if (view) window =[view window];

  return window;
}


/* Return the X display structure for the display named NAME.
   Open a new connection if necessary.  */
struct ns_display_info *
176
ns_display_info_for_name (Lisp_Object name)
177 178 179 180 181 182
{
  Lisp_Object names;
  struct ns_display_info *dpyinfo;

  CHECK_STRING (name);

183
  for (dpyinfo = x_display_list, names = ns_display_name_list;
184 185 186 187 188 189 190 191 192 193 194
       dpyinfo;
       dpyinfo = dpyinfo->next, names = XCDR (names))
    {
      Lisp_Object tem;
      tem = Fstring_equal (XCAR (XCAR (names)), name);
      if (!NILP (tem))
        return dpyinfo;
    }

  error ("Emacs for OpenStep does not yet support multi-display.");

195 196
  Fx_open_connection (name, Qnil, Qnil);
  dpyinfo = x_display_list;
197 198

  if (dpyinfo == 0)
199
    error ("OpenStep on %s not responding.\n", SDATA (name));
200 201 202 203

  return dpyinfo;
}

204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226
static NSString *
ns_filename_from_panel (NSSavePanel *panel)
{
#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
  NSURL *url = [panel URL];
  NSString *str = [url path];
  return str;
#else
  return [panel filename];
#endif
}

static NSString *
ns_directory_from_panel (NSSavePanel *panel)
{
#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
  NSURL *url = [panel directoryURL];
  NSString *str = [url path];
  return str;
#else
  return [panel directory];
#endif
}
227 228 229 230 231 232 233 234

static Lisp_Object
interpret_services_menu (NSMenu *menu, Lisp_Object prefix, Lisp_Object old)
/* --------------------------------------------------------------------------
   Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
   -------------------------------------------------------------------------- */
{
  int i, count;
235
  NSMenuItem *item;
236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286
  const char *name;
  Lisp_Object nameStr;
  unsigned short key;
  NSString *keys;
  Lisp_Object res;

  count = [menu numberOfItems];
  for (i = 0; i<count; i++)
    {
      item = [menu itemAtIndex: i];
      name = [[item title] UTF8String];
      if (!name) continue;

      nameStr = build_string (name);

      if ([item hasSubmenu])
        {
          old = interpret_services_menu ([item submenu],
                                        Fcons (nameStr, prefix), old);
        }
      else
        {
          keys = [item keyEquivalent];
          if (keys && [keys length] )
            {
              key = [keys characterAtIndex: 0];
              res = make_number (key|super_modifier);
            }
          else
            {
              res = Qundefined;
            }
          old = Fcons (Fcons (res,
                            Freverse (Fcons (nameStr,
                                           prefix))),
                    old);
        }
    }
  return old;
}



/* ==========================================================================

    Frame parameter setters

   ========================================================================== */


static void
287
x_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
288 289
{
  NSColor *col;
290
  EmacsCGFloat r, g, b, alpha;
291 292 293 294 295 296 297 298 299 300 301

  if (ns_lisp_to_color (arg, &col))
    {
      store_frame_param (f, Qforeground_color, oldval);
      error ("Unknown color");
    }

  [col retain];
  [f->output_data.ns->foreground_color release];
  f->output_data.ns->foreground_color = col;

302 303 304 305
  [col getRed: &r green: &g blue: &b alpha: &alpha];
  FRAME_FOREGROUND_PIXEL (f) =
    ARGB_TO_ULONG ((int)(alpha*0xff), (int)(r*0xff), (int)(g*0xff), (int)(b*0xff));

306 307 308 309 310 311 312 313 314 315 316
  if (FRAME_NS_VIEW (f))
    {
      update_face_from_frame_parameter (f, Qforeground_color, arg);
      /*recompute_basic_faces (f); */
      if (FRAME_VISIBLE_P (f))
        redraw_frame (f);
    }
}


static void
317
x_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
318 319 320 321
{
  struct face *face;
  NSColor *col;
  NSView *view = FRAME_NS_VIEW (f);
322
  EmacsCGFloat r, g, b, alpha;
323 324 325 326 327 328 329 330 331 332 333 334 335 336 337

  if (ns_lisp_to_color (arg, &col))
    {
      store_frame_param (f, Qbackground_color, oldval);
      error ("Unknown color");
    }

  /* clear the frame; in some instances the NS-internal GC appears not to
     update, or it does update and cannot clear old text properly */
  if (FRAME_VISIBLE_P (f))
    ns_clear_frame (f);

  [col retain];
  [f->output_data.ns->background_color release];
  f->output_data.ns->background_color = col;
338 339 340 341 342

  [col getRed: &r green: &g blue: &b alpha: &alpha];
  FRAME_BACKGROUND_PIXEL (f) =
    ARGB_TO_ULONG ((int)(alpha*0xff), (int)(r*0xff), (int)(g*0xff), (int)(b*0xff));

343 344 345 346
  if (view != nil)
    {
      [[view window] setBackgroundColor: col];

347
      if (alpha != (EmacsCGFloat) 1.0)
348 349 350 351 352 353 354
          [[view window] setOpaque: NO];
      else
          [[view window] setOpaque: YES];

      face = FRAME_DEFAULT_FACE (f);
      if (face)
        {
355
          col = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f);
356 357
          face->background = ns_index_color
            ([col colorWithAlphaComponent: alpha], f);
358 359 360 361 362 363 364 365 366 367 368

          update_face_from_frame_parameter (f, Qbackground_color, arg);
        }

      if (FRAME_VISIBLE_P (f))
        redraw_frame (f);
    }
}


static void
369
x_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
370 371 372 373 374 375 376 377 378
{
  NSColor *col;

  if (ns_lisp_to_color (arg, &col))
    {
      store_frame_param (f, Qcursor_color, oldval);
      error ("Unknown color");
    }

379 380
  [FRAME_CURSOR_COLOR (f) release];
  FRAME_CURSOR_COLOR (f) = [col retain];
381 382 383 384 385 386 387 388 389

  if (FRAME_VISIBLE_P (f))
    {
      x_update_cursor (f, 0);
      x_update_cursor (f, 1);
    }
  update_face_from_frame_parameter (f, Qcursor_color, arg);
}

390

391
static void
392
x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
393 394
{
  NSView *view = FRAME_NS_VIEW (f);
395
  NSTRACE (x_set_icon_name);
396 397 398 399 400 401 402 403 404 405

  /* see if it's changed */
  if (STRINGP (arg))
    {
      if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
        return;
    }
  else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
    return;

406
  fset_icon_name (f, arg);
407 408 409

  if (NILP (arg))
    {
410 411
      if (!NILP (f->title))
        arg = f->title;
412 413 414
      else
        /* explicit name and no icon-name -> explicit_name */
        if (f->explicit_name)
415
          arg = f->name;
416 417 418 419 420 421 422 423 424 425 426 427 428
        else
          {
            /* no explicit name and no icon-name ->
               name has to be rebuild from icon_title_format */
            windows_or_buffers_changed++;
            return;
          }
    }

  /* Don't change the name if it's already NAME.  */
  if ([[view window] miniwindowTitle] &&
      ([[[view window] miniwindowTitle]
             isEqualToString: [NSString stringWithUTF8String:
429
                                           SSDATA (arg)]]))
430 431 432
    return;

  [[view window] setMiniwindowTitle:
433
        [NSString stringWithUTF8String: SSDATA (arg)]];
434 435 436
}

static void
437
ns_set_name_internal (FRAME_PTR f, Lisp_Object name)
438
{
439 440 441
  struct gcpro gcpro1;
  Lisp_Object encoded_name, encoded_icon_name;
  NSString *str;
442 443
  NSView *view = FRAME_NS_VIEW (f);

444 445 446
  GCPRO1 (name);
  encoded_name = ENCODE_UTF_8 (name);
  UNGCPRO;
447

448
  str = [NSString stringWithUTF8String: SSDATA (encoded_name)];
449

450 451 452
  /* Don't change the name if it's already NAME.  */
  if (! [[[view window] title] isEqualToString: str])
    [[view window] setTitle: str];
453

454
  if (!STRINGP (f->icon_name))
455
    encoded_icon_name = encoded_name;
456
  else
457
    encoded_icon_name = ENCODE_UTF_8 (f->icon_name);
458

459
  str = [NSString stringWithUTF8String: SSDATA (encoded_icon_name)];
460 461

  if ([[view window] miniwindowTitle] &&
462 463
      ! [[[view window] miniwindowTitle] isEqualToString: str])
    [[view window] setMiniwindowTitle: str];
464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486

}

static void
ns_set_name (struct frame *f, Lisp_Object name, int explicit)
{
  NSTRACE (ns_set_name);

  /* Make sure that requests from lisp code override requests from
     Emacs redisplay code.  */
  if (explicit)
    {
      /* If we're switching from explicit to implicit, we had better
         update the mode lines and thereby update the title.  */
      if (f->explicit_name && NILP (name))
        update_mode_lines = 1;

      f->explicit_name = ! NILP (name);
    }
  else if (f->explicit_name)
    return;

  if (NILP (name))
487
    name = build_string([ns_app_name UTF8String]);
488 489 490 491
  else
    CHECK_STRING (name);

  /* Don't change the name if it's already NAME.  */
492
  if (! NILP (Fstring_equal (name, f->name)))
493
    return;
494

495
  fset_name (f, name);
496 497

  /* title overrides explicit name */
498 499
  if (! NILP (f->title))
    name = f->title;
500

501
  ns_set_name_internal (f, name);
502 503 504 505 506 507 508
}


/* This function should be called when the user's lisp code has
   specified a name for the frame; the name will override any set by the
   redisplay code.  */
static void
509
x_explicitly_set_name (FRAME_PTR f, Lisp_Object arg, Lisp_Object oldval)
510
{
511
  NSTRACE (x_explicitly_set_name);
512 513 514 515 516 517 518 519 520 521 522
  ns_set_name (f, arg, 1);
}


/* This function should be called by Emacs redisplay code to set the
   name; names set this way will never override names set by the user's
   lisp code.  */
void
x_implicitly_set_name (FRAME_PTR f, Lisp_Object arg, Lisp_Object oldval)
{
  NSTRACE (x_implicitly_set_name);
523 524 525 526

  /* Deal with NS specific format t.  */
  if (FRAME_NS_P (f) && ((FRAME_ICONIFIED_P (f) && EQ (Vicon_title_format, Qt))
                         || EQ (Vframe_title_format, Qt)))
527
    ns_set_name_as_filename (f);
528 529 530 531 532 533
  else
    ns_set_name (f, arg, 0);
}


/* Change the title of frame F to NAME.
534
   If NAME is nil, use the frame name as the title.  */
535 536

static void
537
x_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name)
538
{
539
  NSTRACE (x_set_title);
540
  /* Don't change the title if it's already NAME.  */
541
  if (EQ (name, f->title))
542 543 544 545
    return;

  update_mode_lines = 1;

546
  fset_title (f, name);
547 548

  if (NILP (name))
549
    name = f->name;
550 551 552 553
  else
    CHECK_STRING (name);

  ns_set_name_internal (f, name);
554 555 556 557 558 559
}


void
ns_set_name_as_filename (struct frame *f)
{
560
  NSView *view;
561
  Lisp_Object name, filename;
562
  Lisp_Object buf = XWINDOW (f->selected_window)->contents;
563 564
  const char *title;
  NSAutoreleasePool *pool;
565
  struct gcpro gcpro1;
566 567
  Lisp_Object encoded_name, encoded_filename;
  NSString *str;
568 569
  NSTRACE (ns_set_name_as_filename);

Jan Djärv's avatar
Jan Djärv committed
570
  if (f->explicit_name || ! NILP (f->title))
571 572
    return;

573
  block_input ();
574
  pool = [[NSAutoreleasePool alloc] init];
Jan Djärv's avatar
Jan Djärv committed
575 576
  filename = BVAR (XBUFFER (buf), filename);
  name = BVAR (XBUFFER (buf), name);
577 578

  if (NILP (name))
579 580 581 582 583 584
    {
      if (! NILP (filename))
        name = Ffile_name_nondirectory (filename);
      else
        name = build_string ([ns_app_name UTF8String]);
    }
585

586 587 588 589
  GCPRO1 (name);
  encoded_name = ENCODE_UTF_8 (name);
  UNGCPRO;

590 591
  view = FRAME_NS_VIEW (f);

592 593 594
  title = FRAME_ICONIFIED_P (f) ? [[[view window] miniwindowTitle] UTF8String]
                                : [[[view window] title] UTF8String];

595
  if (title && (! strcmp (title, SSDATA (encoded_name))))
596 597
    {
      [pool release];
598
      unblock_input ();
599 600 601
      return;
    }

602
  str = [NSString stringWithUTF8String: SSDATA (encoded_name)];
603 604 605 606
  if (str == nil) str = @"Bad coding";

  if (FRAME_ICONIFIED_P (f))
    [[view window] setMiniwindowTitle: str];
607
  else
608
    {
609 610 611
      NSString *fstr;

      if (! NILP (filename))
612
        {
613 614 615 616
          GCPRO1 (filename);
          encoded_filename = ENCODE_UTF_8 (filename);
          UNGCPRO;

617
          fstr = [NSString stringWithUTF8String: SSDATA (encoded_filename)];
618 619 620 621 622 623 624 625
          if (fstr == nil) fstr = @"";
#ifdef NS_IMPL_COCOA
          /* work around a bug observed on 10.3 and later where
             setTitleWithRepresentedFilename does not clear out previous state
             if given filename does not exist */
          if (! [[NSFileManager defaultManager] fileExistsAtPath: fstr])
            [[view window] setRepresentedFilename: @""];
#endif
626 627
        }
      else
628 629 630 631
        fstr = @"";

      [[view window] setRepresentedFilename: fstr];
      [[view window] setTitle: str];
632
      fset_name (f, name);
633
    }
634

635
  [pool release];
636
  unblock_input ();
637 638 639 640
}


void
641
ns_set_doc_edited (struct frame *f, Lisp_Object arg)
642 643 644
{
  NSView *view = FRAME_NS_VIEW (f);
  NSAutoreleasePool *pool;
645
  if (!MINI_WINDOW_P (XWINDOW (f->selected_window)))
646
    {
647
      block_input ();
648 649 650
      pool = [[NSAutoreleasePool alloc] init];
      [[view window] setDocumentEdited: !NILP (arg)];
      [pool release];
651
      unblock_input ();
652
    }
653 654 655
}


656 657
void
x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
658 659 660 661 662
{
  int nlines;
  if (FRAME_MINIBUF_ONLY_P (f))
    return;

663
  if (TYPE_RANGED_INTEGERP (int, value))
664 665 666 667 668 669 670 671
    nlines = XINT (value);
  else
    nlines = 0;

  FRAME_MENU_BAR_LINES (f) = 0;
  if (nlines)
    {
      FRAME_EXTERNAL_MENU_BAR (f) = 1;
672 673
      /* does for all frames, whereas we just want for one frame
	 [NSMenu setMenuBarVisible: YES]; */
674 675 676 677 678
    }
  else
    {
      if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
        free_frame_menubar (f);
679
      /*      [NSMenu setMenuBarVisible: NO]; */
680 681 682 683 684
      FRAME_EXTERNAL_MENU_BAR (f) = 0;
    }
}


685
/* toolbar support */
686 687
void
x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
688 689 690 691 692 693
{
  int nlines;

  if (FRAME_MINIBUF_ONLY_P (f))
    return;

694
  if (RANGED_INTEGERP (0, value, INT_MAX))
695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716
    nlines = XFASTINT (value);
  else
    nlines = 0;

  if (nlines)
    {
      FRAME_EXTERNAL_TOOL_BAR (f) = 1;
      update_frame_tool_bar (f);
    }
  else
    {
      if (FRAME_EXTERNAL_TOOL_BAR (f))
        {
          free_frame_tool_bar (f);
          FRAME_EXTERNAL_TOOL_BAR (f) = 0;
        }
    }

  x_set_window_size (f, 0, f->text_cols, f->text_lines);
}


717
static void
718 719 720 721
ns_implicitly_set_icon_type (struct frame *f)
{
  Lisp_Object tem;
  EmacsView *view = FRAME_NS_VIEW (f);
722
  id image = nil;
723 724 725 726 727 728
  Lisp_Object chain, elt;
  NSAutoreleasePool *pool;
  BOOL setMini = YES;

  NSTRACE (ns_implicitly_set_icon_type);

729
  block_input ();
730 731
  pool = [[NSAutoreleasePool alloc] init];
  if (f->output_data.ns->miniimage
732
      && [[NSString stringWithUTF8String: SSDATA (f->name)]
733 734 735
               isEqualToString: [(NSImage *)f->output_data.ns->miniimage name]])
    {
      [pool release];
736
      unblock_input ();
737 738 739
      return;
    }

740
  tem = assq_no_quit (Qicon_type, f->param_alist);
741 742 743
  if (CONSP (tem) && ! NILP (XCDR (tem)))
    {
      [pool release];
744
      unblock_input ();
745 746 747 748
      return;
    }

  for (chain = Vns_icon_type_alist;
749
       image == nil && CONSP (chain);
750 751 752 753
       chain = XCDR (chain))
    {
      elt = XCAR (chain);
      /* special case: 't' means go by file type */
754
      if (SYMBOLP (elt) && EQ (elt, Qt) && SSDATA (f->name)[0] == '/')
755
        {
756
          NSString *str
757
	     = [NSString stringWithUTF8String: SSDATA (f->name)];
758 759 760 761 762 763
          if ([[NSFileManager defaultManager] fileExistsAtPath: str])
            image = [[[NSWorkspace sharedWorkspace] iconForFile: str] retain];
        }
      else if (CONSP (elt) &&
               STRINGP (XCAR (elt)) &&
               STRINGP (XCDR (elt)) &&
764
               fast_string_match (XCAR (elt), f->name) >= 0)
765 766 767 768 769
        {
          image = [EmacsImage allocInitFromFile: XCDR (elt)];
          if (image == nil)
            image = [[NSImage imageNamed:
                               [NSString stringWithUTF8String:
770
					    SSDATA (XCDR (elt))]] retain];
771 772 773 774 775 776 777 778 779 780 781 782 783
        }
    }

  if (image == nil)
    {
      image = [[[NSWorkspace sharedWorkspace] iconForFileType: @"text"] retain];
      setMini = NO;
    }

  [f->output_data.ns->miniimage release];
  f->output_data.ns->miniimage = image;
  [view setMiniwindowImage: setMini];
  [pool release];
784
  unblock_input ();
785 786 787 788
}


static void
789
x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
790 791 792 793 794
{
  EmacsView *view = FRAME_NS_VIEW (f);
  id image = nil;
  BOOL setMini = YES;

795
  NSTRACE (x_set_icon_type);
796 797 798

  if (!NILP (arg) && SYMBOLP (arg))
    {
799
      arg =build_string (SSDATA (SYMBOL_NAME (arg)));
800 801 802 803 804 805 806 807 808 809 810 811 812 813 814
      store_frame_param (f, Qicon_type, arg);
    }

  /* do it the implicit way */
  if (NILP (arg))
    {
      ns_implicitly_set_icon_type (f);
      return;
    }

  CHECK_STRING (arg);

  image = [EmacsImage allocInitFromFile: arg];
  if (image == nil)
    image =[NSImage imageNamed: [NSString stringWithUTF8String:
815
                                            SSDATA (arg)]];
816 817 818 819 820 821 822 823 824 825 826 827

  if (image == nil)
    {
      image = [NSImage imageNamed: @"text"];
      setMini = NO;
    }

  f->output_data.ns->miniimage = image;
  [view setMiniwindowImage: setMini];
}


828
/* TODO: move to nsterm? */
829 830 831 832 833
int
ns_lisp_to_cursor_type (Lisp_Object arg)
{
  char *str;
  if (XTYPE (arg) == Lisp_String)
834
    str = SSDATA (arg);
835
  else if (XTYPE (arg) == Lisp_Symbol)
836
    str = SSDATA (SYMBOL_NAME (arg));
837
  else return -1;
838 839 840 841 842
  if (!strcmp (str, "box"))	return FILLED_BOX_CURSOR;
  if (!strcmp (str, "hollow"))	return HOLLOW_BOX_CURSOR;
  if (!strcmp (str, "hbar"))	return HBAR_CURSOR;
  if (!strcmp (str, "bar"))	return BAR_CURSOR;
  if (!strcmp (str, "no"))	return NO_CURSOR;
843 844 845 846 847 848 849 850 851
  return -1;
}


Lisp_Object
ns_cursor_type_to_lisp (int arg)
{
  switch (arg)
    {
852 853 854 855 856 857
    case FILLED_BOX_CURSOR: return Qbox;
    case HOLLOW_BOX_CURSOR: return intern ("hollow");
    case HBAR_CURSOR:	    return intern ("hbar");
    case BAR_CURSOR:	    return intern ("bar");
    case NO_CURSOR:
    default:		    return intern ("no");
858 859 860
    }
}

861
/* This is the same as the xfns.c definition.  */
862
static void
863
x_set_cursor_type (FRAME_PTR f, Lisp_Object arg, Lisp_Object oldval)
864
{
865
  set_frame_cursor_types (f, arg);
866

867 868
  /* Make sure the cursor gets redrawn.  */
  cursor_type_changed = 1;
869
}
870

871

872 873
/* called to set mouse pointer color, but all other terms use it to
   initialize pointer types (and don't set the color ;) */
874
static void
875
x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
876
{
877
  /* don't think we can do this on Nextstep */
878 879 880
}


881 882 883 884
#define Str(x) #x
#define Xstr(x) Str(x)

static Lisp_Object
885
ns_appkit_version_str (void)
886 887 888 889 890 891 892 893 894 895 896 897 898 899
{
  char tmp[80];

#ifdef NS_IMPL_GNUSTEP
  sprintf(tmp, "gnustep-gui-%s", Xstr(GNUSTEP_GUI_VERSION));
#elif defined(NS_IMPL_COCOA)
  sprintf(tmp, "apple-appkit-%.2f", NSAppKitVersionNumber);
#else
  tmp = "ns-unknown";
#endif
  return build_string (tmp);
}


900 901 902 903
/* This is for use by x-server-version and collapses all version info we
   have into a single int.  For a better picture of the implementation
   running, use ns_appkit_version_str.*/
static int
904
ns_appkit_version_int (void)
905 906
{
#ifdef NS_IMPL_GNUSTEP
907
  return GNUSTEP_GUI_MAJOR_VERSION * 100 + GNUSTEP_GUI_MINOR_VERSION;
908 909 910 911 912 913 914
#elif defined(NS_IMPL_COCOA)
  return (int)NSAppKitVersionNumber;
#endif
  return 0;
}


915
static void
916
x_icon (struct frame *f, Lisp_Object parms)
917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944
/* --------------------------------------------------------------------------
   Strangely-named function to set icon position parameters in frame.
   This is irrelevant under OS X, but might be needed under GNUstep,
   depending on the window manager used.  Note, this is not a standard
   frame parameter-setter; it is called directly from x-create-frame.
   -------------------------------------------------------------------------- */
{
  Lisp_Object icon_x, icon_y;
  struct ns_display_info *dpyinfo = check_ns_display_info (Qnil);

  f->output_data.ns->icon_top = Qnil;
  f->output_data.ns->icon_left = Qnil;

  /* Set the position of the icon.  */
  icon_x = x_get_arg (dpyinfo, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
  icon_y = x_get_arg (dpyinfo, parms, Qicon_top, 0, 0,  RES_TYPE_NUMBER);
  if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
    {
      CHECK_NUMBER (icon_x);
      CHECK_NUMBER (icon_y);
      f->output_data.ns->icon_top = icon_y;
      f->output_data.ns->icon_left = icon_x;
    }
  else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
    error ("Both left and top icon corners of icon must be specified");
}


945
/* Note: see frame.c for template, also where generic functions are impl */
946 947 948 949
frame_parm_handler ns_frame_parm_handlers[] =
{
  x_set_autoraise, /* generic OK */
  x_set_autolower, /* generic OK */
950
  x_set_background_color,
951 952
  0, /* x_set_border_color,  may be impossible under Nextstep */
  0, /* x_set_border_width,  may be impossible under Nextstep */
953 954
  x_set_cursor_color,
  x_set_cursor_type,
955
  x_set_font, /* generic OK */
956 957 958
  x_set_foreground_color,
  x_set_icon_name,
  x_set_icon_type,
959
  x_set_internal_border_width, /* generic OK */
960
  x_set_menu_bar_lines,
961 962
  x_set_mouse_color,
  x_explicitly_set_name,
963
  x_set_scroll_bar_width, /* generic OK */
964
  x_set_title,
965 966 967
  x_set_unsplittable, /* generic OK */
  x_set_vertical_scroll_bars, /* generic OK */
  x_set_visibility, /* generic OK */
968
  x_set_tool_bar_lines,
969 970 971 972 973 974 975
  0, /* x_set_scroll_bar_foreground, will ignore (not possible on NS) */
  0, /* x_set_scroll_bar_background,  will ignore (not possible on NS) */
  x_set_screen_gamma, /* generic OK */
  x_set_line_spacing, /* generic OK, sets f->extra_line_spacing to int */
  x_set_fringe_width, /* generic OK */
  x_set_fringe_width, /* generic OK */
  0, /* x_set_wait_for_wm, will ignore */
976
  x_set_fullscreen, /* generic OK */
977
  x_set_font_backend, /* generic OK */
978
  x_set_alpha,
979 980
  0, /* x_set_sticky */
  0, /* x_set_tool_bar_position */
981 982 983
};


984 985 986 987 988 989 990 991 992 993 994 995 996 997 998
/* Handler for signals raised during x_create_frame.
   FRAME is the frame which is partially constructed.  */

static Lisp_Object
unwind_create_frame (Lisp_Object frame)
{
  struct frame *f = XFRAME (frame);

  /* If frame is already dead, nothing to do.  This can happen if the
     display is disconnected after the frame has become official, but
     before x_create_frame removes the unwind protect.  */
  if (!FRAME_LIVE_P (f))
    return Qnil;

  /* If frame is ``official'', nothing to do.  */
Jan Djärv's avatar
Jan Djärv committed
999
  if (NILP (Fmemq (frame, Vframe_list)))
1000
    {
1001
#if defined GLYPH_DEBUG && defined ENABLE_CHECKING
1002 1003 1004 1005 1006 1007
      struct ns_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
#endif

      x_free_frame_resources (f);
      free_glyphs (f);

1008
#ifdef GLYPH_DEBUG
1009
      /* Check that reference counts are indeed correct.  */
1010
      eassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount);
1011 1012 1013 1014 1015 1016 1017
#endif
      return Qt;
    }

  return Qnil;
}

1018 1019 1020 1021
/*
 * Read geometry related parameters from preferences if not in PARMS.
 * Returns the union of parms and any preferences read.
 */
1022

1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049
static Lisp_Object
get_geometry_from_preferences (struct ns_display_info *dpyinfo,
                               Lisp_Object parms)
{
  struct {
    const char *val;
    const char *cls;
    Lisp_Object tem;
  } r[] = {
    { "width",  "Width", Qwidth },
    { "height", "Height", Qheight },
    { "left", "Left", Qleft },
    { "top", "Top", Qtop },
  };

  int i;
  for (i = 0; i < sizeof (r)/sizeof (r[0]); ++i)
    {
      if (NILP (Fassq (r[i].tem, parms)))
        {
          Lisp_Object value
            = x_get_arg (dpyinfo, parms, r[i].tem, r[i].val, r[i].cls,
                         RES_TYPE_NUMBER);
          if (! EQ (value, Qunbound))
            parms = Fcons (Fcons (r[i].tem, value), parms);
        }
    }
1050

1051 1052
  return parms;
}
1053 1054 1055 1056 1057 1058 1059

/* ==========================================================================

    Lisp definitions

   ========================================================================== */

1060
DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
1061
       1, 1, 0,
1062
       doc: /* Make a new Nextstep window, called a "frame" in Emacs terms.
1063 1064 1065 1066 1067
Return an Emacs frame object.
PARMS is an alist of frame parameters.
If the parameters specify that the frame should not have a minibuffer,
and do not specify a specific minibuffer window to use,
then `default-minibuffer-frame' must be a frame whose minibuffer can
1068 1069 1070
be shared by the new frame.

This function is an internal primitive--use `make-frame' instead.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
1071
     (Lisp_Object parms)