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

Paul Eggert's avatar
Paul Eggert committed
3
Copyright (C) 1989, 1992-1994, 2005-2006, 2008-2020 Free Software
4
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 <https://www.gnu.org/licenses/>.  */
20

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

29
/* This should be the first include, as it may set up #defines affecting
30
   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
#ifdef NS_IMPL_COCOA
#include <IOKit/graphics/IOGraphicsLib.h>
49 50
#include "macfont.h"
#endif
51

52 53
#ifdef HAVE_NS

54
static EmacsTooltip *ns_tooltip = nil;
55

56
/* Static variables to handle AppleScript execution.  */
57 58
static Lisp_Object as_script, *as_result;
static int as_status;
59

60 61
static ptrdiff_t image_cache_refcount;

62
static struct ns_display_info *ns_display_info_for_name (Lisp_Object);
63

64 65 66 67 68 69
/* ==========================================================================

    Internal utility functions

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

70 71 72
/* 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,
73
   the first Nextstep display on the list.  */
74

75
static struct ns_display_info *
76
check_ns_display_info (Lisp_Object object)
77
{
78 79 80
  struct ns_display_info *dpyinfo = NULL;

  if (NILP (object))
81
    {
82 83 84
      struct frame *sf = XFRAME (selected_frame);

      if (FRAME_NS_P (sf) && FRAME_LIVE_P (sf))
85
	dpyinfo = FRAME_DISPLAY_INFO (sf);
86
      else if (x_display_list != 0)
87
	dpyinfo = x_display_list;
88
      else
89
        error ("Nextstep windows are not in use or not initialized");
90
    }
91
  else if (TERMINALP (object))
92
    {
93
      struct terminal *t = decode_live_terminal (object);
94 95

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

98
      dpyinfo = t->display_info.ns;
99
    }
100 101
  else if (STRINGP (object))
    dpyinfo = ns_display_info_for_name (object);
102 103
  else
    {
Dmitry Antipov's avatar
Dmitry Antipov committed
104
      struct frame *f = decode_window_system_frame (object);
105
      dpyinfo = FRAME_DISPLAY_INFO (f);
106
    }
107 108

  return dpyinfo;
109 110 111 112 113 114 115 116 117
}


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

  if (!FRAMEP (maybeFrame) || !FRAME_NS_P (XFRAME (maybeFrame)))
118
    maybeFrame = selected_frame; /* wrong_type_argument (Qframep, maybeFrame); */
119 120 121 122 123 124 125 126 127 128 129

  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.  */
130
static struct ns_display_info *
131
ns_display_info_for_name (Lisp_Object name)
132 133 134 135 136
{
  struct ns_display_info *dpyinfo;

  CHECK_STRING (name);

137 138 139
  for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next)
    if (!NILP (Fstring_equal (XCAR (dpyinfo->name_list_element), name)))
      return dpyinfo;
140

Glenn Morris's avatar
Glenn Morris committed
141
  error ("Emacs for Nextstep does not yet support multi-display");
142

143 144
  Fx_open_connection (name, Qnil, Qnil);
  dpyinfo = x_display_list;
145 146

  if (dpyinfo == 0)
147
    error ("Display on %s not responding.\n", SDATA (name));
148 149 150 151

  return dpyinfo;
}

152 153 154
static NSString *
ns_filename_from_panel (NSSavePanel *panel)
{
155
#ifdef NS_IMPL_COCOA
156 157 158 159 160 161 162 163 164 165 166
  NSURL *url = [panel URL];
  NSString *str = [url path];
  return str;
#else
  return [panel filename];
#endif
}

static NSString *
ns_directory_from_panel (NSSavePanel *panel)
{
167
#ifdef NS_IMPL_COCOA
168 169 170 171 172 173 174
  NSURL *url = [panel directoryURL];
  NSString *str = [url path];
  return str;
#else
  return [panel directory];
#endif
}
175

