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