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