176
#ifndef NS_IMPL_COCOA
177 178 179
static Lisp_Object
interpret_services_menu (NSMenu *menu, Lisp_Object prefix, Lisp_Object old)
/* --------------------------------------------------------------------------
180
   Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side.
181 182 183
   -------------------------------------------------------------------------- */
{
  int i, count;
184
  NSMenuItem *item;
185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210
  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];
211
              res = make_fixnum (key|super_modifier);
212 213 214 215 216 217 218 219 220 221 222 223 224
            }
          else
            {
              res = Qundefined;
            }
          old = Fcons (Fcons (res,
                            Freverse (Fcons (nameStr,
                                           prefix))),
                    old);
        }
    }
  return old;
}
225
#endif
226 227 228 229 230 231 232 233 234 235


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

    Frame parameter setters

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


static void
236
ns_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
237 238
{
  NSColor *col;
239
  EmacsCGFloat r, g, b, alpha;
240

Jan Djärv's avatar
Jan Djärv committed
241 242 243 244
  /* Must block_input, because ns_lisp_to_color does block/unblock_input
     which means that col may be deallocated in its unblock_input if there
     is user input, unless we also block_input.  */
  block_input ();
245 246 247
  if (ns_lisp_to_color (arg, &col))
    {
      store_frame_param (f, Qforeground_color, oldval);
Jan Djärv's avatar
Jan Djärv committed
248
      unblock_input ();
249 250 251 252 253 254 255
      error ("Unknown color");
    }

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

256 257
  [col getRed: &r green: &g blue: &b alpha: &alpha];
  FRAME_FOREGROUND_PIXEL (f) =
258 259 260 261
    ARGB_TO_ULONG ((unsigned long) (alpha * 0xff),
                   (unsigned long) (r * 0xff),
                   (unsigned long) (g * 0xff),
                   (unsigned long) (b * 0xff));
262

263 264 265
  if (FRAME_NS_VIEW (f))
    {
      update_face_from_frame_parameter (f, Qforeground_color, arg);
266
      /* recompute_basic_faces (f); */
267
      if (FRAME_VISIBLE_P (f))
Jan Djärv's avatar
Jan Djärv committed
268
        SET_FRAME_GARBAGED (f);
269
    }
Jan Djärv's avatar
Jan Djärv committed
270
  unblock_input ();
271 272 273 274
}


static void
275
ns_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
276 277 278 279
{
  struct face *face;
  NSColor *col;
  NSView *view = FRAME_NS_VIEW (f);
280
  EmacsCGFloat r, g, b, alpha;
281

Jan Djärv's avatar
Jan Djärv committed
282
  block_input ();
283 284 285
  if (ns_lisp_to_color (arg, &col))
    {
      store_frame_param (f, Qbackground_color, oldval);
Jan Djärv's avatar
Jan Djärv committed
286
      unblock_input ();
287 288 289 290 291 292
      error ("Unknown color");
    }

  [col retain];
  [f->output_data.ns->background_color release];
  f->output_data.ns->background_color = col;
293 294 295

  [col getRed: &r green: &g blue: &b alpha: &alpha];
  FRAME_BACKGROUND_PIXEL (f) =
296 297 298 299
    ARGB_TO_ULONG ((unsigned long) (alpha * 0xff),
                   (unsigned long) (r * 0xff),
                   (unsigned long) (g * 0xff),
                   (unsigned long) (b * 0xff));
300

301 302 303 304
  if (view != nil)
    {
      [[view window] setBackgroundColor: col];

305
      if (alpha != (EmacsCGFloat) 1.0)
306 307 308 309 310 311 312
          [[view window] setOpaque: NO];
      else
          [[view window] setOpaque: YES];

      face = FRAME_DEFAULT_FACE (f);
      if (face)
        {
313
          col = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f);
314 315
          face->background = ns_index_color
            ([col colorWithAlphaComponent: alpha], f);
316 317 318 319 320

          update_face_from_frame_parameter (f, Qbackground_color, arg);
        }

      if (FRAME_VISIBLE_P (f))
Alan Third's avatar
Alan Third committed
321 322 323 324
        {
          SET_FRAME_GARBAGED (f);
          ns_clear_frame (f);
        }
325
    }
