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