1 /* Functions for the NeXT/Open/GNUstep and MacOSX window system.
2 Copyright (C) 1989, 1992, 1993, 1994, 2005, 2006, 2008
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
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.
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.
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/>. */
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)
32 #include "blockinput.h"
37 #include "termhooks.h"
40 #include "character.h"
44 int fns_trace_num
= 1;
45 #define NSTRACE
(x
) fprintf (stderr
, "
%s:%d: [%d] " #x "\n", \
46 __FILE__
, __LINE__
, ++fns_trace_num
)
53 extern NSArray
*ns_send_types
, *ns_return_types
, *ns_drag_types
;
55 extern Lisp_Object Qforeground_color
;
56 extern Lisp_Object Qbackground_color
;
57 extern Lisp_Object Qcursor_color
;
58 extern Lisp_Object Qinternal_border_width
;
59 extern Lisp_Object Qvisibility
;
60 extern Lisp_Object Qcursor_type
;
61 extern Lisp_Object Qicon_type
;
62 extern Lisp_Object Qicon_name
;
63 extern Lisp_Object Qicon_left
;
64 extern Lisp_Object Qicon_top
;
65 extern Lisp_Object Qleft
;
66 extern Lisp_Object Qright
;
67 extern Lisp_Object Qtop
;
68 extern Lisp_Object Qdisplay
;
69 extern Lisp_Object Qvertical_scroll_bars
;
70 extern Lisp_Object Qauto_raise
;
71 extern Lisp_Object Qauto_lower
;
72 extern Lisp_Object Qbox
;
73 extern Lisp_Object Qscroll_bar_width
;
74 extern Lisp_Object Qx_resource_name
;
75 extern Lisp_Object Qface_set_after_frame_default
;
76 extern Lisp_Object Qunderline
, Qundefined
;
77 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
78 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
81 Lisp_Object Qns_frame_parameter
;
82 Lisp_Object Qbuffered
;
83 Lisp_Object Qfontsize
;
85 /* hack for OS X file panels */
88 /* Alist of elements (REGEXP . IMAGE) for images of icons associated
90 Lisp_Object Vns_icon_type_alist
;
92 EmacsTooltip
*ns_tooltip
;
94 /* Need forward declaration here to preserve organizational integrity of file */
95 Lisp_Object Fns_open_connection
(Lisp_Object
, Lisp_Object
, Lisp_Object
);
97 extern BOOL ns_in_resize
;
100 /* ==========================================================================
102 Internal utility functions
104 ========================================================================== */
111 error ("OpenStep is not in use or not initialized"
);
115 /* Nonzero if we can use mouse menus. */
123 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
124 and checking validity for NS. */
126 check_ns_frame
(Lisp_Object frame
)
131 f
= SELECTED_FRAME
();
134 CHECK_LIVE_FRAME
(frame
);
137 if (! FRAME_NS_P
(f
))
138 error ("non
-NS frame used"
);
143 /* Let the user specify an NS display with a frame.
144 nil stands for the selected frame--or, if that is not an NS frame,
145 the first NS display on the list. */
146 static
struct ns_display_info
*
147 check_ns_display_info
(Lisp_Object frame
)
151 struct frame
*f
= SELECTED_FRAME
();
152 if (FRAME_NS_P
(f
) && FRAME_LIVE_P
(f
) )
153 return FRAME_NS_DISPLAY_INFO
(f
);
154 else if (ns_display_list
!= 0)
155 return ns_display_list
;
157 error ("NS windows are not in use or not initialized"
);
159 else if (INTEGERP
(frame
))
161 struct terminal *t
= get_terminal
(frame
, 1);
163 if (t
->type != output_ns
)
164 error ("
Terminal %d is not an NS display", XINT (frame));
166 return t
->display_info.ns
;
168 else if (STRINGP
(frame
))
169 return ns_display_info_for_name
(frame
);
174 CHECK_LIVE_FRAME
(frame
);
176 if (! FRAME_NS_P
(f
))
177 error ("non
-NS frame used"
);
178 return FRAME_NS_DISPLAY_INFO
(f
);
180 return NULL; /* shut compiler up */
185 ns_get_window
(Lisp_Object maybeFrame
)
187 id
view =nil
, window
=nil
;
189 if (!FRAMEP
(maybeFrame
) ||
!FRAME_NS_P
(XFRAME
(maybeFrame
)))
190 maybeFrame
= selected_frame
;/*wrong_type_argument (Qframep, maybeFrame); */
192 if (!NILP
(maybeFrame
))
193 view = FRAME_NS_VIEW
(XFRAME
(maybeFrame
));
194 if (view) window
=[view window
];
201 ns_get_screen
(Lisp_Object anythingUnderTheSun
)
204 NSScreen
*screen
= 0;
206 struct terminal *terminal;
207 struct ns_display_info
*dpyinfo
;
208 struct frame
*f
= NULL;
211 if (INTEGERP
(anythingUnderTheSun
)) {
212 /* we got a terminal */
213 terminal = get_terminal
(anythingUnderTheSun
, 1);
214 dpyinfo
= terminal->display_info.ns
;
215 f
= dpyinfo
->ns_focus_frame
;
217 f
= dpyinfo
->ns_highlight_frame
;
219 } else if (FRAMEP
(anythingUnderTheSun
) &&
220 FRAME_NS_P
(XFRAME
(anythingUnderTheSun
))) {
222 f
= XFRAME
(anythingUnderTheSun
);
224 } else if (STRINGP
(anythingUnderTheSun
)) { /* FIXME/cl for multi-display */
228 f
= SELECTED_FRAME
();
231 XSETFRAME
(frame
, f
);
232 window
= ns_get_window
(frame
);
236 screen
= [window screen
];
238 screen
= [NSScreen mainScreen
];
244 /* Return the X display structure for the display named NAME.
245 Open a new connection if necessary. */
246 struct ns_display_info
*
247 ns_display_info_for_name
(name
)
251 struct ns_display_info
*dpyinfo
;
255 for (dpyinfo
= ns_display_list
, names
= ns_display_name_list
;
257 dpyinfo
= dpyinfo
->next
, names
= XCDR
(names
))
260 tem
= Fstring_equal
(XCAR
(XCAR
(names
)), name
);
265 error ("Emacs
for OpenStep does not yet support multi
-display."
);
267 Fns_open_connection
(name
, Qnil
, Qnil
);
268 dpyinfo
= ns_display_list
;
271 error ("OpenStep on
%s not responding.\n", SDATA (name));
278 interpret_services_menu
(NSMenu
*menu, Lisp_Object prefix
, Lisp_Object old
)
279 /* --------------------------------------------------------------------------
280 Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
281 -------------------------------------------------------------------------- */
291 count
= [menu numberOfItems
];
292 for (i
= 0; i
<count
; i
++)
294 item
= [menu itemAtIndex
: i
];
295 name
= [[item
title] UTF8String
];
298 nameStr
= build_string
(name
);
300 if ([item hasSubmenu
])
302 old
= interpret_services_menu
([item submenu
],
303 Fcons
(nameStr
, prefix
), old
);
307 keys
= [item keyEquivalent
];
308 if (keys
&& [keys
length] )
310 key
= [keys characterAtIndex
: 0];
311 res
= make_number
(key|super_modifier
);
317 old
= Fcons
(Fcons
(res
,
318 Freverse
(Fcons
(nameStr
,
328 /* ==========================================================================
330 Frame parameter setters
332 ========================================================================== */
336 ns_set_foreground_color
(struct frame
*f
, Lisp_Object arg
, Lisp_Object oldval
)
340 if (ns_lisp_to_color
(arg
, &col
))
342 store_frame_param
(f
, Qforeground_color
, oldval
);
343 error ("Unknown color"
);
347 [f
->output_data.ns
->foreground_color release
];
348 f
->output_data.ns
->foreground_color
= col
;
350 if (FRAME_NS_VIEW
(f
))
352 update_face_from_frame_parameter
(f
, Qforeground_color
, arg
);
353 /*recompute_basic_faces (f); */
354 if (FRAME_VISIBLE_P
(f
))
361 ns_set_background_color
(struct frame
*f
, Lisp_Object arg
, Lisp_Object oldval
)
365 NSView
*view = FRAME_NS_VIEW
(f
);
368 if (ns_lisp_to_color
(arg
, &col
))
370 store_frame_param
(f
, Qbackground_color
, oldval
);
371 error ("Unknown color"
);
374 /* clear the frame; in some instances the NS-internal GC appears not to
375 update, or it does update and cannot clear old text properly */
376 if (FRAME_VISIBLE_P
(f
))
380 [f
->output_data.ns
->background_color release
];
381 f
->output_data.ns
->background_color
= col
;
384 [[view window
] setBackgroundColor
: col
];
385 alpha
= [col alphaComponent
];
388 /* the alpha code below only works on 10.4, so we need to do something
389 else (albeit less good) otherwise.
390 Check NSApplication.h for useful NSAppKitVersionNumber values. */
391 if (NSAppKitVersionNumber
< 744.0)
392 [[view window
] setAlphaValue
: alpha
];
396 [[view window
] setOpaque
: NO
];
398 [[view window
] setOpaque
: YES
];
400 face
= FRAME_DEFAULT_FACE
(f
);
403 col
= NS_FACE_BACKGROUND
(face
);
405 = (EMACS_UINT
) [[col colorWithAlphaComponent
: alpha
] retain
];
408 update_face_from_frame_parameter
(f
, Qbackground_color
, arg
);
411 if (FRAME_VISIBLE_P
(f
))
418 ns_set_cursor_color
(struct frame
*f
, Lisp_Object arg
, Lisp_Object oldval
)
422 if (ns_lisp_to_color
(arg
, &col
))
424 store_frame_param
(f
, Qcursor_color
, oldval
);
425 error ("Unknown color"
);
428 [f
->output_data.ns
->desired_cursor_color release
];
429 f
->output_data.ns
->desired_cursor_color
= [col retain
];
431 if (FRAME_VISIBLE_P
(f
))
433 x_update_cursor
(f
, 0);
434 x_update_cursor
(f
, 1);
436 update_face_from_frame_parameter
(f
, Qcursor_color
, arg
);
441 ns_set_icon_name
(struct frame
*f
, Lisp_Object arg
, Lisp_Object oldval
)
443 NSView
*view = FRAME_NS_VIEW
(f
);
444 NSTRACE
(ns_set_icon_name
);
449 /* see if it's changed */
452 if (STRINGP
(oldval
) && EQ
(Fstring_equal
(oldval
, arg
), Qt
))
455 else if (!STRINGP
(oldval
) && EQ
(oldval
, Qnil
) == EQ
(arg
, Qnil
))
462 if (!NILP
(f
->title))
465 /* explicit name and no icon-name -> explicit_name */
466 if (f
->explicit_name
)
470 /* no explicit name and no icon-name ->
471 name has to be rebuild from icon_title_format */
472 windows_or_buffers_changed
++;
477 /* Don't change the name if it's already NAME. */
478 if ([[view window
] miniwindowTitle
] &&
479 ([[[view window
] miniwindowTitle
]
480 isEqualToString
: [NSString stringWithUTF8String
:
484 [[view window
] setMiniwindowTitle
:
485 [NSString stringWithUTF8String
: SDATA
(arg
)]];
490 ns_set_name_iconic
(struct frame
*f
, Lisp_Object name
, int explicit
)
492 NSView
*view = FRAME_NS_VIEW
(f
);
493 NSTRACE
(ns_set_name_iconic
);
498 /* Make sure that requests from lisp code override requests from
499 Emacs redisplay code. */
502 /* If we're switching from explicit to implicit, we had better
503 update the mode lines and thereby update the title. */
504 if (f
->explicit_name
&& NILP
(name
))
505 update_mode_lines
= 1;
507 f
->explicit_name
= ! NILP
(name
);
509 else if (f
->explicit_name
)
512 /* title overrides explicit name */
513 if (! NILP
(f
->title))
516 /* icon_name overrides title and explicit name */
517 if (! NILP
(f
->icon_name
))
522 ([[[NSProcessInfo processInfo
] processName
] UTF8String
]);
526 /* Don't change the name if it's already NAME. */
527 if ([[view window
] miniwindowTitle
] &&
528 ([[[view window
] miniwindowTitle
]
529 isEqualToString
: [NSString stringWithUTF8String
:
533 [[view window
] setMiniwindowTitle
:
534 [NSString stringWithUTF8String
: SDATA
(name
)]];
539 ns_set_name
(struct frame
*f
, Lisp_Object name
, int explicit
)
541 NSView
*view = FRAME_NS_VIEW
(f
);
542 NSTRACE
(ns_set_name
);
547 /* Make sure that requests from lisp code override requests from
548 Emacs redisplay code. */
551 /* If we're switching from explicit to implicit, we had better
552 update the mode lines and thereby update the title. */
553 if (f
->explicit_name
&& NILP
(name
))
554 update_mode_lines
= 1;
556 f
->explicit_name
= ! NILP
(name
);
558 else if (f
->explicit_name
)
563 ([[[NSProcessInfo processInfo
] processName
] UTF8String
]);
567 /* title overrides explicit name */
568 if (! NILP
(f
->title))
573 /* Don't change the name if it's already NAME. */
574 if ([[[view window
] title]
575 isEqualToString
: [NSString stringWithUTF8String
:
578 [[view window
] setTitle
: [NSString stringWithUTF8String
:
583 /* This function should be called when the user's lisp code has
584 specified a name for the frame; the name will override any set by the
587 ns_explicitly_set_name
(FRAME_PTR f
, Lisp_Object arg
, Lisp_Object oldval
)
589 NSTRACE
(ns_explicitly_set_name
);
590 ns_set_name_iconic
(f
, arg
, 1);
591 ns_set_name
(f
, arg
, 1);
595 /* This function should be called by Emacs redisplay code to set the
596 name; names set this way will never override names set by the user's
599 x_implicitly_set_name
(FRAME_PTR f
, Lisp_Object arg
, Lisp_Object oldval
)
601 NSTRACE
(x_implicitly_set_name
);
602 if (FRAME_ICONIFIED_P
(f
))
603 ns_set_name_iconic
(f
, arg
, 0);
605 ns_set_name
(f
, arg
, 0);
609 /* Change the title of frame F to NAME.
610 If NAME is nil, use the frame name as the title.
612 If EXPLICIT is non-zero, that indicates that lisp code is setting the
613 name; if NAME is a string, set F's name to NAME and set
614 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
616 If EXPLICIT is zero, that indicates that Emacs redisplay code is
617 suggesting a new name, which lisp code should override; if
618 F->explicit_name is set, ignore the new name; otherwise, set it. */
620 ns_set_title
(struct frame
*f
, Lisp_Object name
, Lisp_Object old_name
)
622 NSTRACE
(ns_set_title
);
623 /* Don't change the title if it's already NAME. */
624 if (EQ
(name
, f
->title))
627 update_mode_lines
= 1;
634 ns_set_name_as_filename
(struct frame
*f
)
636 NSView
*view = FRAME_NS_VIEW
(f
);
638 Lisp_Object buf
= XWINDOW
(f
->selected_window
)->buffer
;
640 NSAutoreleasePool
*pool
;
641 NSTRACE
(ns_set_name_as_filename
);
643 if (f
->explicit_name ||
! NILP
(f
->title) || ns_in_resize
)
647 pool
= [[NSAutoreleasePool alloc
] init
];
648 name
=XBUFFER
(buf
)->filename
;
649 if (NILP
(name
) || FRAME_ICONIFIED_P
(f
)) name
=XBUFFER
(buf
)->name
;
651 if (FRAME_ICONIFIED_P
(f
) && !NILP
(f
->icon_name
))
656 ([[[NSProcessInfo processInfo
] processName
] UTF8String
]);
660 title = FRAME_ICONIFIED_P
(f
) ?
[[[view window
] miniwindowTitle
] UTF8String
]
661 : [[[view window
] title] UTF8String
];
663 if (title && (! strcmp (title, SDATA
(name
))))
670 if (! FRAME_ICONIFIED_P
(f
))
673 /* work around a bug observed on 10.3 where
674 setTitleWithRepresentedFilename does not clear out previous state
675 if given filename does not exist */
676 NSString
*str
= [NSString stringWithUTF8String
: SDATA
(name
)];
677 if (![[NSFileManager defaultManager
] fileExistsAtPath
: str
])
679 [[view window
] setTitleWithRepresentedFilename
: @""
];
680 [[view window
] setTitle
: str
];
684 [[view window
] setTitleWithRepresentedFilename
: str
];
687 [[view window
] setTitleWithRepresentedFilename
:
688 [NSString stringWithUTF8String
: SDATA
(name
)]];
694 [[view window
] setMiniwindowTitle
:
695 [NSString stringWithUTF8String
: SDATA
(name
)]];
703 ns_set_doc_edited
(struct frame
*f
, Lisp_Object arg
, Lisp_Object oldval
)
705 NSView
*view = FRAME_NS_VIEW
(f
);
706 NSAutoreleasePool
*pool
;
708 pool
= [[NSAutoreleasePool alloc
] init
];
709 [[view window
] setDocumentEdited
: !NILP
(arg
)];
716 ns_set_menu_bar_lines
(struct frame
*f
, Lisp_Object value
, Lisp_Object oldval
)
719 int olines
= FRAME_MENU_BAR_LINES
(f
);
720 if (FRAME_MINIBUF_ONLY_P
(f
))
723 if (INTEGERP
(value
))
724 nlines
= XINT
(value
);
728 FRAME_MENU_BAR_LINES
(f
) = 0;
731 FRAME_EXTERNAL_MENU_BAR
(f
) = 1;
732 /* does for all frames, whereas we just want for one frame
733 [NSMenu setMenuBarVisible: YES]; */
737 if (FRAME_EXTERNAL_MENU_BAR
(f
) == 1)
738 free_frame_menubar
(f
);
739 /* [NSMenu setMenuBarVisible: NO]; */
740 FRAME_EXTERNAL_MENU_BAR
(f
) = 0;
745 /* 23: XXX: there is an erroneous direct call in window.c to this fn */
747 x_set_menu_bar_lines
(struct frame
*f
, Lisp_Object value
, Lisp_Object oldval
)
749 ns_set_menu_bar_lines
(f
, value
, oldval
);
753 /* 23: toolbar support */
755 ns_set_tool_bar_lines
(struct frame
*f
, Lisp_Object value
, Lisp_Object oldval
)
758 Lisp_Object root_window
;
760 if (FRAME_MINIBUF_ONLY_P
(f
))
763 if (INTEGERP
(value
) && XINT
(value
) >= 0)
764 nlines
= XFASTINT
(value
);
770 FRAME_EXTERNAL_TOOL_BAR
(f
) = 1;
771 update_frame_tool_bar
(f
);
775 if (FRAME_EXTERNAL_TOOL_BAR
(f
))
777 free_frame_tool_bar
(f
);
778 FRAME_EXTERNAL_TOOL_BAR
(f
) = 0;
782 x_set_window_size
(f
, 0, f
->text_cols
, f
->text_lines
);
786 /* 23: XXX: there is an erroneous direct call in window.c to this fn */
788 x_set_tool_bar_lines
(struct frame
*f
, Lisp_Object value
, Lisp_Object oldval
)
790 ns_set_tool_bar_lines
(f
, value
, oldval
);
795 ns_implicitly_set_icon_type
(struct frame
*f
)
798 EmacsView
*view = FRAME_NS_VIEW
(f
);
800 Lisp_Object chain
, elt
;
801 NSAutoreleasePool
*pool
;
804 NSTRACE
(ns_implicitly_set_icon_type
);
807 pool
= [[NSAutoreleasePool alloc
] init
];
808 if (f
->output_data.ns
->miniimage
809 && [[NSString stringWithUTF8String
: SDATA
(f
->name
)]
810 isEqualToString
: [(NSImage
*)f
->output_data.ns
->miniimage name
]])
817 tem
= assq_no_quit
(Qicon_type
, f
->param_alist
);
818 if (CONSP
(tem
) && ! NILP
(XCDR
(tem
)))
825 for (chain
= Vns_icon_type_alist
;
826 (image = nil
) && CONSP
(chain
);
827 chain
= XCDR
(chain
))
830 /* special case: 't' means go by file type */
831 if (SYMBOLP
(elt
) && EQ
(elt
, Qt
) && SDATA
(f
->name
)[0] == '/')
834 = [NSString stringWithUTF8String
: SDATA
(f
->name
)];
835 if ([[NSFileManager defaultManager
] fileExistsAtPath
: str
])
836 image = [[[NSWorkspace sharedWorkspace
] iconForFile
: str
] retain
];
838 else if (CONSP
(elt
) &&
839 STRINGP
(XCAR
(elt
)) &&
840 STRINGP
(XCDR
(elt
)) &&
841 fast_string_match
(XCAR
(elt
), f
->name
) >= 0)
843 image = [EmacsImage allocInitFromFile
: XCDR
(elt
)];
845 image = [[NSImage imageNamed
:
846 [NSString stringWithUTF8String
:
847 SDATA
(XCDR
(elt
))]] retain
];
853 image = [[[NSWorkspace sharedWorkspace
] iconForFileType
: @"
text"
] retain
];
857 [f
->output_data.ns
->miniimage release
];
858 f
->output_data.ns
->miniimage
= image;
859 [view setMiniwindowImage
: setMini
];
866 ns_set_icon_type
(struct frame
*f
, Lisp_Object arg
, Lisp_Object oldval
)
868 EmacsView
*view = FRAME_NS_VIEW
(f
);
872 NSTRACE
(ns_set_icon_type
);
874 if (!NILP
(arg
) && SYMBOLP
(arg
))
876 arg
=build_string
(SDATA
(SYMBOL_NAME
(arg
)));
877 store_frame_param
(f
, Qicon_type
, arg
);
880 /* do it the implicit way */
883 ns_implicitly_set_icon_type
(f
);
889 image = [EmacsImage allocInitFromFile
: arg
];
891 image =[NSImage imageNamed
: [NSString stringWithUTF8String
:
896 image = [NSImage imageNamed
: @"
text"
];
900 f
->output_data.ns
->miniimage
= image;
901 [view setMiniwindowImage
: setMini
];
905 /* 23: added Xism; we stub out (we do implement this in ns-win.el) */
907 XParseGeometry
(char *string
, int
*x
, int
*y
,
908 unsigned int
*width
, unsigned int
*height
)
910 message1
("Warning
: XParseGeometry not supported under NS.
\n"
);
915 /* TODO: move to nsterm? */
917 ns_lisp_to_cursor_type
(Lisp_Object arg
)
920 if (XTYPE
(arg
) == Lisp_String
)
922 else if (XTYPE
(arg
) == Lisp_Symbol
)
923 str
= SDATA
(SYMBOL_NAME
(arg
));
925 if (!strcmp (str
, "box"
)) return filled_box
;
926 if (!strcmp (str
, "hollow"
)) return hollow_box
;
927 if (!strcmp (str
, "underscore"
)) return underscore
;
928 if (!strcmp (str
, "
bar"
)) return bar;
929 if (!strcmp (str
, "no"
)) return no_highlight
;
935 ns_cursor_type_to_lisp
(int arg
)
939 case filled_box
: return Qbox
;
940 case hollow_box
: return intern
("hollow"
);
941 case underscore
: return intern
("underscore"
);
942 case bar: return intern
("
bar"
);
944 default
: return intern
("no"
);
950 ns_set_cursor_type
(struct frame
*f
, Lisp_Object arg
, Lisp_Object oldval
)
954 val
= ns_lisp_to_cursor_type
(arg
);
957 f
->output_data.ns
->desired_cursor
=val
;
961 store_frame_param
(f
, Qcursor_type
, oldval
);
962 error ("the `cursor
-type' frame parameter should be either `no', `box
', \
963 `hollow', `underscore
' or `bar'."
);
970 /* 23: called to set mouse pointer color, but all other terms use it to
971 initialize pointer types (and don't set the color ;) */
973 ns_set_mouse_color
(struct frame
*f
, Lisp_Object arg
, Lisp_Object oldval
)
975 /* don't think we can do this on NS */
980 ns_icon
(struct frame
*f
, Lisp_Object parms
)
981 /* --------------------------------------------------------------------------
982 Strangely-named function to set icon position parameters in frame.
983 This is irrelevant under OS X, but might be needed under GNUstep,
984 depending on the window manager used. Note, this is not a standard
985 frame parameter-setter; it is called directly from x-create-frame.
986 -------------------------------------------------------------------------- */
988 Lisp_Object icon_x
, icon_y
;
989 struct ns_display_info
*dpyinfo
= check_ns_display_info
(Qnil
);
991 f
->output_data.ns
->icon_top
= Qnil
;
992 f
->output_data.ns
->icon_left
= Qnil
;
994 /* Set the position of the icon. */
995 icon_x
= x_get_arg
(dpyinfo
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
996 icon_y
= x_get_arg
(dpyinfo
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
997 if (!EQ
(icon_x
, Qunbound
) && !EQ
(icon_y
, Qunbound
))
999 CHECK_NUMBER
(icon_x
);
1000 CHECK_NUMBER
(icon_y
);
1001 f
->output_data.ns
->icon_top
= icon_y
;
1002 f
->output_data.ns
->icon_left
= icon_x
;
1004 else if (!EQ
(icon_x
, Qunbound
) ||
!EQ
(icon_y
, Qunbound
))
1005 error ("Both left and top icon corners of icon must be specified"
);
1009 /* 23 Note: commented out ns_... entries are no longer used in 23.
1010 commented out x_... entries have not been implemented yet.
1011 see frame.c for template, also where all generic OK functions are impl */
1012 frame_parm_handler ns_frame_parm_handlers
[] =
1014 x_set_autoraise
, /* generic OK */
1015 x_set_autolower
, /* generic OK */
1016 ns_set_background_color
,
1017 0, /* x_set_border_color, may be impossible under NS */
1018 0, /* x_set_border_width, may be impossible under NS */
1019 ns_set_cursor_color
,
1021 x_set_font
, /* generic OK */
1022 ns_set_foreground_color
,
1025 x_set_internal_border_width
, /* generic OK */
1026 ns_set_menu_bar_lines
,
1028 ns_explicitly_set_name
,
1029 x_set_scroll_bar_width
, /* generic OK */
1031 x_set_unsplittable
, /* generic OK */
1032 x_set_vertical_scroll_bars
, /* generic OK */
1033 x_set_visibility
, /* generic OK */
1034 ns_set_tool_bar_lines
,
1035 0, /* x_set_scroll_bar_foreground, will ignore (not possible on NS) */
1036 0, /* x_set_scroll_bar_background, will ignore (not possible on NS) */
1037 x_set_screen_gamma
, /* generic OK */
1038 x_set_line_spacing
, /* generic OK, sets f->extra_line_spacing to int */
1039 x_set_fringe_width
, /* generic OK */
1040 x_set_fringe_width
, /* generic OK */
1041 0, /* x_set_wait_for_wm, will ignore */
1042 0, /* x_set_fullscreen will ignore */
1043 x_set_font_backend
/* generic OK */
1047 DEFUN
("x
-create
-frame"
, Fns_create_frame
, Sns_create_frame
,
1049 "Make a new NS window
, which is called a
\"frame
\" in Emacs terms.
\n\
1050 Return an Emacs frame object representing the X window.
\n\
1051 ALIST is an alist of frame parameters.
\n\
1052 If the parameters specify that the frame should not have a minibuffer
,\n\
1053 and do not specify a specific minibuffer window to use
,\n\
1054 then `default
-minibuffer
-frame
' must be a frame whose minibuffer can\n\
1055 be shared by the new frame.")
1059 static int desc_ctr = 1;
1061 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1062 Lisp_Object frame, tem;
1064 int minibuffer_only = 0;
1065 int count = specpdl_ptr - specpdl;
1066 Lisp_Object display;
1067 struct ns_display_info *dpyinfo = NULL;
1070 Lisp_Object tfont, tfontsize;
1071 int window_prompting = 0;
1076 display = x_get_arg (dpyinfo, parms, Qterminal, 0, 0, RES_TYPE_STRING);
1077 if (EQ (display, Qunbound))
1079 dpyinfo = check_ns_display_info (display);
1081 if (!dpyinfo->terminal->name)
1082 error ("Terminal is not live, can't create new frames on it"
);
1084 kb
= dpyinfo
->terminal->kboard
;
1086 name
= x_get_arg
(dpyinfo
, parms
, Qname
, 0, 0, RES_TYPE_STRING
);
1088 && ! EQ
(name
, Qunbound
)
1090 error ("Invalid frame name
--not a string or nil"
);
1093 Vx_resource_name
= name
;
1095 parent
= x_get_arg
(dpyinfo
, parms
, Qparent_id
, 0, 0, RES_TYPE_NUMBER
);
1096 if (EQ
(parent
, Qunbound
))
1098 if (! NILP
(parent
))
1099 CHECK_NUMBER
(parent
);
1102 GCPRO4
(parms
, parent
, name
, frame
);
1104 tem
= x_get_arg
(dpyinfo
, parms
, Qminibuffer
, "minibuffer"
, "Minibuffer"
,
1106 if (EQ
(tem
, Qnone
) || NILP
(tem
))
1108 f
= make_frame_without_minibuffer
(Qnil
, kb
, display
);
1110 else if (EQ
(tem
, Qonly
))
1112 f
= make_minibuffer_frame
();
1113 minibuffer_only
= 1;
1115 else if (WINDOWP
(tem
))
1117 f
= make_frame_without_minibuffer
(tem
, kb
, display
);
1124 /* Set the name; the functions to which we pass f expect the name to
1126 if (EQ
(name
, Qunbound
) || NILP
(name
) ||
(XTYPE
(name
) != Lisp_String
))
1129 = build_string
([[[NSProcessInfo processInfo
] processName
] UTF8String
]);
1130 f
->explicit_name
=0;
1135 f
->explicit_name
= 1;
1136 specbind
(Qx_resource_name
, name
);
1139 XSETFRAME
(frame
, f
);
1140 FRAME_CAN_HAVE_SCROLL_BARS
(f
) = 1;
1142 f
->terminal = dpyinfo
->terminal;
1143 f
->terminal->reference_count
++;
1145 f
->output_method
= output_ns
;
1146 f
->output_data.ns
= (struct ns_output
*)xmalloc
(sizeof
*(f
->output_data.ns
));
1147 bzero
(f
->output_data.ns
, sizeof
(*(f
->output_data.ns
)));
1149 FRAME_FONTSET
(f
) = -1;
1151 /* record_unwind_protect (unwind_create_frame, frame); safety; maybe later? */
1153 f
->icon_name
= x_get_arg
(dpyinfo
, parms
, Qicon_name
, "iconName"
, "
Title"
,
1155 if (EQ
(f
->icon_name
, Qunbound
) ||
(XTYPE
(f
->icon_name
) != Lisp_String
))
1156 f
->icon_name
= Qnil
;
1158 FRAME_NS_DISPLAY_INFO
(f
) = dpyinfo
;
1160 f
->output_data.ns
->window_desc
= desc_ctr
++;
1163 f
->output_data.ns
->parent_desc
= (Window
) XFASTINT
(parent
);
1164 f
->output_data.ns
->explicit_parent
= 1;
1168 f
->output_data.ns
->parent_desc
= FRAME_NS_DISPLAY_INFO
(f
)->root_window
;
1169 f
->output_data.ns
->explicit_parent
= 0;
1172 f
->resx
= dpyinfo
->resx
;
1173 f
->resy
= dpyinfo
->resy
;
1176 register_font_driver
(&nsfont_driver
, f
);
1177 x_default_parameter
(f
, parms
, Qfont_backend
, Qnil
,
1178 "fontBackend"
, "FontBackend"
, RES_TYPE_STRING
);
1181 /* use for default font name */
1182 id font
= [NSFont userFixedPitchFontOfSize
: -1.0]; /* default */
1183 tfontsize
= x_default_parameter
(f
, parms
, Qfontsize
,
1184 make_number
(0 /*(int)[font pointSize]*/),
1185 "fontSize"
, "FontSize"
, RES_TYPE_NUMBER
);
1186 tfont
= x_default_parameter
(f
, parms
, Qfont
,
1187 build_string
([[font fontName
] UTF8String
]),
1188 "font"
, "Font"
, RES_TYPE_STRING
);
1192 x_default_parameter
(f
, parms
, Qborder_width
, make_number
(0),
1193 "borderwidth"
, "BorderWidth"
, RES_TYPE_NUMBER
);
1194 x_default_parameter
(f
, parms
, Qinternal_border_width
, make_number
(2),
1195 "internalBorderWidth"
, "InternalBorderWidth"
,
1198 /* default scrollbars on right on Mac */
1201 #ifdef NS_IMPL_GNUSTEP
1206 x_default_parameter
(f
, parms
, Qvertical_scroll_bars
, spos
,
1207 "verticalScrollBars"
, "VerticalScrollBars"
,
1210 x_default_parameter
(f
, parms
, Qforeground_color
, build_string
("Black"
),
1211 "foreground"
, "Foreground"
, RES_TYPE_STRING
);
1212 x_default_parameter
(f
, parms
, Qbackground_color
, build_string
("
White"
),
1213 "background"
, "Background"
, RES_TYPE_STRING
);
1214 x_default_parameter
(f
, parms
, Qcursor_color
, build_string
("grey"
),
1215 "cursorColor"
, "CursorColor"
, RES_TYPE_STRING
);
1216 /* FIXME: not suppported yet in NS */
1217 x_default_parameter
(f
, parms
, Qline_spacing
, Qnil
,
1218 "lineSpacing"
, "LineSpacing"
, RES_TYPE_NUMBER
);
1219 x_default_parameter
(f
, parms
, Qleft_fringe
, Qnil
,
1220 "leftFringe"
, "LeftFringe"
, RES_TYPE_NUMBER
);
1221 x_default_parameter
(f
, parms
, Qright_fringe
, Qnil
,
1222 "rightFringe"
, "RightFringe"
, RES_TYPE_NUMBER
);
1225 init_frame_faces
(f
);
1227 x_default_parameter
(f
, parms
, Qmenu_bar_lines
, make_number
(0), "menuBar"
,
1228 "menuBar"
, RES_TYPE_NUMBER
);
1229 x_default_parameter
(f
, parms
, Qtool_bar_lines
, make_number
(0), "toolBar"
,
1230 "toolBar"
, RES_TYPE_NUMBER
);
1231 x_default_parameter
(f
, parms
, Qbuffer_predicate
, Qnil
, "bufferPredicate"
,
1232 "BufferPredicate"
, RES_TYPE_SYMBOL
);
1233 x_default_parameter
(f
, parms
, Qtitle
, Qnil
, "
title"
, "
Title"
,
1236 /* TODO: other terms seem to get away w/o this complexity.. */
1237 if (NILP
(Fassq
(Qwidth
, parms
)))
1240 = x_get_arg
(dpyinfo
, parms
, Qwidth
, "width"
, "Width"
,
1242 if (! EQ
(value
, Qunbound
))
1243 parms
= Fcons
(Fcons
(Qwidth
, value
), parms
);
1245 if (NILP
(Fassq
(Qheight
, parms
)))
1248 = x_get_arg
(dpyinfo
, parms
, Qheight
, "height"
, "Height"
,
1250 if (! EQ
(value
, Qunbound
))
1251 parms
= Fcons
(Fcons
(Qheight
, value
), parms
);
1253 if (NILP
(Fassq
(Qleft
, parms
)))
1256 = x_get_arg
(dpyinfo
, parms
, Qleft
, "left"
, "Left"
, RES_TYPE_NUMBER
);
1257 if (! EQ
(value
, Qunbound
))
1258 parms
= Fcons
(Fcons
(Qleft
, value
), parms
);
1260 if (NILP
(Fassq
(Qtop
, parms
)))
1263 = x_get_arg
(dpyinfo
, parms
, Qtop
, "top"
, "Top"
, RES_TYPE_NUMBER
);
1264 if (! EQ
(value
, Qunbound
))
1265 parms
= Fcons
(Fcons
(Qtop
, value
), parms
);
1268 window_prompting
= x_figure_window_size
(f
, parms
, 1);
1270 tem
= x_get_arg
(dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
1271 f
->no_split
= minibuffer_only ||
(!EQ
(tem
, Qunbound
) && !EQ
(tem
, Qnil
));
1273 /* NOTE: on other terms, this is done in set_mouse_color, however this
1274 was not getting called under NS */
1275 f
->output_data.ns
->text_cursor
= [NSCursor IBeamCursor
];
1276 f
->output_data.ns
->nontext_cursor
= [NSCursor arrowCursor
];
1277 f
->output_data.ns
->modeline_cursor
= [NSCursor pointingHandCursor
];
1278 f
->output_data.ns
->hand_cursor
= [NSCursor pointingHandCursor
];
1279 f
->output_data.ns
->hourglass_cursor
= [NSCursor disappearingItemCursor
];
1280 f
->output_data.ns
->horizontal_drag_cursor
= [NSCursor resizeLeftRightCursor
];
1281 FRAME_NS_DISPLAY_INFO
(f
)->vertical_scroll_bar_cursor
1282 = [NSCursor arrowCursor
];
1283 f
->output_data.ns
->current_pointer
= f
->output_data.ns
->text_cursor
;
1285 [[EmacsView alloc
] initFrameFromEmacs
: f
];
1289 /* It is now ok to make the frame official even if we get an error below.
1290 The frame needs to be on Vframe_list or making it visible won't work. */
1291 Vframe_list
= Fcons
(frame
, Vframe_list
);
1292 /*FRAME_NS_DISPLAY_INFO (f)->reference_count++; */
1294 x_default_parameter
(f
, parms
, Qcursor_type
, Qbox
, "cursorType"
, "CursorType"
,
1296 x_default_parameter
(f
, parms
, Qscroll_bar_width
, Qnil
, "scrollBarWidth"
,
1297 "ScrollBarWidth"
, RES_TYPE_NUMBER
);
1298 x_default_parameter
(f
, parms
, Qicon_type
, Qnil
, "bitmapIcon"
, "BitmapIcon"
,
1300 x_default_parameter
(f
, parms
, Qauto_raise
, Qnil
, "autoRaise"
, "AutoRaise"
,
1302 x_default_parameter
(f
, parms
, Qauto_lower
, Qnil
, "autoLower"
, "AutoLower"
,
1304 x_default_parameter
(f
, parms
, Qbuffered
, Qt
, "buffered"
, "Buffered"
,
1307 width
= FRAME_COLS
(f
);
1308 height
= FRAME_LINES
(f
);
1310 SET_FRAME_COLS
(f
, 0);
1311 FRAME_LINES
(f
) = 0;
1312 change_frame_size
(f
, height
, width
, 1, 0, 0);
1314 if (! f
->output_data.ns
->explicit_parent
)
1316 tem
= x_get_arg
(dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_BOOLEAN
);
1317 if (EQ
(tem
, Qunbound
))
1320 x_set_visibility
(f
, tem
, Qnil
);
1322 [[FRAME_NS_VIEW
(f
) window
] makeKeyWindow
];
1325 if (FRAME_HAS_MINIBUF_P
(f
)
1326 && (!FRAMEP
(kb
->Vdefault_minibuffer_frame
)
1327 ||
!FRAME_LIVE_P
(XFRAME
(kb
->Vdefault_minibuffer_frame
))))
1328 kb
->Vdefault_minibuffer_frame
= frame
;
1330 /* All remaining specified parameters, which have not been "used"
1331 by x_get_arg and friends, now go in the misc. alist of the frame. */
1332 for (tem
= parms
; CONSP
(tem
); tem
= XCDR
(tem
))
1333 if (CONSP
(XCAR
(tem
)) && !NILP
(XCAR
(XCAR
(tem
))))
1334 f
->param_alist
= Fcons
(XCAR
(tem
), f
->param_alist
);
1337 Vwindow_list
= Qnil
;
1339 return unbind_to
(count
, frame
);
1343 /* ==========================================================================
1347 ========================================================================== */
1349 DEFUN
("ns
-focus
-frame"
, Fns_focus_frame
, Sns_focus_frame
, 1, 1, 0,
1350 doc: /* Set the input focus to FRAME.
1351 FRAME nil means use the selected frame. */)
1355 struct frame
*f
= check_ns_frame
(frame
);
1356 struct ns_display_info
*dpyinfo
= FRAME_NS_DISPLAY_INFO
(f
);
1358 if (dpyinfo
->ns_focus_frame
!= f
)
1360 EmacsView
*view = FRAME_NS_VIEW
(f
);
1362 [[view window
] makeKeyAndOrderFront
: view];
1370 DEFUN
("ns
-popup
-prefs
-panel"
, Fns_popup_prefs_panel
, Sns_popup_prefs_panel
,
1371 0, 0, ""
, "Pop up the preferences panel."
)
1375 [(EmacsApp
*)NSApp showPreferencesWindow
: NSApp
];
1380 DEFUN
("ns
-popup
-font
-panel"
, Fns_popup_font_panel
, Sns_popup_font_panel
,
1381 0, 1, ""
, "Pop up the font panel."
)
1389 fm
= [NSFontManager new
];
1391 f
= SELECTED_FRAME
();
1394 CHECK_FRAME
(frame
);
1398 [fm setSelectedFont
: ((struct nsfont_info
*)f
->output_data.ns
->font
)->nsfont
1400 [fm orderFrontFontPanel
: NSApp
];
1405 DEFUN
("ns
-popup
-color
-panel"
, Fns_popup_color_panel
, Sns_popup_color_panel
,
1406 0, 1, ""
, "Pop up the color panel."
)
1414 f
= SELECTED_FRAME
();
1417 CHECK_FRAME
(frame
);
1421 [NSApp orderFrontColorPanel
: NSApp
];
1426 DEFUN
("ns
-read
-file
-name"
, Fns_read_file_name
, Sns_read_file_name
, 1, 4, 0,
1427 "As read
-file
-name except that NS panels are used
for querying
, and
\n\
1428 args are slightly different. Nil returned
if no selection made.
\n\
1429 Set ISLOAD non
-nil
if file being read
for a
save."
)
1430 (prompt
, dir, isLoad
, init
)
1431 Lisp_Object prompt
, dir, isLoad
, init
;
1433 static id fileDelegate
= nil
;
1438 NSString
*promptS
= NILP
(prompt
) ||
!STRINGP
(prompt
) ? nil
:
1439 [NSString stringWithUTF8String
: SDATA
(prompt
)];
1440 NSString
*dirS
= NILP
(dir) ||
!STRINGP
(dir) ?
1441 [NSString stringWithUTF8String
: SDATA
(current_buffer
->directory
)] :
1442 [NSString stringWithUTF8String
: SDATA
(dir)];
1443 NSString
*initS
= NILP
(init
) ||
!STRINGP
(init
) ? nil
:
1444 [NSString stringWithUTF8String
: SDATA
(init
)];
1448 if (fileDelegate
== nil
)
1449 fileDelegate
= [EmacsFileDelegate new
];
1451 [NSCursor setHiddenUntilMouseMoves
: NO
];
1453 if ([dirS characterAtIndex
: 0] == '~')
1454 dirS
= [dirS stringByExpandingTildeInPath
];
1456 panel
= NILP
(isLoad
) ?
1457 [EmacsSavePanel savePanel
] : [EmacsOpenPanel openPanel
];
1459 [panel setTitle
: promptS
];
1461 /* Puma (10.1) does not have */
1462 if ([panel respondsToSelector
: @selector
(setAllowsOtherFileTypes
:)])
1463 [panel setAllowsOtherFileTypes
: YES
];
1465 [panel setTreatsFilePackagesAsDirectories
: YES
];
1466 [panel setDelegate
: fileDelegate
];
1471 ret
= [panel runModalForDirectory
: dirS file
: initS
];
1475 [panel setCanChooseDirectories
: YES
];
1476 ret
= [panel runModalForDirectory
: dirS file
: initS types
: nil
];
1479 ret
= (ret
= NSOKButton
) || panelOK
;
1481 fname
= [panel filename
];
1483 [[FRAME_NS_VIEW
(SELECTED_FRAME
()) window
] makeKeyWindow
];
1485 return ret ? build_string
([fname UTF8String
]) : Qnil
;
1489 DEFUN
("ns
-get-resource"
, Fns_get_resource
, Sns_get_resource
, 2, 2, 0,
1490 "
Return the value of the property NAME of OWNER from the defaults database.
\n\
1491 If OWNER is nil
, Emacs is assumed."
)
1493 Lisp_Object owner
, name
;
1499 owner
= build_string
1500 ([[[NSProcessInfo processInfo
] processName
] UTF8String
]);
1501 /* CHECK_STRING (owner); this should be just "Emacs" */
1502 CHECK_STRING
(name
);
1503 /*fprintf (stderr, "ns-get-resource checking resource '%s'\n", SDATA (name)); */
1505 value
=[[[NSUserDefaults standardUserDefaults
]
1506 objectForKey
: [NSString stringWithUTF8String
: SDATA
(name
)]]
1510 return build_string
(value
);
1511 /*fprintf (stderr, "Nothing found for NS resource '%s'.\n", SDATA (name)); */
1516 DEFUN
("ns
-set-resource"
, Fns_set_resource
, Sns_set_resource
, 3, 3, 0,
1517 "
Set property NAME of OWNER to VALUE
, from the defaults database.
\n\
1518 If OWNER is nil
, Emacs is assumed.
\n\
1519 If VALUE is nil
, the default is removed."
)
1520 (owner
, name
, value
)
1521 Lisp_Object owner
, name
, value
;
1526 = build_string
([[[NSProcessInfo processInfo
] processName
] UTF8String
]);
1527 CHECK_STRING
(owner
);
1528 CHECK_STRING
(name
);
1531 [[NSUserDefaults standardUserDefaults
] removeObjectForKey
:
1532 [NSString stringWithUTF8String
: SDATA
(name
)]];
1536 CHECK_STRING
(value
);
1537 [[NSUserDefaults standardUserDefaults
] setObject
:
1538 [NSString stringWithUTF8String
: SDATA
(value
)]
1539 forKey
: [NSString stringWithUTF8String
:
1547 DEFUN
("ns
-set-alpha"
, Fns_set_alpha
, Sns_set_alpha
, 2, 2, 0,
1548 "
Return a color same as given with alpha
set to given value
\n\
1549 from
0 to
1, where
1 is fully opaque."
)
1557 CHECK_STRING
(color
);
1558 CHECK_NUMBER_OR_FLOAT
(alpha
);
1560 if (ns_lisp_to_color
(color
, &col
))
1561 error ("Unknown color."
);
1563 a
= XFLOATINT
(alpha
);
1564 if (a
< 0.0 || a
> 1.0)
1565 error ("Alpha value should be between
0 and
1 inclusive."
);
1567 col
= [col colorWithAlphaComponent
: a
];
1568 return ns_color_to_lisp
(col
);
1572 DEFUN
("ns
-server
-max-request
-size"
, Fns_server_max_request_size
,
1573 Sns_server_max_request_size
,
1575 "This
function is only present
for completeness. It does not
return\n\
1576 a usable result
for NS windows."
)
1578 Lisp_Object display
;
1581 /* This function has no real equivalent under NeXTstep. Return nil to
1587 DEFUN
("ns
-server
-vendor"
, Fns_server_vendor
, Sns_server_vendor
, 0, 1, 0,
1588 "Returns the vendor ID string of the NS server of display DISPLAY.
\n\
1589 The optional argument DISPLAY specifies
which display to ask about.
\n\
1590 DISPLAY should be either a frame or a display name
(a string
).
\n\
1591 If omitted or nil
, that stands
for the selected frame
's display.")
1593 Lisp_Object display;
1596 #ifdef NS_IMPL_GNUSTEP
1597 return build_string ("GNU");
1599 return build_string ("Apple");
1604 DEFUN ("ns-server-version", Fns_server_version, Sns_server_version, 0, 1, 0,
1605 "Returns the version number of the NS release of display DISPLAY.\n\
1606 See also the function `ns-server-vendor'.
\n\n\
1607 The optional argument DISPLAY specifies
which display to ask about.
\n\
1608 DISPLAY should be either a frame or a display name
(a string
).
\n\
1609 If omitted or nil
, that stands
for the selected frame
's display.")
1611 Lisp_Object display;
1613 /* FIXME: return GUI version on GNUSTEP, ?? on OS X */
1614 return build_string ("1.0");
1618 DEFUN ("ns-display-screens", Fns_display_screens, Sns_display_screens, 0, 1, 0,
1619 "Returns the number of screens on the NS server of display DISPLAY.\n\
1620 The optional argument DISPLAY specifies which display to ask about.\n\
1621 DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\
1622 If omitted or nil, that stands for the selected frame's display."
)
1624 Lisp_Object display
;
1629 num
= [[NSScreen screens
] count
];
1631 return (num
!= 0) ? make_number
(num
) : Qnil
;
1635 DEFUN
("ns
-display
-mm
-height"
, Fns_display_mm_height
, Sns_display_mm_height
,
1637 "Returns the height in millimeters of the NS display DISPLAY.
\n\
1638 The optional argument DISPLAY specifies
which display to ask about.
\n\
1639 DISPLAY should be either a frame
, a display name
(a string
), or
terminal ID.
\n\
1640 If omitted or nil
, that stands
for the selected frame
's display.")
1642 Lisp_Object display;
1645 return make_number ((int)
1646 ([ns_get_screen (display) frame].size.height/(92.0/25.4)));
1650 DEFUN ("ns-display-mm-width", Fns_display_mm_width, Sns_display_mm_width,
1652 "Returns the width in millimeters of the NS display DISPLAY.\n\
1653 The optional argument DISPLAY specifies which display to ask about.\n\
1654 DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\
1655 If omitted or nil, that stands for the selected frame's display."
)
1657 Lisp_Object display
;
1660 return make_number
((int
)
1661 ([ns_get_screen
(display
) frame
].
size.width
/(92.0/25.4)));
1665 DEFUN
("ns
-display
-backing
-store"
, Fns_display_backing_store
,
1666 Sns_display_backing_store
, 0, 1, 0,
1667 "Returns an indication of whether NS display DISPLAY does backing store.
\n\
1668 The value may be `buffered
', `retained', or `non
-retained
'.\n\
1669 The optional argument DISPLAY specifies which display to ask about.\n\
1670 DISPLAY should be either a frame, display name (a string), or terminal ID.\n\
1671 If omitted or nil, that stands for the selected frame's display.
\n\
1672 Under NS
, this may differ
for each frame."
)
1674 Lisp_Object display
;
1677 switch ([ns_get_window
(display
) backingType
])
1679 case NSBackingStoreBuffered
:
1680 return intern
("buffered"
);
1681 case NSBackingStoreRetained
:
1682 return intern
("retained"
);
1683 case NSBackingStoreNonretained
:
1684 return intern
("non
-retained"
);
1686 error ("Strange value
for backingType parameter of frame"
);
1688 return Qnil
; /* not reached, shut compiler up */
1692 DEFUN
("ns
-display
-visual
-class"
, Fns_display_visual_class
,
1693 Sns_display_visual_class
, 0, 1, 0,
1694 "Returns the visual
class of the NS display DISPLAY.
\n\
1695 The value is one of the symbols `static
-gray', `gray-scale',\n\
1696 `static
-color
', `pseudo-color', `true
-color
', or `direct-color'.
\n\n\
1697 The optional argument DISPLAY specifies
which display to ask about.
\n\
1698 DISPLAY should be either a frame
, a display name
(a string
), or
terminal ID.
\n\
1699 If omitted or nil
, that stands
for the selected frame
's display.")
1701 Lisp_Object display;
1703 NSWindowDepth depth;
1705 depth = [ns_get_screen (display) depth];
1707 if ( depth == NSBestDepth (NSCalibratedWhiteColorSpace, 2, 2, YES, NULL))
1708 return intern ("static-gray");
1709 else if (depth == NSBestDepth (NSCalibratedWhiteColorSpace, 8, 8, YES, NULL))
1710 return intern ("gray-scale");
1711 else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 8, YES, NULL))
1712 return intern ("pseudo-color");
1713 else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 4, 12, NO, NULL))
1714 return intern ("true-color");
1715 else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 24, NO, NULL))
1716 return intern ("direct-color");
1718 /* color mgmt as far as we do it is really handled by NS itself anyway */
1719 return intern ("direct-color");
1723 DEFUN ("ns-display-save-under", Fns_display_save_under,
1724 Sns_display_save_under, 0, 1, 0,
1725 "Returns t if the NS display DISPLAY supports the save-under feature.\n\
1726 The optional argument DISPLAY specifies which display to ask about.\n\
1727 DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\
1728 If omitted or nil, that stands for the selected frame's display.
\n\
1729 Under NS
, this may differ
for each frame."
)
1731 Lisp_Object display
;
1734 switch ([ns_get_window
(display
) backingType
])
1736 case NSBackingStoreBuffered
:
1739 case NSBackingStoreRetained
:
1740 case NSBackingStoreNonretained
:
1744 error ("Strange value
for backingType parameter of frame"
);
1746 return Qnil
; /* not reached, shut compiler up */
1750 DEFUN
("ns
-open
-connection"
, Fns_open_connection
, Sns_open_connection
,
1751 1, 3, 0, "Open a connection to a NS server.
\n\
1752 DISPLAY is the name of the display to connect to.
\n\
1753 Optional arguments XRM
-STRING and MUST
-SUCCEED are currently ignored."
)
1754 (display
, resource_string
, must_succeed
)
1755 Lisp_Object display
, resource_string
, must_succeed
;
1757 struct ns_display_info
*dpyinfo
;
1759 CHECK_STRING
(display
);
1761 nxatoms_of_nsselect
();
1762 dpyinfo
= ns_term_init
(display
);
1765 if (!NILP
(must_succeed
))
1766 fatal
("OpenStep on
%s not responding.\n",
1769 error ("OpenStep on
%s not responding.\n",
1773 /* Register our external input/output types, used for determining
1774 applicable services and also drag/drop eligibility. */
1775 ns_send_types
= [[NSArray arrayWithObject
: NSStringPboardType
] retain
];
1776 ns_return_types
= [[NSArray arrayWithObject
: NSStringPboardType
] retain
];
1777 ns_drag_types
= [[NSArray arrayWithObjects
:
1779 NSTabularTextPboardType
,
1780 NSFilenamesPboardType
,
1783 NSFontPboardType
, nil
] retain
];
1789 DEFUN
("ns
-close-connection"
, Fns_close_connection
, Sns_close_connection
,
1790 1, 1, 0, "
Close the connection to the current NS server.
\n\
1791 The second argument DISPLAY is currently ignored
, but nil would stand
for\n\
1792 the selected frame
's display.")
1794 Lisp_Object display;
1797 #ifdef NS_IMPL_COCOA
1800 /*ns_delete_terminal (dpyinfo->terminal); */
1801 [NSApp terminate: NSApp];
1806 DEFUN ("ns-display-list", Fns_display_list, Sns_display_list, 0, 0, 0,
1807 "Return the list of display names that Emacs has connections to.")
1810 Lisp_Object tail, result;
1813 for (tail = ns_display_name_list; CONSP (tail); tail = XCDR (tail))
1814 result = Fcons (XCAR (XCAR (tail)), result);
1820 DEFUN ("ns-hide-others", Fns_hide_others, Sns_hide_others,
1821 0, 0, 0, "Hides all applications other than emacs.")
1825 [NSApp hideOtherApplications: NSApp];
1829 DEFUN ("ns-hide-emacs", Fns_hide_emacs, Sns_hide_emacs,
1830 1, 1, 0, "If ON is non-nil, the entire emacs application is hidden.\n\
1831 Otherwise if emacs is hidden, it is unhidden.\n\
1832 If ON is equal to 'activate
, emacs is unhidden and becomes
\n\
1833 the active application."
)
1838 if (EQ
(on
, intern
("activate"
)))
1840 [NSApp unhide
: NSApp
];
1841 [NSApp activateIgnoringOtherApps
: YES
];
1844 [NSApp unhide
: NSApp
];
1846 [NSApp hide
: NSApp
];
1851 DEFUN
("ns
-emacs
-info-panel"
, Fns_emacs_info_panel
, Sns_emacs_info_panel
,
1852 0, 0, 0, "Shows the
'Info' or
'About' panel
for Emacs."
)
1856 [NSApp orderFrontStandardAboutPanel
: nil
];
1861 DEFUN
("x
-list
-fonts"
, Fns_list_fonts
, Sns_list_fonts
, 1, 4, 0,
1862 doc: /* Return a list of the names of available fonts matching PATTERN.
1863 If optional arguments FACE and FRAME are specified, return only fonts
1864 the same size as FACE on FRAME.
1865 If optional argument MAX is specified, return at most MAX matches.
1867 PATTERN is a regular expression; FACE is a face name - a symbol.
1869 The return value is a list of strings, suitable as arguments to
1872 The font names are _NOT_ X names. */)
1873 (pattern
, face
, frame
, max)
1874 Lisp_Object pattern
, face
, frame
, max;
1876 Lisp_Object flist
, olist
= Qnil
, tem
;
1880 /* We can't simply call check_x_frame because this function may be
1881 called before any frame is created. */
1883 f
= SELECTED_FRAME
();
1886 CHECK_LIVE_FRAME
(frame
);
1889 if (! FRAME_WINDOW_P
(f
))
1891 /* Perhaps we have not yet created any frame. */
1900 maxnames
= XFASTINT
(max);
1903 /* get XLFD names */
1904 flist
= ns_list_fonts
(f
, pattern
, 0, maxnames
);
1906 /* convert list into regular names */
1907 for (tem
= flist
; CONSP
(tem
); tem
= XCDR
(tem
))
1909 Lisp_Object fname
= XCAR
(tem
);
1910 olist
= Fcons
(build_string
(ns_xlfd_to_fontname
(SDATA
(fname
))),
1918 DEFUN
("ns
-font
-name"
, Fns_font_name
, Sns_font_name
, 1, 1, 0,
1919 "Determine font postscript or family name from a font name string or
\n\
1920 XLFD string.
If string contains fontset
' and not 'fontset
-startup
' it is\n\
1926 CHECK_STRING (name);
1931 if (strstr (nm, "fontset") && !strstr (nm, "fontset-startup"))
1934 return build_string (ns_xlfd_to_fontname (SDATA (name)));
1938 DEFUN ("ns-list-colors", Fns_list_colors, Sns_list_colors, 0, 1, 0,
1939 "Return a list of all available colors.\n\
1940 The optional argument FRAME is currently ignored.")
1944 Lisp_Object list = Qnil;
1945 NSEnumerator *colorlists;
1950 CHECK_FRAME (frame);
1951 if (! FRAME_NS_P (XFRAME (frame)))
1952 error ("non-NS frame used in `ns-list-colors'"
);
1957 colorlists
= [[NSColorList availableColorLists
] objectEnumerator
];
1958 while (clist
= [colorlists nextObject
])
1960 if ([[clist name
] length] < 7 ||
1961 [[clist name
] rangeOfString
: @"PANTONE"
].location
== 0)
1963 NSEnumerator
*cnames
= [[clist allKeys
] reverseObjectEnumerator
];
1965 while (cname
= [cnames nextObject
])
1966 list
= Fcons
(build_string
([cname UTF8String
]), list
);
1967 /* for (i = [[clist allKeys] count] - 1; i >= 0; i--)
1968 list = Fcons (build_string ([[[clist allKeys] objectAtIndex: i]
1969 UTF8String]), list); */
1979 DEFUN
("ns
-list
-services"
, Fns_list_services
, Sns_list_services
, 0, 0, 0,
1980 "List NS services by querying NSApp."
)
1983 Lisp_Object ret
= Qnil
;
1988 svcs
= [[NSMenu alloc
] initWithTitle
: @"Services"
];
1989 [NSApp setServicesMenu
: svcs
]; /* this and next rebuild on <10.4 */
1990 [NSApp registerServicesMenuSendTypes
: ns_send_types
1991 returnTypes
: ns_return_types
];
1993 /* On Tiger, services menu updating was made lazier (waits for user to
1994 actually click on the menu), so we have to force things along: */
1995 #ifdef NS_IMPL_COCOA
1996 if (NSAppKitVersionNumber
>= 744.0)
1998 delegate
= [svcs delegate
];
1999 if (delegate
!= nil
)
2001 if ([delegate respondsToSelector
: @selector
(menuNeedsUpdate
:)])
2002 [delegate menuNeedsUpdate
: svcs
];
2003 if ([delegate respondsToSelector
:
2004 @selector
(menu:updateItem
:atIndex
:shouldCancel
:)])
2006 int i
, len
= [delegate numberOfItemsInMenu
: svcs
];
2007 for (i
=0; i
<len
; i
++)
2008 [svcs addItemWithTitle
: @"" action
: NULL keyEquivalent
: @""
];
2009 for (i
=0; i
<len
; i
++)
2010 if (![delegate
menu: svcs
2011 updateItem
: (NSMenuItem
*)[svcs itemAtIndex
: i
]
2012 atIndex
: i shouldCancel
: NO
])
2019 [svcs setAutoenablesItems
: NO
];
2020 #ifdef NS_IMPL_COCOA
2021 [svcs update
]; /* on OS X, converts from '/' structure */
2024 ret
= interpret_services_menu
(svcs
, Qnil
, ret
);
2029 DEFUN
("ns
-perform
-service"
, Fns_perform_service
, Sns_perform_service
,
2030 2, 2, 0, "Perform NS SERVICE on SEND
which is either a string or nil.
\n\
2031 Returns result of service as string or nil
if no result."
)
2033 Lisp_Object service
, send
;
2040 CHECK_STRING
(service
);
2043 utfStr
= SDATA
(service
);
2044 svcName
= [NSString stringWithUTF8String
: utfStr
];
2046 pb
=[NSPasteboard pasteboardWithUniqueName
];
2047 ns_string_to_pasteboard
(pb
, send
);
2049 if (NSPerformService
(svcName
, pb
) == NO
)
2050 Fsignal
(Qquit
, Fcons
(build_string
("service not available"
), Qnil
));
2052 if ([[pb types
] count
] == 0)
2053 return build_string
(""
);
2054 return ns_string_from_pasteboard
(pb
);
2058 DEFUN
("ns
-convert
-utf8
-nfd
-to
-nfc"
, Fns_convert_utf8_nfd_to_nfc
,
2059 Sns_convert_utf8_nfd_to_nfc
, 1, 1, 0,
2060 "Composes character sequences in UTF
-8 normal form NFD string STR to produce a normal
(composed normal form NFC
) string."
)
2067 utfStr
= [[NSString stringWithUTF8String
: SDATA
(str
)]
2068 precomposedStringWithCanonicalMapping
];
2069 return build_string
([utfStr UTF8String
]);
2073 /* ==========================================================================
2075 Miscellaneous functions not called through hooks
2077 ========================================================================== */
2080 /* 23: call in image.c */
2082 check_x_frame
(Lisp_Object frame
)
2084 return check_ns_frame
(frame
);
2087 /* 23: added, due to call in frame.c */
2088 struct ns_display_info
*
2089 check_x_display_info
(Lisp_Object frame
)
2091 return check_ns_display_info
(frame
);
2095 /* 23: new function; we don't have much in the way of flexibility though */
2097 x_set_scroll_bar_default_width
(f
)
2100 int wid
= FRAME_COLUMN_WIDTH
(f
);
2101 FRAME_CONFIG_SCROLL_BAR_WIDTH
(f
) = NS_SCROLL_BAR_WIDTH_DEFAULT
;
2102 FRAME_CONFIG_SCROLL_BAR_COLS
(f
) = (FRAME_CONFIG_SCROLL_BAR_WIDTH
(f
) +
2107 /* 23: terms now impl this instead of x-get-resource directly */
2109 x_get_string_resource
(XrmDatabase rdb
, char *name
, char *class)
2111 /* remove appname prefix; TODO: allow for !="Emacs" */
2112 char *toCheck
= class + (!strncmp
(class, "Emacs."
, 6) ?
6 : 0);
2116 /* Support emacs-20-style face resources for backwards compatibility */
2117 if (!strncmp
(toCheck
, "Face"
, 4))
2118 toCheck
= name
+ (!strncmp
(name
, "emacs."
, 6) ?
6 : 0);
2120 /*fprintf (stderr, "Checking '%s'\n", toCheck); */
2122 res
= [[[NSUserDefaults standardUserDefaults
] objectForKey
:
2123 [NSString stringWithUTF8String
: toCheck
]] UTF8String
];
2124 return !res ?
NULL :
2125 (!strncasecmp
(res
, "YES"
, 3) ? "true"
:
2126 (!strncasecmp
(res
, "NO"
, 2) ? "false"
: res
));
2131 x_get_focus_frame
(struct frame
*frame
)
2133 struct ns_display_info
*dpyinfo
= FRAME_NS_DISPLAY_INFO
(frame
);
2134 Lisp_Object nsfocus
;
2136 if (!dpyinfo
->ns_focus_frame
)
2139 XSETFRAME
(nsfocus
, dpyinfo
->ns_focus_frame
);
2145 x_pixel_width
(struct frame
*f
)
2147 return FRAME_PIXEL_WIDTH
(f
);
2152 x_pixel_height
(struct frame
*f
)
2154 return FRAME_PIXEL_HEIGHT
(f
);
2159 x_char_width
(struct frame
*f
)
2161 return FRAME_COLUMN_WIDTH
(f
);
2166 x_char_height
(struct frame
*f
)
2168 return FRAME_LINE_HEIGHT
(f
);
2173 x_screen_planes
(struct frame
*f
)
2175 return FRAME_NS_DISPLAY_INFO
(f
)->n_planes
;
2180 x_sync
(Lisp_Object frame
)
2182 /* XXX Not implemented XXX */
2188 /* ==========================================================================
2190 Lisp definitions that, for whatever reason, we can't alias as 'ns-XXX'.
2192 ========================================================================== */
2195 DEFUN
("xw
-color
-defined
-p"
, Fns_color_defined_p
, Sns_color_defined_p
, 1, 2, 0,
2196 "
Return t
if the current NS display supports the color named COLOR.
\n\
2197 The optional argument FRAME is currently ignored."
)
2199 Lisp_Object color
, frame
;
2203 return ns_lisp_to_color
(color
, &col
) ? Qnil
: Qt
;
2207 DEFUN
("xw
-color
-values"
, Fns_color_values
, Sns_color_values
, 1, 2, 0,
2208 "
Return a description of the color named COLOR.
\n\
2209 The value is a list of integer RGBA values
--(RED GREEN BLUE ALPHA
).
\n\
2210 These values appear to range from
0 to
65280; white is
(65280 65280 65280 0).
\n\
2211 The optional argument FRAME is currently ignored."
)
2213 Lisp_Object color
, frame
;
2216 float red
, green
, blue
, alpha
;
2217 Lisp_Object rgba
[4];
2220 CHECK_STRING
(color
);
2222 if (ns_lisp_to_color
(color
, &col
))
2225 [[col colorUsingColorSpaceName
: NSCalibratedRGBColorSpace
]
2226 getRed
: &red green
: &green blue
: &blue alpha
: &alpha
];
2227 rgba
[0] = make_number
(lrint
(red
*65280));
2228 rgba
[1] = make_number
(lrint
(green
*65280));
2229 rgba
[2] = make_number
(lrint
(blue
*65280));
2230 rgba
[3] = make_number
(lrint
(alpha
*65280));
2232 return Flist
(4, rgba
);
2236 DEFUN
("xw
-display
-color
-p"
, Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
2237 "
Return t
if the NS display supports color.
\n\
2238 The optional argument DISPLAY specifies
which display to ask about.
\n\
2239 DISPLAY should be either a frame
, a display name
(a string
), or
terminal ID.
\n\
2240 If omitted or nil
, that stands
for the selected frame
's display.")
2242 Lisp_Object display;
2244 NSWindowDepth depth;
2245 NSString *colorSpace;
2247 depth = [ns_get_screen (display) depth];
2248 colorSpace = NSColorSpaceFromDepth (depth);
2250 return [colorSpace isEqualToString: NSDeviceWhiteColorSpace]
2251 || [colorSpace isEqualToString: NSCalibratedWhiteColorSpace]
2256 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p,
2257 Sx_display_grayscale_p, 0, 1, 0,
2258 "Return t if the NS display supports shades of gray.\n\
2259 Note that color displays do support shades of gray.\n\
2260 The optional argument DISPLAY specifies which display to ask about.\n\
2261 DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\
2262 If omitted or nil, that stands for the selected frame's display."
)
2264 Lisp_Object display
;
2266 NSWindowDepth depth
;
2268 depth
= [ns_get_screen
(display
) depth
];
2270 return NSBitsPerPixelFromDepth
(depth
) > 1 ? Qt
: Qnil
;
2274 DEFUN
("x
-display
-pixel
-width"
, Fns_display_pixel_width
, Sns_display_pixel_width
,
2276 "Returns the width in pixels of the NS display DISPLAY.
\n\
2277 The optional argument DISPLAY specifies
which display to ask about.
\n\
2278 DISPLAY should be either a frame
, a display name
(a string
), or
terminal ID.
\n\
2279 If omitted or nil
, that stands
for the selected frame
's display.")
2281 Lisp_Object display;
2284 return make_number ((int) [ns_get_screen (display) frame].size.width);
2288 DEFUN ("x-display-pixel-height", Fns_display_pixel_height,
2289 Sns_display_pixel_height, 0, 1, 0,
2290 "Returns the height in pixels of the NS display DISPLAY.\n\
2291 The optional argument DISPLAY specifies which display to ask about.\n\
2292 DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\
2293 If omitted or nil, that stands for the selected frame's display."
)
2295 Lisp_Object display
;
2298 return make_number
((int
) [ns_get_screen
(display
) frame
].
size.height
);
2301 DEFUN
("display
-usable
-bounds"
, Fns_display_usable_bounds
,
2302 Sns_display_usable_bounds
, 0, 1, 0,
2303 "Returns a list of integers in form
(left top width height
) describing the \
2304 usable screen area excluding reserved areas such as the Mac
menu and
doc, or \
2305 the Windows task
bar.
\n \
2306 The optional argument DISPLAY specifies
which display to ask about.
\n\
2307 DISPLAY should be either a frame
, a display name
(a string
), or
terminal ID.
\n\
2308 If omitted or nil
, that stands
for the selected frame
's display.")
2310 Lisp_Object display;
2316 vScreen = [ns_get_screen (display) visibleFrame];
2317 top = vScreen.origin.y == 0.0 ?
2318 (int) [ns_get_screen (display) frame].size.height - vScreen.size.height : 0;
2320 return list4 (make_number ((int) vScreen.origin.x),
2322 make_number ((int) vScreen.size.width),
2323 make_number ((int) vScreen.size.height));
2327 DEFUN ("x-display-planes", Fx_display_planes, Sns_display_planes,
2329 "Returns the number of bitplanes of the NS display DISPLAY.\n\
2330 The optional argument DISPLAY specifies which display to ask about.\n\
2331 DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\
2332 If omitted or nil, that stands for the selected frame's display."
)
2334 Lisp_Object display
;
2338 (NSBitsPerSampleFromDepth
([ns_get_screen
(display
) depth
]));
2342 DEFUN
("x
-display
-color
-cells"
, Fns_display_color_cells
,
2343 Sns_display_color_cells
, 0, 1, 0,
2344 "Returns the number of color cells of the NS display DISPLAY.
\n\
2345 The optional argument DISPLAY specifies
which display to ask about.
\n\
2346 DISPLAY should be either a frame
, a display name
(a string
), or
terminal ID.
\n\
2347 If omitted or nil
, that stands
for the selected frame
's display.")
2349 Lisp_Object display;
2352 struct ns_display_info *dpyinfo = check_ns_display_info (display);
2354 /* We force 24+ bit depths to 24-bit to prevent an overflow. */
2355 return make_number (1 << min (dpyinfo->n_planes, 24));
2359 /* Unused dummy def needed for compatibility. */
2360 Lisp_Object tip_frame;
2362 /* TODO: move to xdisp or similar */
2364 compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y)
2366 Lisp_Object parms, dx, dy;
2368 int *root_x, *root_y;
2370 Lisp_Object left, top;
2371 EmacsView *view = FRAME_NS_VIEW (f);
2374 /* Start with user-specified or mouse position. */
2375 left = Fcdr (Fassq (Qleft, parms));
2376 if (INTEGERP (left))
2379 pt.x = last_mouse_motion_position.x;
2380 top = Fcdr (Fassq (Qtop, parms));
2384 pt.y = last_mouse_motion_position.y;
2386 /* Convert to screen coordinates */
2387 pt = [view convertPoint: pt toView: nil];
2388 pt = [[view window] convertBaseToScreen: pt];
2390 /* Ensure in bounds. (Note, screen origin = lower left.) */
2391 if (pt.x + XINT (dx) <= 0)
2392 *root_x = 0; /* Can happen for negative dx */
2393 else if (pt.x + XINT (dx) + width <= FRAME_NS_DISPLAY_INFO (f)->width)
2394 /* It fits to the right of the pointer. */
2395 *root_x = pt.x + XINT (dx);
2396 else if (width + XINT (dx) <= pt.x)
2397 /* It fits to the left of the pointer. */
2398 *root_x = pt.x - width - XINT (dx);
2400 /* Put it left justified on the screen -- it ought to fit that way. */
2403 if (pt.y - XINT (dy) - height >= 0)
2404 /* It fits below the pointer. */
2405 *root_y = pt.y - height - XINT (dy);
2406 else if (pt.y + XINT (dy) + height <= FRAME_NS_DISPLAY_INFO (f)->height)
2407 /* It fits above the pointer */
2408 *root_y = pt.y + XINT (dy);
2410 /* Put it on the top. */
2411 *root_y = FRAME_NS_DISPLAY_INFO (f)->height - height;
2415 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
2416 doc: /* Show STRING in a "tooltip" window on frame FRAME.
2417 A tooltip window is a small window displaying a string.
2419 FRAME nil or omitted means use the selected frame.
2421 PARMS is an optional list of frame parameters which can be used to
2422 change the tooltip's appearance.
2424 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
2425 means use the default timeout of
5 seconds.
2427 If the list of frame parameters PARMS contains a `left
' parameter,
2428 the tooltip is displayed at that x-position. Otherwise it is
2429 displayed at the mouse position, with offset DX added (default is 5 if
2430 DX isn't specified
). Likewise
for the y
-position
; if a `top
' frame
2431 parameter is specified, it determines the y-position of the tooltip
2432 window, otherwise it is displayed at the mouse position, with offset
2433 DY added (default is -10).
2435 A tooltip's maximum
size is specified by `x
-max-tooltip
-size'.
2436 Text larger than the specified size is clipped. */)
2437 (string, frame, parms, timeout, dx, dy)
2438 Lisp_Object string, frame, parms, timeout, dx, dy;
2441 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2442 int count = SPECPDL_INDEX ();
2447 specbind (Qinhibit_redisplay, Qt);
2449 GCPRO4 (string, parms, frame, timeout);
2451 CHECK_STRING (string);
2452 str = SDATA (string);
2453 f = check_x_frame (frame);
2455 timeout = make_number (5);
2457 CHECK_NATNUM (timeout);
2460 dx = make_number (5);
2465 dy = make_number (-10);
2470 if (ns_tooltip == nil)
2471 ns_tooltip = [[EmacsTooltip alloc] init];
2475 [ns_tooltip setText: str];
2476 size = [ns_tooltip frame].size;
2478 /* Move the tooltip window where the mouse pointer is. Resize and
2480 compute_tip_xy (f, parms, dx, dy, (int)size.width, (int)size.height,
2483 [ns_tooltip showAtX: root_x Y: root_y for: XINT (timeout)];
2487 return unbind_to (count, Qnil);
2491 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
2492 doc: /* Hide the current tooltip window, if there is any.
2493 Value is t if tooltip was open, nil otherwise. */)
2496 if (ns_tooltip == nil || ![ns_tooltip isActive])
2503 /* ==========================================================================
2505 Lisp interface declaration
2507 ========================================================================== */
2515 Qns_frame_parameter = intern ("ns-frame-parameter");
2516 staticpro (&Qns_frame_parameter);
2517 Qnone = intern ("none");
2519 Qbuffered = intern ("bufferd");
2520 staticpro (&Qbuffered);
2521 Qfontsize = intern ("fontsize");
2522 staticpro (&Qfontsize);
2524 DEFVAR_LISP ("ns-icon-type-alist", &Vns_icon_type_alist,
2525 "Alist of elements (REGEXP . IMAGE) for images of icons associated to\n\
2526 frames. If the title of a frame matches REGEXP, then IMAGE.tiff is\n\
2527 selected as the image of the icon representing the frame when it's
\n\
2528 miniaturized.
If an element is t
, then Emacs tries to select an icon
\n\
2529 based on the filetype of the visited file.
\n\
2531 The images have to be installed in a folder called English.lproj in the
\n\
2532 Emacs.app folder. You have to restart Emacs after installing new icons.
\n\
2534 Example
: Install an icon Gnus.tiff and execute the following code
\n\
2536 (setq ns
-icon
-type-alist
\n\
2537 (append ns
-icon
-type-alist
\n\
2538 '((\"^\\\\*\\\\(Group\\\\*$\\\\|Summary \\\\|Article\\\\*$\\\\)\"\n\
2541 When you miniaturize a Group, Summary or Article frame, Gnus.tiff will\n\
2542 be used as the image of the icon representing the frame.");
2543 Vns_icon_type_alist = Fcons (Qt, Qnil);
2545 defsubr (&Sns_read_file_name);
2546 defsubr (&Sns_get_resource);
2547 defsubr (&Sns_set_resource);
2548 defsubr (&Sxw_display_color_p); /* this and next called directly by C code */
2549 defsubr (&Sx_display_grayscale_p);
2550 defsubr (&Sns_list_fonts);
2551 defsubr (&Sns_font_name);
2552 defsubr (&Sns_list_colors);
2553 defsubr (&Sns_color_defined_p);
2554 defsubr (&Sns_color_values);
2555 defsubr (&Sns_server_max_request_size);
2556 defsubr (&Sns_server_vendor);
2557 defsubr (&Sns_server_version);
2558 defsubr (&Sns_display_pixel_width);
2559 defsubr (&Sns_display_pixel_height);
2560 defsubr (&Sns_display_usable_bounds);
2561 defsubr (&Sns_display_mm_width);
2562 defsubr (&Sns_display_mm_height);
2563 defsubr (&Sns_display_screens);
2564 defsubr (&Sns_display_planes);
2565 defsubr (&Sns_display_color_cells);
2566 defsubr (&Sns_display_visual_class);
2567 defsubr (&Sns_display_backing_store);
2568 defsubr (&Sns_display_save_under);
2569 defsubr (&Sns_create_frame);
2570 defsubr (&Sns_set_alpha);
2571 defsubr (&Sns_open_connection);
2572 defsubr (&Sns_close_connection);
2573 defsubr (&Sns_display_list);
2575 defsubr (&Sns_hide_others);
2576 defsubr (&Sns_hide_emacs);
2577 defsubr (&Sns_emacs_info_panel);
2578 defsubr (&Sns_list_services);
2579 defsubr (&Sns_perform_service);
2580 defsubr (&Sns_convert_utf8_nfd_to_nfc);
2581 defsubr (&Sns_focus_frame);
2582 defsubr (&Sns_popup_prefs_panel);
2583 defsubr (&Sns_popup_font_panel);
2584 defsubr (&Sns_popup_color_panel);
2586 defsubr (&Sx_show_tip);
2587 defsubr (&Sx_hide_tip);
2589 /* used only in fontset.c */
2590 check_window_system_func = check_ns;
2596 /* ==========================================================================
2598 Class implementations
2600 ========================================================================== */
2603 @implementation EmacsSavePanel
2604 #ifdef NS_IMPL_COCOA
2605 /* --------------------------------------------------------------------------
2606 These are overridden to intercept on OS X: ending panel restarts NSApp
2607 event loop if it is stopped. Not sure if this is correct behavior,
2608 perhaps should check if running and if so send an appdefined.
2609 -------------------------------------------------------------------------- */
2610 - (void) ok: (id)sender
2616 - (void) cancel: (id)sender
2618 [super cancel: sender];
2625 @implementation EmacsOpenPanel
2626 #ifdef NS_IMPL_COCOA
2627 /* --------------------------------------------------------------------------
2628 These are overridden to intercept on OS X: ending panel restarts NSApp
2629 event loop if it is stopped. Not sure if this is correct behavior,
2630 perhaps should check if running and if so send an appdefined.
2631 -------------------------------------------------------------------------- */
2632 - (void) ok: (id)sender
2638 - (void) cancel: (id)sender
2640 [super cancel: sender];
2647 @implementation EmacsFileDelegate
2648 /* --------------------------------------------------------------------------
2649 Delegate methods for Open/Save panels
2650 -------------------------------------------------------------------------- */
2651 - (BOOL)panel: (id)sender isValidFilename: (NSString *)filename
2655 - (BOOL)panel: (id)sender shouldShowFilename: (NSString *)filename
2659 - (NSString *)panel: (id)sender userEnteredFilename: (NSString *)filename
2660 confirmed: (BOOL)okFlag
2668 // arch-tag: dc2a3f74-1123-4daa-8eed-fb78db6a5642