Jan Djärv's avatar
Jan Djärv committed
326
  unblock_input ();
327 328 329 330
}


static void
331
ns_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
332 333 334
{
  NSColor *col;

Jan Djärv's avatar
Jan Djärv committed
335
  block_input ();
336 337 338
  if (ns_lisp_to_color (arg, &col))
    {
      store_frame_param (f, Qcursor_color, oldval);
Jan Djärv's avatar
Jan Djärv committed
339
      unblock_input ();
340 341 342
      error ("Unknown color");
    }

343 344
  [FRAME_CURSOR_COLOR (f) release];
  FRAME_CURSOR_COLOR (f) = [col retain];
345 346 347

  if (FRAME_VISIBLE_P (f))
    {
348 349
      gui_update_cursor (f, 0);
      gui_update_cursor (f, 1);
350 351
    }
  update_face_from_frame_parameter (f, Qcursor_color, arg);
Jan Djärv's avatar
Jan Djärv committed
352
  unblock_input ();
353 354
}

355

356
static void
357
ns_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
358 359
{
  NSView *view = FRAME_NS_VIEW (f);
360
  NSTRACE ("ns_set_icon_name");
361

362
  /* See if it's changed.  */
363 364 365 366 367
  if (STRINGP (arg))
    {
      if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
        return;
    }
Paul Eggert's avatar
Paul Eggert committed
368
  else if (!STRINGP (oldval) && NILP (oldval) == NILP (arg))
369 370
    return;

371
  fset_icon_name (f, arg);
372 373 374

  if (NILP (arg))
    {
375 376
      if (!NILP (f->title))
        arg = f->title;
377
      else
378
        /* Explicit name and no icon-name -> explicit_name.  */
379
        if (f->explicit_name)
380
          arg = f->name;
381 382
        else
          {
383 384 385
            /* No explicit name and no icon-name ->
               name has to be rebuild from icon_title_format.  */
            windows_or_buffers_changed = 62;
386 387 388 389 390
            return;
          }
    }

  /* Don't change the name if it's already NAME.  */
391 392
  if ([[view window] miniwindowTitle]
      && ([[[view window] miniwindowTitle]
393
             isEqualToString: [NSString stringWithUTF8String:
394
					  SSDATA (arg)]]))
395 396 397
    return;

  [[view window] setMiniwindowTitle:
398
        [NSString stringWithUTF8String: SSDATA (arg)]];
399 400 401
}

static void
Dmitry Antipov's avatar
Dmitry Antipov committed
402
ns_set_name_internal (struct frame *f, Lisp_Object name)
403
{
404 405
  Lisp_Object encoded_name, encoded_icon_name;
  NSString *str;
406 407
  NSView *view = FRAME_NS_VIEW (f);

408

409
  encoded_name = ENCODE_UTF_8 (name);
410

411
  str = [NSString stringWithUTF8String: SSDATA (encoded_name)];
412

413

414 415 416
  /* Don't change the name if it's already NAME.  */
  if (! [[[view window] title] isEqualToString: str])
    [[view window] setTitle: str];
417

418
  if (!STRINGP (f->icon_name))
419
    encoded_icon_name = encoded_name;
420
  else
421
    encoded_icon_name = ENCODE_UTF_8 (f->icon_name);
422

423
  str = [NSString stringWithUTF8String: SSDATA (encoded_icon_name)];
424

425 426
  if ([[view window] miniwindowTitle]
      && ! [[[view window] miniwindowTitle] isEqualToString: str])
427
    [[view window] setMiniwindowTitle: str];
428 429 430 431 432 433

}

static void
ns_set_name (struct frame *f, Lisp_Object name, int explicit)
{
434
  NSTRACE ("ns_set_name");
435 436 437 438 439 440 441 442

  /* 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))
443
        update_mode_lines = 21;
444 445 446 447 448 449 450

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

  if (NILP (name))
451
    name = build_string ([ns_app_name UTF8String]);
452 453 454 455
  else
    CHECK_STRING (name);

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

459
  fset_name (f, name);
460

461
  /* Title overrides explicit name.  */
462 463
  if (! NILP (f->title))
    name = f->title;
464

465
  ns_set_name_internal (f, name);
466 467
}

468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495
static void
ns_set_represented_filename (struct frame *f)
{
  Lisp_Object filename, encoded_filename;
  Lisp_Object buf = XWINDOW (f->selected_window)->contents;
  NSAutoreleasePool *pool;
  NSString *fstr;
  NSView *view = FRAME_NS_VIEW (f);

  NSTRACE ("ns_set_represented_filename");

  if (f->explicit_name || ! NILP (f->title))
    return;

  block_input ();
  pool = [[NSAutoreleasePool alloc] init];
  filename = BVAR (XBUFFER (buf), filename);

  if (! NILP (filename))
    {
      encoded_filename = ENCODE_UTF_8 (filename);

      fstr = [NSString stringWithUTF8String: SSDATA (encoded_filename)];
      if (fstr == nil) fstr = @"";
    }
  else
    fstr = @"";

496 497 498
#if defined (NS_IMPL_COCOA) && defined (MAC_OS_X_VERSION_10_7)
  /* Work around for Mach port leaks on macOS 10.15 (bug#38618).  */
  NSURL *fileURL = [NSURL fileURLWithPath:fstr isDirectory:NO];
499
  NSNumber *isUbiquitousItem = @YES;
500 501 502
  [fileURL getResourceValue:(id *)&isUbiquitousItem
                     forKey:NSURLIsUbiquitousItemKey
                      error:nil];
503
  if ([isUbiquitousItem boolValue])
504 505 506
    fstr = @"";
#endif

507 508 509 510 511 512 513 514 515 516 517 518 519
#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
  [[view window] setRepresentedFilename: fstr];

  [pool release];
  unblock_input ();
}

520 521 522 523 524

/* 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
525
ns_explicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
526
{
527
  NSTRACE ("ns_explicitly_set_name");
528 529 530 531 532 533 534 535
  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
536
ns_implicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
537
{
538
  NSTRACE ("ns_implicitly_set_name");
539

540
  if (ns_use_proxy_icon)
541
    ns_set_represented_filename (f);
542

543
  ns_set_name (f, arg, 0);
544 545 546 547
}


/* Change the title of frame F to NAME.
548
   If NAME is nil, use the frame name as the title.  */
549 550

static void
551
ns_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name)
552
{
553
  NSTRACE ("ns_set_title");
554
  /* Don't change the title if it's already NAME.  */
555
  if (EQ (name, f->title))
556 557
    return;

558
  update_mode_lines = 22;
559

560
  fset_title (f, name);
561 562

  if (NILP (name))
563
    name = f->name;
564 565 566 567
  else
    CHECK_STRING (name);

  ns_set_name_internal (f, name);
568 569 570
}

void
571
ns_set_doc_edited (void)
572 573
{
  NSAutoreleasePool *pool;
574 575 576 577
  Lisp_Object tail, frame;
  block_input ();
  pool = [[NSAutoreleasePool alloc] init];
  FOR_EACH_FRAME (tail, frame)
578
    {
579 580
      BOOL edited = NO;
      struct frame *f = XFRAME (frame);
581 582 583 584 585 586
      struct window *w;
      NSView *view;

      if (! FRAME_NS_P (f)) continue;
      w = XWINDOW (FRAME_SELECTED_WINDOW (f));
      view = FRAME_NS_VIEW (f);
587 588 589 590
      if (!MINI_WINDOW_P (w))
        edited = ! NILP (Fbuffer_modified_p (w->contents)) &&
          ! NILP (Fbuffer_file_name (w->contents));
      [[view window] setDocumentEdited: edited];
591
    }
592 593 594

  [pool release];
  unblock_input ();
595 596 597
}


598
static void
599
ns_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
600 601 602 603 604
{
  int nlines;
  if (FRAME_MINIBUF_ONLY_P (f))
    return;

605 606
  if (TYPE_RANGED_FIXNUMP (int, value))
    nlines = XFIXNUM (value);
607 608 609 610 611 612 613
  else
    nlines = 0;

  FRAME_MENU_BAR_LINES (f) = 0;
  if (nlines)
    {
      FRAME_EXTERNAL_MENU_BAR (f) = 1;
614
      /* Does for all frames, whereas we just want for one frame
615
	 [NSMenu setMenuBarVisible: YES]; */
616 617 618 619 620
    }
  else
    {
      if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
        free_frame_menubar (f);
621
      /* [NSMenu setMenuBarVisible: NO]; */
622 623 624 625 626
      FRAME_EXTERNAL_MENU_BAR (f) = 0;
    }
}


627 628 629 630
/* tabbar support */
static void
ns_set_tab_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
{
631
  /* Currently unimplemented.  */
632 633 634 635
  NSTRACE ("ns_set_tab_bar_lines");
}


636
/* toolbar support */
637
static void
638
ns_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
639
{
640
  /* Currently, when the tool bar changes state, the frame is resized.
641 642 643

     TODO: It would be better if this didn't occur when 1) the frame
     is full height or maximized or 2) when specified by
644
     `frame-inhibit-implied-resize'.  */
645 646
  int nlines;

647
  NSTRACE ("ns_set_tool_bar_lines");
648

649 650 651
  if (FRAME_MINIBUF_ONLY_P (f))
    return;

652 653
  if (RANGED_FIXNUMP (0, value, INT_MAX))
    nlines = XFIXNAT (value);
654 655 656 657 658 659 660 661 662 663 664 665 666 667
  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;
668 669 670 671 672 673 674 675 676 677 678 679 680 681 682

          {
            EmacsView *view = FRAME_NS_VIEW (f);
            int fs_state = [view fullscreenState];

            if (fs_state == FULLSCREEN_MAXIMIZED)
              {
                [view setFSValue:FULLSCREEN_WIDTH];
              }
            else if (fs_state == FULLSCREEN_HEIGHT)
              {
                [view setFSValue:FULLSCREEN_NONE];
              }
          }
       }
683 684
    }

685 686 687 688 689 690 691 692 693 694 695 696
  {
    int inhibit
      = ((f->after_make_frame
	  && !f->tool_bar_resized
	  && (EQ (frame_inhibit_implied_resize, Qt)
	      || (CONSP (frame_inhibit_implied_resize)
		  && !NILP (Fmemq (Qtool_bar_lines,
				   frame_inhibit_implied_resize))))
	  && NILP (get_frame_param (f, Qfullscreen)))
	 ? 0
	 : 2);

697 698
    NSTRACE_MSG ("inhibit:%d", inhibit);

699 700 701
    frame_size_history_add (f, Qupdate_frame_tool_bar, 0, 0, Qnil);
    adjust_frame_size (f, -1, -1, inhibit, 0, Qtool_bar_lines);
  }
702 703 704
}


705
static void
706
ns_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
707 708
{
  int old_width = FRAME_INTERNAL_BORDER_WIDTH (f);
Paul Eggert's avatar
Paul Eggert committed
709
  int new_width = check_int_nonnegative (arg);
710

Paul Eggert's avatar
Paul Eggert committed
711
  if (new_width == old_width)
712
    return;
Paul Eggert's avatar
Paul Eggert committed
713
  f->internal_border_width = new_width;
714

715
  if (FRAME_NATIVE_WINDOW (f) != 0)
716
    adjust_frame_size (f, -1, -1, 3, 0, Qinternal_border_width);
717 718 719 720 721

  SET_FRAME_GARBAGED (f);
}


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

732
  NSTRACE ("ns_implicitly_set_icon_type");
733

734
  block_input ();
735 736
  pool = [[NSAutoreleasePool alloc] init];
  if (f->output_data.ns->miniimage
737
      && [[NSString stringWithUTF8String: SSDATA (f->name)]
738 739 740
               isEqualToString: [(NSImage *)f->output_data.ns->miniimage name]])
    {
      [pool release];
741
      unblock_input ();
742 743 744
      return;
    }

745
  tem = assq_no_quit (Qicon_type, f->param_alist);
746 747 748
  if (CONSP (tem) && ! NILP (XCDR (tem)))
    {
      [pool release];
749
      unblock_input ();
750 751 752 753
      return;
    }

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

  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];
789
  unblock_input ();
790 791 792 793
}


static void
794
ns_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
795 796 797 798 799
{
  EmacsView *view = FRAME_NS_VIEW (f);
  id image = nil;
  BOOL setMini = YES;

800
  NSTRACE ("ns_set_icon_type");
801 802 803

  if (!NILP (arg) && SYMBOLP (arg))
    {
804
      arg =build_string (SSDATA (SYMBOL_NAME (arg)));
805 806 807
      store_frame_param (f, Qicon_type, arg);
    }

808
  /* Do it the implicit way.  */
809 810 811 812 813 814 815 816 817 818 819
  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:
820
                                            SSDATA (arg)]];
821 822 823 824 825 826 827 828 829 830 831

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

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

832
/* This is the same as the xfns.c definition.  */
833
static void
834
ns_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
835
{
836
  set_frame_cursor_types (f, arg);
837 838
}

839 840
/* called to set mouse pointer color, but all other terms use it to
   initialize pointer types (and don't set the color ;) */
841
static void
842
ns_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
843
{
844
  /* Don't think we can do this on Nextstep.  */
845 846 847
}


848 849 850 851
#define Str(x) #x
#define Xstr(x) Str(x)

static Lisp_Object
852
ns_appkit_version_str (void)
853
{
854
  char tmp[256];
855 856 857

#ifdef NS_IMPL_GNUSTEP
  sprintf(tmp, "gnustep-gui-%s", Xstr(GNUSTEP_GUI_VERSION));
Paul Eggert's avatar
Paul Eggert committed
858
#elif defined (NS_IMPL_COCOA)
859 860 861 862 863
  NSString *osversion
    = [[NSProcessInfo processInfo] operatingSystemVersionString];
  sprintf(tmp, "appkit-%.2f %s",
          NSAppKitVersionNumber,
          [osversion UTF8String]);
864 865 866 867 868 869 870
#else
  tmp = "ns-unknown";
#endif
  return build_string (tmp);
}


871 872
/* 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
873
   running, use ns_appkit_version_str.  */
874
static int
875
ns_appkit_version_int (void)
876 877
{
#ifdef NS_IMPL_GNUSTEP
878
  return GNUSTEP_GUI_MAJOR_VERSION * 100 + GNUSTEP_GUI_MINOR_VERSION;
Paul Eggert's avatar
Paul Eggert committed
879
#elif defined (NS_IMPL_COCOA)
880 881 882 883 884 885
  return (int)NSAppKitVersionNumber;
#endif
  return 0;
}


886
static void
887
ns_icon (struct frame *f, Lisp_Object parms)
888 889
/* --------------------------------------------------------------------------
   Strangely-named function to set icon position parameters in frame.
890
   This is irrelevant under macOS, but might be needed under GNUstep,
891 892 893 894 895 896 897
   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);

898 899
  f->output_data.ns->icon_top = -1;
  f->output_data.ns->icon_left = -1;
900 901

  /* Set the position of the icon.  */
902 903 904 905
  icon_x = gui_display_get_arg (dpyinfo, parms, Qicon_left, 0, 0,
                                RES_TYPE_NUMBER);
  icon_y = gui_display_get_arg (dpyinfo, parms, Qicon_top, 0, 0,
                                RES_TYPE_NUMBER);
906 907
  if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
    {
908 909 910 911
      CHECK_FIXNUM (icon_x);
      CHECK_FIXNUM (icon_y);
      f->output_data.ns->icon_top = XFIXNUM (icon_y);
      f->output_data.ns->icon_left = XFIXNUM (icon_x);
912 913 914 915 916 917
    }
  else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
    error ("Both left and top icon corners of icon must be specified");
}


918 919
/* Note: see frame.c for template, also where generic functions are
   implemented.  */
920 921
frame_parm_handler ns_frame_parm_handlers[] =
{
922 923 924
  gui_set_autoraise, /* generic OK */
  gui_set_autolower, /* generic OK */
  ns_set_background_color,
925 926
  0, /* x_set_border_color,  may be impossible under Nextstep */
  0, /* x_set_border_width,  may be impossible under Nextstep */
927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945
  ns_set_cursor_color,
  ns_set_cursor_type,
  gui_set_font, /* generic OK */
  ns_set_foreground_color,
  ns_set_icon_name,
  ns_set_icon_type,
  ns_set_internal_border_width,
  gui_set_right_divider_width, /* generic OK */
  gui_set_bottom_divider_width, /* generic OK */
  ns_set_menu_bar_lines,
  ns_set_mouse_color,
  ns_explicitly_set_name,
  gui_set_scroll_bar_width, /* generic OK */
  gui_set_scroll_bar_height, /* generic OK */
  ns_set_title,
  gui_set_unsplittable, /* generic OK */
  gui_set_vertical_scroll_bars, /* generic OK */
  gui_set_horizontal_scroll_bars, /* generic OK */
  gui_set_visibility, /* generic OK */
946
  ns_set_tab_bar_lines,
947
  ns_set_tool_bar_lines,
948 949
  0, /* x_set_scroll_bar_foreground, will ignore (not possible on NS) */
  0, /* x_set_scroll_bar_background,  will ignore (not possible on NS) */
950 951 952 953
  gui_set_screen_gamma, /* generic OK */
  gui_set_line_spacing, /* generic OK, sets f->extra_line_spacing to int */
  gui_set_left_fringe, /* generic OK */
  gui_set_right_fringe, /* generic OK */
954
  0, /* x_set_wait_for_wm, will ignore */
955 956 957
  gui_set_fullscreen, /* generic OK */
  gui_set_font_backend, /* generic OK */
  gui_set_alpha,
958 959
  0, /* x_set_sticky */
  0, /* x_set_tool_bar_position */
960
  0, /* x_set_inhibit_double_buffering */
961
#ifdef NS_IMPL_COCOA
962
  ns_set_undecorated,
963
#else
964
  0, /* ns_set_undecorated */
965
#endif
966
  ns_set_parent_frame,
967
  0, /* x_set_skip_taskbar */
968 969 970
  ns_set_no_focus_on_map,
  ns_set_no_accept_focus,
  ns_set_z_group,
971
  0, /* x_set_override_redirect */
972
  gui_set_no_special_glyphs,
973 974 975 976
#ifdef NS_IMPL_COCOA
  ns_set_appearance,
  ns_set_transparent_titlebar,
#endif
977 978 979
};


980 981 982
/* Handler for signals raised during x_create_frame.
   FRAME is the frame which is partially constructed.  */

983
static void
984 985 986 987 988 989 990 991
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))
992
    return;
993 994

  /* If frame is ``official'', nothing to do.  */
Jan Djärv's avatar
Jan Djärv committed
995
  if (NILP (Fmemq (frame, Vframe_list)))
996
    {
997
#if defined GLYPH_DEBUG && defined ENABLE_CHECKING
998
      struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
999 1000
#endif

1001 1002 1003 1004
      /* If the frame's image cache refcount is still the same as our
	 private shadow variable, it means we are unwinding a frame
	 for which we didn't yet call init_frame_faces, where the
	 refcount is incremented.  Therefore, we increment it here, so
1005
	 that free_frame_faces, called in ns_free_frame_resources
1006 1007 1008 1009 1010 1011
	 below, will not mistakenly decrement the counter that was not
	 incremented yet to account for this new frame.  */
      if (FRAME_IMAGE_CACHE (f) != NULL
	  && FRAME_IMAGE_CACHE (f)->refcount == image_cache_refcount)
	FRAME_IMAGE_CACHE (f)->refcount++;

1012
      ns_free_frame_resources (f);
1013 1014
      free_glyphs (f);

1015
#if defined GLYPH_DEBUG && defined ENABLE_CHECKING
1016
      /* Check that reference counts are indeed correct.  */
1017
      eassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount);
1018 1019 1020 1021
#endif
    }
}

1022 1023 1024 1025
/*
 * Read geometry related parameters from preferences if not in PARMS.
 * Returns the union of parms and any preferences read.
 */
1026

1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042
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;
1043
  for (i = 0; i < ARRAYELTS (r); ++i)
1044 1045 1046 1047
    {
      if (NILP (Fassq (r[i].tem, parms)))
        {
          Lisp_Object value
1048 1049
            = gui_display_get_arg (dpyinfo, parms, r[i].tem, r[i].val, r[i].cls,
                                   RES_TYPE_NUMBER);
1050 1051 1052 1053
          if (! EQ (value, Qunbound))
            parms = Fcons (Fcons (r[i].tem, value), parms);
        }
    }
1054

1055 1056
  return parms;
}
1057 1058 1059 1060 1061 1062 1063

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

    Lisp definitions

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

1064
DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
1065
       1, 1, 0,
1066
       doc: /* SKIP: real doc in xfns.c.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
1067
     (Lisp_Object parms)
1068 1069 1070 1071 1072
{
  struct frame *f;
  Lisp_Object frame, tem;
  Lisp_Object name;
  int minibuffer_only = 0;
1073
  long window_prompting = 0;
1074
  ptrdiff_t count = specpdl_ptr - specpdl;
1075 1076
  Lisp_Object display;
  struct ns_display_info *dpyinfo = NULL;
1077
  Lisp_Object parent, parent_frame;
1078
  struct kboard *kb;
1079
  static int desc_ctr = 1;
1080
  int x_width = 0, x_height = 0;
1081

1082
  /* gui_display_get_arg modifies parms.  */
Adrian Robert's avatar
Adrian Robert committed
1083 1084
  parms = Fcopy_alist (parms);

1085 1086 1087 1088
  /* Use this general default value to start with
     until we know if this frame has a specified name.  */
  Vx_resource_name = Vinvocation_name;

1089 1090
  display = gui_display_get_arg (dpyinfo, parms, Qterminal, 0, 0,
                                 RES_TYPE_STRING);
1091 1092 1093
  if (EQ (display, Qunbound))
    display = Qnil;
  dpyinfo = check_ns_display_info (display);
1094
  kb = dpyinfo->terminal->kboard;
1095 1096 1097 1098

  if (!dpyinfo->terminal->name)
    error ("Terminal is not live, can't create new frames on it");

1099 1100
  name = gui_display_get_arg (dpyinfo, parms, Qname, 0, 0,
                              RES_TYPE_STRING);
1101 1102 1103 1104 1105 1106 1107 1108
  if (!STRINGP (name)
      && ! EQ (name, Qunbound)
      && ! NILP (name))
    error ("Invalid frame name--not a string or nil");

  if (STRINGP (name))
    Vx_resource_name = name;

1109 1110
  parent = gui_display_get_arg (dpyinfo, parms, Qparent_id, 0, 0,
                                RES_TYPE_NUMBER);
1111 1112 1113
  if (EQ (parent, Qunbound))
    parent = Qnil;
  if (! NILP (parent))
1114
    CHECK_FIXNUM (parent);
1115

1116 1117 1118
  /* make_frame_without_minibuffer can run Lisp code and garbage collect.  */
  /* No need to protect DISPLAY because that's not used after passing
     it to make_frame_without_minibuffer.  */
1119
  frame = Qnil;