/* Graphical user interface functions for the Microsoft W32 API.
- Copyright (C) 1989, 92, 93, 94, 95, 1996, 1997, 1998, 1999
+ Copyright (C) 1989, 92, 93, 94, 95, 1996, 1997, 1998, 1999, 2000, 2001
Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "charset.h"
#include "dispextern.h"
#include "w32term.h"
+#include "keyboard.h"
#include "frame.h"
#include "window.h"
#include "buffer.h"
#include "fontset.h"
#include "intervals.h"
-#include "keyboard.h"
#include "blockinput.h"
#include "epaths.h"
#include "w32heap.h"
/* Non nil if no window manager is in use. */
Lisp_Object Vx_no_window_manager;
-/* Non-zero means we're allowed to display a busy cursor. */
+/* Non-zero means we're allowed to display a hourglass pointer. */
-int display_busy_cursor_p;
+int display_hourglass_p;
/* The background and shape of the mouse pointer, and shape when not
over text or in the modeline. */
Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
-Lisp_Object Vx_busy_pointer_shape;
+Lisp_Object Vx_hourglass_pointer_shape, Vx_window_horizontal_drag_shape;
/* The shape when over mouse-sensitive text. */
#define VIETNAMESE_CHARSET 163
#endif
-
-/* Evaluate this expression to rebuild the section of syms_of_w32fns
- that initializes and staticpros the symbols declared below. Note
- that Emacs 18 has a bug that keeps C-x C-e from being able to
- evaluate this expression.
-
-(progn
- ;; Accumulate a list of the symbols we want to initialize from the
- ;; declarations at the top of the file.
- (goto-char (point-min))
- (search-forward "/\*&&& symbols declared here &&&*\/\n")
- (let (symbol-list)
- (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
- (setq symbol-list
- (cons (buffer-substring (match-beginning 1) (match-end 1))
- symbol-list))
- (forward-line 1))
- (setq symbol-list (nreverse symbol-list))
- ;; Delete the section of syms_of_... where we initialize the symbols.
- (search-forward "\n /\*&&& init symbols here &&&*\/\n")
- (let ((start (point)))
- (while (looking-at "^ Q")
- (forward-line 2))
- (kill-region start (point)))
- ;; Write a new symbol initialization section.
- (while symbol-list
- (insert (format " %s = intern (\"" (car symbol-list)))
- (let ((start (point)))
- (insert (substring (car symbol-list) 1))
- (subst-char-in-region start (point) ?_ ?-))
- (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
- (setq symbol-list (cdr symbol-list)))))
-
- */
-
-/*&&& symbols declared here &&&*/
Lisp_Object Qauto_raise;
Lisp_Object Qauto_lower;
Lisp_Object Qbar;
Lisp_Object Qscreen_gamma;
Lisp_Object Qline_spacing;
Lisp_Object Qcenter;
+Lisp_Object Qcancel_timer;
Lisp_Object Qhyper;
Lisp_Object Qsuper;
Lisp_Object Qmeta;
Lisp_Object Qw32_charset_default;
Lisp_Object Qw32_charset_symbol;
Lisp_Object Qw32_charset_shiftjis;
-Lisp_Object Qw32_charset_hangul;
+Lisp_Object Qw32_charset_hangeul;
Lisp_Object Qw32_charset_gb2312;
Lisp_Object Qw32_charset_chinesebig5;
Lisp_Object Qw32_charset_oem;
Lisp_Object Qw32_charset_arabic;
Lisp_Object Qw32_charset_greek;
Lisp_Object Qw32_charset_hebrew;
+Lisp_Object Qw32_charset_vietnamese;
Lisp_Object Qw32_charset_thai;
Lisp_Object Qw32_charset_johab;
Lisp_Object Qw32_charset_mac;
Lisp_Object Qface_set_after_frame_default;
+#ifdef GLYPH_DEBUG
+int image_cache_refcount, dpyinfo_refcount;
+#endif
+
+
/* From w32term.c. */
extern Lisp_Object Vw32_num_mouse_buttons;
extern Lisp_Object Vw32_recognize_altgr;
f = XFRAME (frame);
if (!FRAME_W32_P (f) || FRAME_W32_DISPLAY_INFO (f) != dpyinfo)
continue;
- if (f->output_data.w32->busy_window == wdesc)
+ if (f->output_data.w32->hourglass_window == wdesc)
return f;
- /* NTEMACS_TODO: Check tooltips when supported. */
+ /* TODO: Check tooltips when supported. */
if (FRAME_W32_WINDOW (f) == wdesc)
return f;
}
Lisp_Object file;
{
return -1;
-#if 0 /* NTEMACS_TODO : bitmap support */
+#if 0 /* TODO : bitmap support */
struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
unsigned int width, height;
HBITMAP bitmap;
fd = openp (Vx_bitmap_file_path, file, "", &found, 0);
if (fd < 0)
return -1;
- /* LoadLibraryEx won't handle special files handled by Emacs handler. */
- if (fd == 0)
- return -1;
emacs_close (fd);
filename = (char *) XSTRING (found)->data;
strcpy (dpyinfo->bitmaps[id - 1].file, XSTRING (file)->data);
return id;
-#endif /* NTEMACS_TODO */
+#endif /* TODO */
}
/* Remove reference to bitmap with id number ID. */
void (*setter) P_ ((struct frame *, Lisp_Object, Lisp_Object));
};
-/* NTEMACS_TODO: Native Input Method support; see x_create_im. */
+static Lisp_Object unwind_create_frame P_ ((Lisp_Object));
+static Lisp_Object unwind_create_tip_frame P_ ((Lisp_Object));
+static void x_change_window_heights P_ ((Lisp_Object, int));
+/* TODO: Native Input Method support; see x_create_im. */
void x_set_foreground_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
static void x_set_line_spacing P_ ((struct frame *, Lisp_Object, Lisp_Object));
void x_set_background_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
x_to_w32_color (colorname)
char * colorname;
{
- register Lisp_Object tail, ret = Qnil;
-
+ register Lisp_Object ret = Qnil;
+
BLOCK_INPUT;
if (colorname[0] == '#')
struct frame *f;
Lisp_Object arg, oldval;
{
-
Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
int count;
int mask_color;
&& mask_color == FRAME_BACKGROUND_PIXEL (f))
f->output_data.w32->mouse_pixel = FRAME_FOREGROUND_PIXEL (f);
-#if 0 /* NTEMACS_TODO : cursor changes */
+#if 0 /* TODO : cursor changes */
BLOCK_INPUT;
/* It's not okay to crash if the user selects a screwy cursor. */
nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_left_ptr);
x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
- if (!EQ (Qnil, Vx_busy_pointer_shape))
+ if (!EQ (Qnil, Vx_hourglass_pointer_shape))
{
- CHECK_NUMBER (Vx_busy_pointer_shape, 0);
- busy_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
- XINT (Vx_busy_pointer_shape));
+ CHECK_NUMBER (Vx_hourglass_pointer_shape, 0);
+ hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
+ XINT (Vx_hourglass_pointer_shape));
}
else
- busy_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_watch);
+ hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_watch);
x_check_errors (FRAME_W32_DISPLAY (f), "bad busy pointer cursor: %s");
x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
else
cross_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_crosshair);
+ if (!NILP (Vx_window_horizontal_drag_shape))
+ {
+ CHECK_NUMBER (Vx_window_horizontal_drag_shape, 0);
+ horizontal_drag_cursor
+ = XCreateFontCursor (FRAME_X_DISPLAY (f),
+ XINT (Vx_window_horizontal_drag_shape));
+ }
+ else
+ horizontal_drag_cursor
+ = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_sb_h_double_arrow);
+
/* Check and report errors with the above calls. */
x_check_errors (FRAME_W32_DISPLAY (f), "can't set cursor shape: %s");
x_uncatch_errors (FRAME_W32_DISPLAY (f), count);
&fore_color, &back_color);
XRecolorCursor (FRAME_W32_DISPLAY (f), cross_cursor,
&fore_color, &back_color);
- XRecolorCursor (FRAME_W32_DISPLAY (f), busy_cursor,
+ XRecolorCursor (FRAME_W32_DISPLAY (f), hourglass_cursor,
&fore_color, &back_color);
}
XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->nontext_cursor);
f->output_data.w32->nontext_cursor = nontext_cursor;
- if (busy_cursor != f->output_data.w32->busy_cursor
- && f->output_data.w32->busy_cursor != 0)
- XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->busy_cursor);
- f->output_data.w32->busy_cursor = busy_cursor;
+ if (hourglass_cursor != f->output_data.w32->hourglass_cursor
+ && f->output_data.w32->hourglass_cursor != 0)
+ XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->hourglass_cursor);
+ f->output_data.w32->hourglass_cursor = hourglass_cursor;
if (mode_cursor != f->output_data.w32->modeline_cursor
&& f->output_data.w32->modeline_cursor != 0)
UNBLOCK_INPUT;
update_face_from_frame_parameter (f, Qmouse_color, arg);
-#endif /* NTEMACS_TODO */
+#endif /* TODO */
}
+/* Defined in w32term.c. */
+void x_update_cursor (struct frame *f, int on_p);
+
void
x_set_cursor_color (f, arg, oldval)
struct frame *f;
Lisp_Object arg, oldval;
{
- unsigned long fore_pixel;
+ unsigned long fore_pixel, pixel;
if (!NILP (Vx_cursor_fore_pixel))
fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
- WHITE_PIX_DEFAULT (f));
+ WHITE_PIX_DEFAULT (f));
else
fore_pixel = FRAME_BACKGROUND_PIXEL (f);
- f->output_data.w32->cursor_pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
+
+ pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
/* Make sure that the cursor color differs from the background color. */
- if (f->output_data.w32->cursor_pixel == FRAME_BACKGROUND_PIXEL (f))
+ if (pixel == FRAME_BACKGROUND_PIXEL (f))
{
- f->output_data.w32->cursor_pixel = f->output_data.w32->mouse_pixel;
- if (f->output_data.w32->cursor_pixel == fore_pixel)
+ pixel = f->output_data.w32->mouse_pixel;
+ if (pixel == fore_pixel)
fore_pixel = FRAME_BACKGROUND_PIXEL (f);
}
+
FRAME_FOREGROUND_PIXEL (f) = fore_pixel;
+ f->output_data.w32->cursor_pixel = pixel;
if (FRAME_W32_WINDOW (f) != 0)
{
if (FRAME_VISIBLE_P (f))
{
- x_display_cursor (f, 0);
- x_display_cursor (f, 1);
+ x_update_cursor (f, 0);
+ x_update_cursor (f, 1);
}
}
struct frame *f;
Lisp_Object arg, oldval;
{
- int result;
-
if (STRINGP (arg))
{
if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
error ("The characters of the given font have varying widths");
else if (STRINGP (result))
{
+ if (!NILP (Fequal (result, oldval)))
+ return;
store_frame_param (f, Qfont, result);
recompute_basic_faces (f);
}
Fmake_frame_visible (frame);
}
+\f
+/* Change window heights in windows rooted in WINDOW by N lines. */
+
+static void
+x_change_window_heights (window, n)
+ Lisp_Object window;
+ int n;
+{
+ struct window *w = XWINDOW (window);
+
+ XSETFASTINT (w->top, XFASTINT (w->top) + n);
+ XSETFASTINT (w->height, XFASTINT (w->height) - n);
+
+ if (INTEGERP (w->orig_top))
+ XSETFASTINT (w->orig_top, XFASTINT (w->orig_top) + n);
+ if (INTEGERP (w->orig_height))
+ XSETFASTINT (w->orig_height, XFASTINT (w->orig_height) - n);
+
+ /* Handle just the top child in a vertical split. */
+ if (!NILP (w->vchild))
+ x_change_window_heights (w->vchild, n);
+
+ /* Adjust all children in a horizontal split. */
+ for (window = w->hchild; !NILP (window); window = w->next)
+ {
+ w = XWINDOW (window);
+ x_change_window_heights (window, n);
+ }
+}
+
void
x_set_menu_bar_lines (f, value, oldval)
struct frame *f;
struct frame *f;
Lisp_Object value, oldval;
{
- int delta, nlines;
+ int delta, nlines, root_height;
+ Lisp_Object root_window;
+
+ /* Treat tool bars like menu bars. */
+ if (FRAME_MINIBUF_ONLY_P (f))
+ return;
/* Use VALUE only if an integer >= 0. */
if (INTEGERP (value) && XINT (value) >= 0)
++windows_or_buffers_changed;
delta = nlines - FRAME_TOOL_BAR_LINES (f);
+
+ /* Don't resize the tool-bar to more than we have room for. */
+ root_window = FRAME_ROOT_WINDOW (f);
+ root_height = XINT (XWINDOW (root_window)->height);
+ if (root_height - delta < 1)
+ {
+ delta = root_height - 1;
+ nlines = FRAME_TOOL_BAR_LINES (f) + delta;
+ }
+
FRAME_TOOL_BAR_LINES (f) = nlines;
- x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
- do_pending_window_change (0);
+ x_change_window_heights (root_window, delta);
adjust_glyphs (f);
+
+ /* We also have to make sure that the internal border at the top of
+ the frame, below the menu bar or tool bar, is redrawn when the
+ tool bar disappears. This is so because the internal border is
+ below the tool bar if one is displayed, but is below the menu bar
+ if there isn't a tool bar. The tool bar draws into the area
+ below the menu bar. */
+ if (FRAME_W32_WINDOW (f) && FRAME_TOOL_BAR_LINES (f) == 0)
+ {
+ updating_frame = f;
+ clear_frame ();
+ clear_current_matrices (f);
+ updating_frame = NULL;
+ }
+
+ /* If the tool bar gets smaller, the internal border below it
+ has to be cleared. It was formerly part of the display
+ of the larger tool bar, and updating windows won't clear it. */
+ if (delta < 0)
+ {
+ int height = FRAME_INTERNAL_BORDER_WIDTH (f);
+ int width = PIXEL_WIDTH (f);
+ int y = nlines * CANON_Y_UNIT (f);
+
+ BLOCK_INPUT;
+ {
+ HDC hdc = get_frame_dc (f);
+ w32_clear_area (f, hdc, 0, y, width, height);
+ release_frame_dc (f, hdc);
+ }
+ UNBLOCK_INPUT;
+ }
}
f->output_data.w32->top_pos = 0;
f->output_data.w32->left_pos = 0;
+ /* Ensure that old new_width and new_height will not override the
+ values set here. */
+ FRAME_NEW_WIDTH (f) = 0;
+ FRAME_NEW_HEIGHT (f) = 0;
+
tem0 = w32_get_arg (parms, Qheight, 0, 0, RES_TYPE_NUMBER);
tem1 = w32_get_arg (parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
tem2 = w32_get_arg (parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
immediate values. */
if (NILP (new_state)
|| (NUMBERP (new_state)
- && (XUINT (new_state)) & 1 != cur_state))
+ && ((XUINT (new_state)) & 1) != cur_state))
{
one_w32_display_info.faked_key = vk_code;
/* Hack to correct bug that allows Emacs frames to be resized
below the Minimum Tracking Size. */
((LPMINMAXINFO) lParam)->ptMinTrackSize.y++;
+ /* Hack to allow resizing the Emacs frame above the screen size.
+ Note that Windows 9x limits coordinates to 16-bits. */
+ ((LPMINMAXINFO) lParam)->ptMaxTrackSize.x = 32767;
+ ((LPMINMAXINFO) lParam)->ptMaxTrackSize.y = 32767;
return 0;
case WM_EMACS_CREATESCROLLBAR:
}
+/* Handler for signals raised during x_create_frame and
+ x_create_top_frame. FRAME is the frame which is partially
+ constructed. */
+
+static Lisp_Object
+unwind_create_frame (frame)
+ Lisp_Object frame;
+{
+ struct frame *f = XFRAME (frame);
+
+ /* If frame is ``official'', nothing to do. */
+ if (!CONSP (Vframe_list) || !EQ (XCAR (Vframe_list), frame))
+ {
+#ifdef GLYPH_DEBUG
+ struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
+#endif
+
+ x_free_frame_resources (f);
+
+ /* Check that reference counts are indeed correct. */
+ xassert (dpyinfo->reference_count == dpyinfo_refcount);
+ xassert (dpyinfo->image_cache->refcount == image_cache_refcount);
+
+ return Qt;
+ }
+
+ return Qnil;
+}
+
+
DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
1, 1, 0,
"Make a new window, which is called a \"frame\" in Emacs terms.\n\
int minibuffer_only = 0;
long window_prompting = 0;
int width, height;
- int count = specpdl_ptr - specpdl;
+ int count = BINDING_STACK_SIZE ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
Lisp_Object display;
struct w32_display_info *dpyinfo = NULL;
f->output_data.w32 =
(struct w32_output *) xmalloc (sizeof (struct w32_output));
bzero (f->output_data.w32, sizeof (struct w32_output));
-
FRAME_FONTSET (f) = -1;
+ record_unwind_protect (unwind_create_frame, frame);
f->icon_name
= w32_get_arg (parms, Qicon_name, "iconName", "Title", RES_TYPE_STRING);
tem = w32_get_arg (parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
f->no_split = minibuffer_only || EQ (tem, Qt);
- /* Create the window. Add the tool-bar height to the initial frame
- height so that the user gets a text display area of the size he
- specified with -g or via the registry. Later changes of the
- tool-bar height don't change the frame size. This is done so that
- users can create tall Emacs frames without having to guess how
- tall the tool-bar will get. */
- f->height += FRAME_TOOL_BAR_LINES (f);
w32_window (f, window_prompting, minibuffer_only);
x_icon (f, parms);
f->height. */
width = f->width;
height = f->height;
+
+ /* Add the tool-bar height to the initial frame height so that the
+ user gets a text display area of the size he specified with -g or
+ via .Xdefaults. Later changes of the tool-bar height don't
+ change the frame size. This is done so that users can create
+ tall Emacs frames without having to guess how tall the tool-bar
+ will get. */
+ if (FRAME_TOOL_BAR_LINES (f))
+ {
+ int margin, relief, bar_height;
+
+ relief = (tool_bar_button_relief > 0
+ ? tool_bar_button_relief
+ : DEFAULT_TOOL_BAR_BUTTON_RELIEF);
+
+ if (INTEGERP (Vtool_bar_button_margin)
+ && XINT (Vtool_bar_button_margin) > 0)
+ margin = XFASTINT (Vtool_bar_button_margin);
+ else if (CONSP (Vtool_bar_button_margin)
+ && INTEGERP (XCDR (Vtool_bar_button_margin))
+ && XINT (XCDR (Vtool_bar_button_margin)) > 0)
+ margin = XFASTINT (XCDR (Vtool_bar_button_margin));
+ else
+ margin = 0;
+
+ bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
+ height += (bar_height + CANON_Y_UNIT (f) - 1) / CANON_Y_UNIT (f);
+ }
+
f->height = 0;
SET_FRAME_WIDTH (f, 0);
change_frame_size (f, height, width, 1, 0, 0);
x_wm_set_size_hint (f, window_prompting, 0);
UNBLOCK_INPUT;
+ /* Set up faces after all frame parameters are known. This call
+ also merges in face attributes specified for new frames. If we
+ don't do this, the `menu' face for instance won't have the right
+ colors, and the menu bar won't appear in the specified colors for
+ new frames. */
+ call1 (Qface_set_after_frame_default, frame);
+
/* Make the window appear on the frame and enable display, unless
the caller says not to. However, with explicit parent, Emacs
cannot control visibility, so don't try. */
;
}
UNGCPRO;
+
+ /* Make sure windows on this frame appear in calls to next-window
+ and similar functions. */
+ Vwindow_list = Qnil;
+
return unbind_to (count, frame);
}
}
\f
+/* Return the charset portion of a font name. */
+char * xlfd_charset_of_font (char * fontname)
+{
+ char *charset, *encoding;
+
+ encoding = strrchr(fontname, '-');
+ if (!encoding || encoding == fontname)
+ return NULL;
+
+ for (charset = encoding - 1; charset >= fontname; charset--)
+ if (*charset == '-')
+ break;
+
+ if (charset == fontname || strcmp(charset, "-*-*") == 0)
+ return NULL;
+
+ return charset + 1;
+}
+
struct font_info *w32_load_bdf_font (struct frame *f, char *fontname,
int size, char* filename);
+static Lisp_Object w32_list_bdf_fonts (Lisp_Object pattern, int max_names);
+static BOOL w32_to_x_font (LOGFONT * lplf, char * lpxstr, int len,
+ char * charset);
+static BOOL x_to_w32_font (char *lpxstr, LOGFONT *lplogfont);
-struct font_info *
+static struct font_info *
w32_load_system_font (f,fontname,size)
struct frame *f;
char * fontname;
/* Load the font and add it to the table. */
{
- char *full_name, *encoding;
+ char *full_name, *encoding, *charset;
XFontStruct *font;
struct font_info *fontp;
LOGFONT lf;
{
HDC hdc;
HANDLE oldobj;
+ int codepage = w32_codepage_for_font (fontname);
hdc = GetDC (dpyinfo->root_window);
oldobj = SelectObject (hdc, font->hfont);
+
ok = GetTextMetrics (hdc, &font->tm);
- font->double_byte_p = GetFontLanguageInfo(hdc) & GCP_DBCS;
+ if (codepage == CP_UNICODE)
+ font->double_byte_p = 1;
+ else
+ font->double_byte_p = GetFontLanguageInfo(hdc) & GCP_DBCS;
+
SelectObject (hdc, oldobj);
ReleaseDC (dpyinfo->root_window, hdc);
/* Fill out details in lf according to the font that was
fontp->name = (char *) xmalloc (strlen (fontname) + 1);
bcopy (fontname, fontp->name, strlen (fontname) + 1);
+ charset = xlfd_charset_of_font (fontname);
+
/* Work out the font's full name. */
full_name = (char *)xmalloc (100);
- if (full_name && w32_to_x_font (&lf, full_name, 100))
+ if (full_name && w32_to_x_font (&lf, full_name, 100, charset))
fontp->full_name = full_name;
else
{
Lisp_Object bdf_fonts;
struct font_info *retval = NULL;
- bdf_fonts = w32_list_bdf_fonts (build_string (fontname));
+ bdf_fonts = w32_list_bdf_fonts (build_string (fontname), 1);
while (!retval && CONSP (bdf_fonts))
{
* )
*/
-LONG
+static LONG
x_to_w32_weight (lpw)
char * lpw;
{
}
-char *
+static char *
w32_to_x_weight (fnweight)
int fnweight;
{
return "*";
}
-LONG
+static LONG
x_to_w32_charset (lpcs)
char * lpcs;
{
- Lisp_Object rest;
+ Lisp_Object this_entry, w32_charset;
/* Look through w32-charset-info-alist for the character set.
Format of each entry is
(CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
*/
- for (rest = Vw32_charset_info_alist; CONSP (rest); rest = XCDR (rest))
- {
- Lisp_Object this_entry = XCAR (rest);
- char * x_charset = XSTRING (XCAR (this_entry))->data;
+ this_entry = Fassoc (build_string(lpcs), Vw32_charset_info_alist);
- if (strnicmp (lpcs, x_charset, strlen(x_charset)) == 0)
- {
- Lisp_Object w32_charset = XCAR (XCDR (this_entry));
- // Translate Lisp symbol to number.
- if (w32_charset == Qw32_charset_ansi)
- return ANSI_CHARSET;
- if (w32_charset == Qw32_charset_symbol)
- return SYMBOL_CHARSET;
- if (w32_charset == Qw32_charset_shiftjis)
- return SHIFTJIS_CHARSET;
- if (w32_charset == Qw32_charset_hangul)
- return HANGEUL_CHARSET;
- if (w32_charset == Qw32_charset_chinesebig5)
- return CHINESEBIG5_CHARSET;
- if (w32_charset == Qw32_charset_gb2312)
- return GB2312_CHARSET;
- if (w32_charset == Qw32_charset_oem)
- return OEM_CHARSET;
+ if (NILP(this_entry))
+ {
+ /* At startup, we want iso8859-1 fonts to come up properly. */
+ if (stricmp(lpcs, "iso8859-1") == 0)
+ return ANSI_CHARSET;
+ else
+ return DEFAULT_CHARSET;
+ }
+
+ w32_charset = Fcar (Fcdr (this_entry));
+
+ // Translate Lisp symbol to number.
+ if (w32_charset == Qw32_charset_ansi)
+ return ANSI_CHARSET;
+ if (w32_charset == Qw32_charset_symbol)
+ return SYMBOL_CHARSET;
+ if (w32_charset == Qw32_charset_shiftjis)
+ return SHIFTJIS_CHARSET;
+ if (w32_charset == Qw32_charset_hangeul)
+ return HANGEUL_CHARSET;
+ if (w32_charset == Qw32_charset_chinesebig5)
+ return CHINESEBIG5_CHARSET;
+ if (w32_charset == Qw32_charset_gb2312)
+ return GB2312_CHARSET;
+ if (w32_charset == Qw32_charset_oem)
+ return OEM_CHARSET;
#ifdef JOHAB_CHARSET
- if (w32_charset == Qw32_charset_johab)
- return JOHAB_CHARSET;
- if (w32_charset == Qw32_charset_easteurope)
- return EASTEUROPE_CHARSET;
- if (w32_charset == Qw32_charset_turkish)
- return TURKISH_CHARSET;
- if (w32_charset == Qw32_charset_baltic)
- return BALTIC_CHARSET;
- if (w32_charset == Qw32_charset_russian)
- return RUSSIAN_CHARSET;
- if (w32_charset == Qw32_charset_arabic)
- return ARABIC_CHARSET;
- if (w32_charset == Qw32_charset_greek)
- return GREEK_CHARSET;
- if (w32_charset == Qw32_charset_hebrew)
- return HEBREW_CHARSET;
- if (w32_charset == Qw32_charset_thai)
- return THAI_CHARSET;
- if (w32_charset == Qw32_charset_mac)
- return MAC_CHARSET;
+ if (w32_charset == Qw32_charset_johab)
+ return JOHAB_CHARSET;
+ if (w32_charset == Qw32_charset_easteurope)
+ return EASTEUROPE_CHARSET;
+ if (w32_charset == Qw32_charset_turkish)
+ return TURKISH_CHARSET;
+ if (w32_charset == Qw32_charset_baltic)
+ return BALTIC_CHARSET;
+ if (w32_charset == Qw32_charset_russian)
+ return RUSSIAN_CHARSET;
+ if (w32_charset == Qw32_charset_arabic)
+ return ARABIC_CHARSET;
+ if (w32_charset == Qw32_charset_greek)
+ return GREEK_CHARSET;
+ if (w32_charset == Qw32_charset_hebrew)
+ return HEBREW_CHARSET;
+ if (w32_charset == Qw32_charset_vietnamese)
+ return VIETNAMESE_CHARSET;
+ if (w32_charset == Qw32_charset_thai)
+ return THAI_CHARSET;
+ if (w32_charset == Qw32_charset_mac)
+ return MAC_CHARSET;
#endif /* JOHAB_CHARSET */
#ifdef UNICODE_CHARSET
- if (w32_charset == Qw32_charset_unicode)
- return UNICODE_CHARSET;
+ if (w32_charset == Qw32_charset_unicode)
+ return UNICODE_CHARSET;
#endif
- }
- }
return DEFAULT_CHARSET;
}
-char *
+static char *
w32_to_x_charset (fncharset)
int fncharset;
{
static char buf[16];
+ Lisp_Object charset_type;
- /* NTEMACS_TODO: use w32-charset-info-alist. Multiple matches
- are possible, so this will require more than just a rewrite of
- this function. w32_to_x_font is the only user of this function,
- and that will require rewriting too, and its users. */
switch (fncharset)
{
- /* ansi is considered iso8859-1, as most modern ansi fonts are. */
- case ANSI_CHARSET: return "iso8859-1";
- case DEFAULT_CHARSET: return "ascii-*";
- case SYMBOL_CHARSET: return "ms-symbol";
- case SHIFTJIS_CHARSET: return "jisx0208-sjis";
- case HANGEUL_CHARSET: return "ksc5601.1987-*";
- case GB2312_CHARSET: return "gb2312-*";
- case CHINESEBIG5_CHARSET: return "big5-*";
- case OEM_CHARSET: return "ms-oem";
+ case ANSI_CHARSET:
+ /* Handle startup case of w32-charset-info-alist not
+ being set up yet. */
+ if (NILP(Vw32_charset_info_alist))
+ return "iso8859-1";
+ charset_type = Qw32_charset_ansi;
+ break;
+ case DEFAULT_CHARSET:
+ charset_type = Qw32_charset_default;
+ break;
+ case SYMBOL_CHARSET:
+ charset_type = Qw32_charset_symbol;
+ break;
+ case SHIFTJIS_CHARSET:
+ charset_type = Qw32_charset_shiftjis;
+ break;
+ case HANGEUL_CHARSET:
+ charset_type = Qw32_charset_hangeul;
+ break;
+ case GB2312_CHARSET:
+ charset_type = Qw32_charset_gb2312;
+ break;
+ case CHINESEBIG5_CHARSET:
+ charset_type = Qw32_charset_chinesebig5;
+ break;
+ case OEM_CHARSET:
+ charset_type = Qw32_charset_oem;
+ break;
/* More recent versions of Windows (95 and NT4.0) define more
character sets. */
#ifdef EASTEUROPE_CHARSET
- case EASTEUROPE_CHARSET: return "iso8859-2";
- case TURKISH_CHARSET: return "iso8859-9";
- case BALTIC_CHARSET: return "iso8859-4";
-
- /* W95 with international support but not IE4 often has the
- KOI8-R codepage but not ISO8859-5. */
+ case EASTEUROPE_CHARSET:
+ charset_type = Qw32_charset_easteurope;
+ break;
+ case TURKISH_CHARSET:
+ charset_type = Qw32_charset_turkish;
+ break;
+ case BALTIC_CHARSET:
+ charset_type = Qw32_charset_baltic;
+ break;
case RUSSIAN_CHARSET:
- if (!IsValidCodePage(28595) && IsValidCodePage(20886))
- return "koi8-r";
- else
- return "iso8859-5";
- case ARABIC_CHARSET: return "iso8859-6";
- case GREEK_CHARSET: return "iso8859-7";
- case HEBREW_CHARSET: return "iso8859-8";
- case VIETNAMESE_CHARSET: return "viscii1.1-*";
- case THAI_CHARSET: return "tis620-*";
- case MAC_CHARSET: return "mac-*";
- case JOHAB_CHARSET: return "ksc5601.1992-*";
-
+ charset_type = Qw32_charset_russian;
+ break;
+ case ARABIC_CHARSET:
+ charset_type = Qw32_charset_arabic;
+ break;
+ case GREEK_CHARSET:
+ charset_type = Qw32_charset_greek;
+ break;
+ case HEBREW_CHARSET:
+ charset_type = Qw32_charset_hebrew;
+ break;
+ case VIETNAMESE_CHARSET:
+ charset_type = Qw32_charset_vietnamese;
+ break;
+ case THAI_CHARSET:
+ charset_type = Qw32_charset_thai;
+ break;
+ case MAC_CHARSET:
+ charset_type = Qw32_charset_mac;
+ break;
+ case JOHAB_CHARSET:
+ charset_type = Qw32_charset_johab;
+ break;
#endif
#ifdef UNICODE_CHARSET
- case UNICODE_CHARSET: return "iso10646-unicode";
+ case UNICODE_CHARSET:
+ charset_type = Qw32_charset_unicode;
+ break;
#endif
+ default:
+ /* Encode numerical value of unknown charset. */
+ sprintf (buf, "*-#%u", fncharset);
+ return buf;
}
- /* Encode numerical value of unknown charset. */
- sprintf (buf, "*-#%u", fncharset);
- return buf;
+
+ {
+ Lisp_Object rest;
+ char * best_match = NULL;
+
+ /* Look through w32-charset-info-alist for the character set.
+ Prefer ISO codepages, and prefer lower numbers in the ISO
+ range. Only return charsets for codepages which are installed.
+
+ Format of each entry is
+ (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
+ */
+ for (rest = Vw32_charset_info_alist; CONSP (rest); rest = XCDR (rest))
+ {
+ char * x_charset;
+ Lisp_Object w32_charset;
+ Lisp_Object codepage;
+
+ Lisp_Object this_entry = XCAR (rest);
+
+ /* Skip invalid entries in alist. */
+ if (!CONSP (this_entry) || !STRINGP (XCAR (this_entry))
+ || !CONSP (XCDR (this_entry))
+ || !SYMBOLP (XCAR (XCDR (this_entry))))
+ continue;
+
+ x_charset = XSTRING (XCAR (this_entry))->data;
+ w32_charset = XCAR (XCDR (this_entry));
+ codepage = XCDR (XCDR (this_entry));
+
+ /* Look for Same charset and a valid codepage (or non-int
+ which means ignore). */
+ if (w32_charset == charset_type
+ && (!INTEGERP (codepage) || codepage == CP_DEFAULT
+ || IsValidCodePage (XINT (codepage))))
+ {
+ /* If we don't have a match already, then this is the
+ best. */
+ if (!best_match)
+ best_match = x_charset;
+ /* If this is an ISO codepage, and the best so far isn't,
+ then this is better. */
+ else if (stricmp (best_match, "iso") != 0
+ && stricmp (x_charset, "iso") == 0)
+ best_match = x_charset;
+ /* If both are ISO8859 codepages, choose the one with the
+ lowest number in the encoding field. */
+ else if (stricmp (best_match, "iso8859-") == 0
+ && stricmp (x_charset, "iso8859-") == 0)
+ {
+ int best_enc = atoi (best_match + 8);
+ int this_enc = atoi (x_charset + 8);
+ if (this_enc > 0 && this_enc < best_enc)
+ best_match = x_charset;
+ }
+ }
+ }
+
+ /* If no match, encode the numeric value. */
+ if (!best_match)
+ {
+ sprintf (buf, "*-#%u", fncharset);
+ return buf;
+ }
+
+ strncpy(buf, best_match, 15);
+ buf[15] = '\0';
+ return buf;
+ }
}
int
w32_codepage_for_font (char *fontname)
{
- Lisp_Object codepage;
- char charset_str[20], *charset, *end;
+ Lisp_Object codepage, entry;
+ char *charset_str, *charset, *end;
- /* Extract charset part of font string. */
- if (sscanf (fontname,
- "-%*[^-]-%*[^-]-%*[^-]-%*[^-]-%*[^-]-%*[^-]-%*[^-]-%*[^-]-%*[^-]-%*[^-]-%*[^-]-%*[^-]-%19s",
- charset_str) < 1)
+ if (NILP (Vw32_charset_info_alist))
return CP_DEFAULT;
+ /* Extract charset part of font string. */
+ charset = xlfd_charset_of_font (fontname);
+
+ if (!charset)
+ return CP_UNKNOWN;
+
+ charset_str = (char *) alloca (strlen (charset));
+ strcpy (charset_str, charset);
+
/* Remove leading "*-". */
if (strncmp ("*-", charset_str, 2) == 0)
charset = charset_str + 2;
*end = '\0';
}
- codepage = Fcdr (Fcdr (Fassoc (build_string(charset),
- Vw32_charset_info_alist)));
- if (INTEGERP (codepage))
+ entry = Fassoc (build_string(charset), Vw32_charset_info_alist);
+ if (NILP (entry))
+ return CP_UNKNOWN;
+
+ codepage = Fcdr (Fcdr (entry));
+
+ if (NILP (codepage))
+ return CP_8BIT;
+ else if (XFASTINT (codepage) == XFASTINT (Qt))
+ return CP_UNICODE;
+ else if (INTEGERP (codepage))
return XINT (codepage);
else
- return CP_DEFAULT;
+ return CP_UNKNOWN;
}
-BOOL
-w32_to_x_font (lplogfont, lpxstr, len)
+static BOOL
+w32_to_x_font (lplogfont, lpxstr, len, specific_charset)
LOGFONT * lplogfont;
char * lpxstr;
int len;
+ char * specific_charset;
{
char* fonttype;
char *fontname;
((lplogfont->lfPitchAndFamily & 0x3) == VARIABLE_PITCH)
? 'p' : 'c', /* spacing */
width_pixels, /* avg width */
- w32_to_x_charset (lplogfont->lfCharSet) /* charset registry
- and encoding*/
+ specific_charset ? specific_charset
+ : w32_to_x_charset (lplogfont->lfCharSet)
+ /* charset registry and encoding */
);
lpxstr[len - 1] = 0; /* just to be sure */
return (TRUE);
}
-BOOL
+static BOOL
x_to_w32_font (lpxstr, lplogfont)
char * lpxstr;
LOGFONT * lplogfont;
fields--;
- if (!NILP (Vw32_enable_synthesized_fonts))
- lplogfont->lfItalic = (fields > 0 && slant == 'i');
+ lplogfont->lfItalic = (fields > 0 && slant == 'i');
fields--;
one from the point height, or if that isn't defined either, return
0 (which usually signifies a scalable font).
*/
-int xlfd_strip_height (char *fontname)
+static int
+xlfd_strip_height (char *fontname)
{
- int pixel_height, point_height, dpi, field_number;
+ int pixel_height, field_number;
char *read_from, *write_to;
xassert (fontname);
*write_to = '-';
write_to++;
}
- /* If the pixel height field is at the end (partial xfld),
+ /* If the pixel height field is at the end (partial xlfd),
return now. */
else
return pixel_height;
}
/* Assume parameter 1 is fully qualified, no wildcards. */
-BOOL
+static BOOL
w32_font_match (fontname, pattern)
char * fontname;
char * pattern;
{
- char *regex = alloca (strlen (pattern) * 2);
+ char *regex = alloca (strlen (pattern) * 2 + 3);
char *font_name_copy = alloca (strlen (fontname) + 1);
char *ptr;
Lisp_Object *tail;
} enumfont_t;
-int CALLBACK
+static int CALLBACK
enum_font_cb2 (lplf, lptm, FontType, lpef)
ENUMLOGFONT * lplf;
NEWTEXTMETRIC * lptm;
{
char buf[100];
Lisp_Object width = Qnil;
+ char *charset = NULL;
/* Truetype fonts do not report their true metrics until loaded */
if (FontType != RASTER_FONTTYPE)
lplf->elfLogFont.lfHeight = -lplf->elfLogFont.lfHeight;
}
- if (!w32_to_x_font (&(lplf->elfLogFont), buf, 100))
+ if (!NILP (*(lpef->pattern)))
+ {
+ charset = xlfd_charset_of_font (XSTRING(*(lpef->pattern))->data);
+
+ /* Ensure that charset is valid for this font. */
+ if (charset
+ && (x_to_w32_charset (charset) != lplf->elfLogFont.lfCharSet))
+ charset = NULL;
+ }
+
+ /* TODO: List all relevant charsets if charset not specified. */
+ if (!w32_to_x_font (&(lplf->elfLogFont), buf, 100, charset))
return (0);
if (NILP (*(lpef->pattern))
return (1);
}
-int CALLBACK
+static int CALLBACK
enum_font_cb1 (lplf, lptm, FontType, lpef)
ENUMLOGFONT * lplf;
NEWTEXTMETRIC * lptm;
}
-int CALLBACK
+static int CALLBACK
enum_fontex_cb2 (lplf, lptm, font_type, lpef)
ENUMLOGFONTEX * lplf;
NEWTEXTMETRICEX * lptm;
font_type, lpef);
}
-int CALLBACK
+static int CALLBACK
enum_fontex_cb1 (lplf, lptm, font_type, lpef)
ENUMLOGFONTEX * lplf;
NEWTEXTMETRICEX * lptm;
/* Interface to fontset handler. (adapted from mw32font.c in Meadow
and xterm.c in Emacs 20.3) */
-Lisp_Object w32_list_bdf_fonts (Lisp_Object pattern, int max_names)
+static Lisp_Object w32_list_bdf_fonts (Lisp_Object pattern, int max_names)
{
char *fontname, *ptnstr;
Lisp_Object list, tem, newlist = Qnil;
return newlist;
}
-Lisp_Object w32_list_synthesized_fonts (FRAME_PTR f, Lisp_Object pattern,
- int size, int max_names);
+static Lisp_Object w32_list_synthesized_fonts (FRAME_PTR f,
+ Lisp_Object pattern,
+ int size, int max_names);
/* Return a list of names of available fonts matching PATTERN on frame
F. If SIZE is not 0, it is the size (maximum bound width) of fonts
MAXNAMES sets a limit on how many fonts to match. */
Lisp_Object
-w32_list_fonts (FRAME_PTR f, Lisp_Object pattern, int size, int maxnames )
+w32_list_fonts (f, pattern, size, maxnames)
+ struct frame *f;
+ Lisp_Object pattern;
+ int size;
+ int maxnames;
{
Lisp_Object patterns, key = Qnil, tem, tpat;
Lisp_Object list = Qnil, newlist = Qnil, second_best = Qnil;
for (; CONSP (patterns); patterns = XCDR (patterns))
{
enumfont_t ef;
+ int codepage;
tpat = XCAR (patterns);
+ if (!STRINGP (tpat))
+ continue;
+
+ /* Avoid expensive EnumFontFamilies functions if we are not
+ going to be able to output one of these anyway. */
+ codepage = w32_codepage_for_font (XSTRING (tpat)->data);
+ if (codepage != CP_8BIT && codepage != CP_UNICODE
+ && codepage != CP_DEFAULT && codepage != CP_UNKNOWN
+ && !IsValidCodePage(codepage))
+ continue;
+
/* See if we cached the result for this particular query.
The cache is an alist of the form:
((PATTERN (FONTNAME . WIDTH) ...) ...)
/* Use EnumFontFamiliesEx where it is available, as it knows
about character sets. Fall back to EnumFontFamilies for
older versions of NT that don't support the 'Ex function. */
- x_to_w32_font (STRINGP (tpat) ? XSTRING (tpat)->data :
- NULL, &ef.logfont);
+ x_to_w32_font (XSTRING (tpat)->data, &ef.logfont);
{
LOGFONT font_match_pattern;
HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
return newlist;
}
-Lisp_Object
+static Lisp_Object
w32_list_synthesized_fonts (f, pattern, size, max_names)
FRAME_PTR f;
Lisp_Object pattern;
int fields;
char *full_pattn, *new_pattn, foundary[50], family[50], *pattn_part2;
char style[20], slant;
- Lisp_Object matches, match, tem, synthed_matches = Qnil;
+ Lisp_Object matches, tem, synthed_matches = Qnil;
full_pattn = XSTRING (pattern)->data;
}
\f
+/* Find BDF files in a specified directory. (use GCPRO when calling,
+ as this calls lisp to get a directory listing). */
+static Lisp_Object
+w32_find_bdf_fonts_in_dir (Lisp_Object directory)
+{
+ Lisp_Object filelist, list = Qnil;
+ char fontname[100];
+
+ if (!STRINGP(directory))
+ return Qnil;
+
+ filelist = Fdirectory_files (directory, Qt,
+ build_string (".*\\.[bB][dD][fF]"), Qt);
+
+ for ( ; CONSP(filelist); filelist = XCDR (filelist))
+ {
+ Lisp_Object filename = XCAR (filelist);
+ if (w32_BDF_to_x_font (XSTRING (filename)->data, fontname, 100))
+ store_in_alist (&list, build_string (fontname), filename);
+ }
+ return list;
+}
+
DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts, Sw32_find_bdf_fonts,
1, 1, 0,
"Return a list of BDF fonts in DIR, suitable for appending to\n\
-w32-bdf-filename-alist. Fonts which do not contain an xfld description\n\
+w32-bdf-filename-alist. Fonts which do not contain an xlfd description\n\
will not be included in the list. DIR may be a list of directories.")
(directory)
Lisp_Object directory;
return list;
}
-/* Find BDF files in a specified directory. (use GCPRO when calling,
- as this calls lisp to get a directory listing). */
-Lisp_Object w32_find_bdf_fonts_in_dir( Lisp_Object directory )
-{
- Lisp_Object filelist, list = Qnil;
- char fontname[100];
-
- if (!STRINGP(directory))
- return Qnil;
-
- filelist = Fdirectory_files (directory, Qt,
- build_string (".*\\.[bB][dD][fF]"), Qt);
-
- for ( ; CONSP(filelist); filelist = XCDR (filelist))
- {
- Lisp_Object filename = XCAR (filelist);
- if (w32_BDF_to_x_font (XSTRING (filename)->data, fontname, 100))
- store_in_alist (&list, build_string (fontname), filename);
- }
- return list;
-}
-
\f
DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
"Internal function called by `color-defined-p', which see.")
cap = GetDeviceCaps (hdc,SIZEPALETTE);
else
cap = GetDeviceCaps (hdc,NUMCOLORS);
+
+ if (cap < 0)
+ cap = 1 << (dpyinfo->n_planes * dpyinfo->n_cbits);
ReleaseDC (dpyinfo->root_window, hdc);
Lisp_Object display;
{
return Fcons (make_number (w32_major_version),
- Fcons (make_number (w32_minor_version), Qnil));
+ Fcons (make_number (w32_minor_version),
+ Fcons (make_number (w32_build_number), Qnil)));
}
DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
Lisp_Object display;
{
struct w32_display_info *dpyinfo = check_x_display_info (display);
+ Lisp_Object result = Qnil;
-#if 0
- switch (dpyinfo->visual->class)
- {
- case StaticGray: return (intern ("static-gray"));
- case GrayScale: return (intern ("gray-scale"));
- case StaticColor: return (intern ("static-color"));
- case PseudoColor: return (intern ("pseudo-color"));
- case TrueColor: return (intern ("true-color"));
- case DirectColor: return (intern ("direct-color"));
- default:
- error ("Display has an unknown visual class");
- }
-#endif
+ if (dpyinfo->has_palette)
+ result = intern ("pseudo-color");
+ else if (dpyinfo->n_planes * dpyinfo->n_cbits == 1)
+ result = intern ("static-grey");
+ else if (dpyinfo->n_planes * dpyinfo->n_cbits == 4)
+ result = intern ("static-color");
+ else if (dpyinfo->n_planes * dpyinfo->n_cbits > 8)
+ result = intern ("true-color");
- error ("Display has an unknown visual class");
+ return result;
}
DEFUN ("x-display-save-under", Fx_display_save_under,
extern Lisp_Object QCwidth, QCheight, QCforeground, QCbackground, QCfile;
extern Lisp_Object QCdata;
Lisp_Object QCtype, QCascent, QCmargin, QCrelief;
-Lisp_Object QCalgorithm, QCcolor_symbols, QCheuristic_mask;
+Lisp_Object QCconversion, QCcolor_symbols, QCheuristic_mask;
Lisp_Object QCindex;
/* Other symbols. */
IMAGE_STRING_VALUE,
IMAGE_SYMBOL_VALUE,
IMAGE_POSITIVE_INTEGER_VALUE,
+ IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR,
IMAGE_NON_NEGATIVE_INTEGER_VALUE,
IMAGE_ASCENT_VALUE,
IMAGE_INTEGER_VALUE,
return 0;
break;
+ case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR:
+ if (INTEGERP (value) && XINT (value) >= 0)
+ break;
+ if (CONSP (value)
+ && INTEGERP (XCAR (value)) && INTEGERP (XCDR (value))
+ && XINT (XCAR (value)) >= 0 && XINT (XCDR (value)) >= 0)
+ break;
+ return 0;
+
case IMAGE_ASCENT_VALUE:
if (SYMBOLP (value) && EQ (value, Qcenter))
break;
struct image *img;
struct face *face;
{
- int height = img->height + img->margin;
+ int height = img->height + img->vmargin;
int ascent;
if (img->ascent == CENTERED_IMAGE_ASCENT)
struct frame *f;
struct image *img;
{
-#if 0 /* NTEMACS_TODO: W32 image support */
+#if 0 /* TODO: W32 image support */
if (img->pixmap)
{
Lisp_Object color_name;
unsigned long dflt;
{
-#if 0 /* NTEMACS_TODO: allocing colors. */
+#if 0 /* TODO: allocing colors. */
XColor color;
unsigned long result;
/* If not found, create a new image and cache it. */
if (img == NULL)
{
+ BLOCK_INPUT;
img = make_image (spec, hash);
cache_image (f, img);
img->load_failed_p = img->type->load (f, img) == 0;
- xassert (!interrupt_input_blocked);
/* If we can't load the image, and we don't have a width and
height, use some arbitrary width and height so that we can
{
/* Handle image type independent image attributes
`:ascent PERCENT', `:margin MARGIN', `:relief RELIEF'. */
- Lisp_Object ascent, margin, relief, algorithm, heuristic_mask;
- Lisp_Object file;
+ Lisp_Object ascent, margin, relief;
ascent = image_spec_value (spec, QCascent, NULL);
if (INTEGERP (ascent))
margin = image_spec_value (spec, QCmargin, NULL);
if (INTEGERP (margin) && XINT (margin) >= 0)
- img->margin = XFASTINT (margin);
+ img->vmargin = img->hmargin = XFASTINT (margin);
+ else if (CONSP (margin) && INTEGERP (XCAR (margin))
+ && INTEGERP (XCDR (margin)))
+ {
+ if (XINT (XCAR (margin)) > 0)
+ img->hmargin = XFASTINT (XCAR (margin));
+ if (XINT (XCDR (margin)) > 0)
+ img->vmargin = XFASTINT (XCDR (margin));
+ }
relief = image_spec_value (spec, QCrelief, NULL);
if (INTEGERP (relief))
{
img->relief = XINT (relief);
- img->margin += abs (img->relief);
+ img->hmargin += abs (img->relief);
+ img->vmargin += abs (img->relief);
}
- /* Should we apply a Laplace edge-detection algorithm? */
- algorithm = image_spec_value (spec, QCalgorithm, NULL);
- if (img->pixmap && EQ (algorithm, Qlaplace))
- x_laplace (f, img);
-
- /* Should we built a mask heuristically? */
- heuristic_mask = image_spec_value (spec, QCheuristic_mask, NULL);
- if (img->pixmap && !img->mask && !NILP (heuristic_mask))
- x_build_heuristic_mask (f, img, heuristic_mask);
+#if 0 /* TODO: image mask and algorithm. */
+ /* Manipulation of the image's mask. */
+ if (img->pixmap)
+ {
+ /* `:heuristic-mask t'
+ `:mask heuristic'
+ means build a mask heuristically.
+ `:heuristic-mask (R G B)'
+ `:mask (heuristic (R G B))'
+ means build a mask from color (R G B) in the
+ image.
+ `:mask nil'
+ means remove a mask, if any. */
+
+ Lisp_Object mask;
+
+ mask = image_spec_value (spec, QCheuristic_mask, NULL);
+ if (!NILP (mask))
+ x_build_heuristic_mask (f, img, mask);
+ else
+ {
+ int found_p;
+
+ mask = image_spec_value (spec, QCmask, &found_p);
+
+ if (EQ (mask, Qheuristic))
+ x_build_heuristic_mask (f, img, Qt);
+ else if (CONSP (mask)
+ && EQ (XCAR (mask), Qheuristic))
+ {
+ if (CONSP (XCDR (mask)))
+ x_build_heuristic_mask (f, img, XCAR (XCDR (mask)));
+ else
+ x_build_heuristic_mask (f, img, XCDR (mask));
+ }
+ else if (NILP (mask) && found_p && img->mask)
+ {
+ XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
+ img->mask = None;
+ }
+ }
+ }
+
+ /* Should we apply an image transformation algorithm? */
+ if (img->pixmap)
+ {
+ Lisp_Object conversion;
+
+ algorithm = image_spec_value (spec, QCconversion, NULL);
+ if (EQ (conversion, Qdisabled))
+ x_disable_image (f, img);
+ else if (EQ (conversion, Qlaplace))
+ x_laplace (f, img);
+ else if (EQ (conversion, Qemboss))
+ x_emboss (f, img);
+ else if (CONSP (conversion)
+ && EQ (XCAR (conversion), Qedge_detection))
+ {
+ Lisp_Object tem;
+ tem = XCDR (conversion);
+ if (CONSP (tem))
+ x_edge_detection (f, img,
+ Fplist_get (tem, QCmatrix),
+ Fplist_get (tem, QCcolor_adjustment));
+ }
+ }
+#endif /* TODO. */
}
+ UNBLOCK_INPUT;
+ xassert (!interrupt_input_blocked);
}
/* We're using IMG, so set its timestamp to `now'. */
W32 support code
***********************************************************************/
-#if 0 /* NTEMACS_TODO: W32 specific image code. */
+#if 0 /* TODO: W32 specific image code. */
static int x_create_x_image_and_pixmap P_ ((struct frame *, int, int, int,
XImage **, Pixmap *));
XImage **ximg;
Pixmap *pixmap;
{
-#if 0 /* NTEMACS_TODO: Image support for W32 */
+#if 0 /* TODO: Image support for W32 */
Display *display = FRAME_W32_DISPLAY (f);
Screen *screen = FRAME_X_SCREEN (f);
Window window = FRAME_W32_WINDOW (f);
/* Try to find FILE in data-directory, then x-bitmap-file-path. */
fd = openp (search_path, file, "", &file_found, 0);
- if (fd < 0)
+ if (fd == -1)
file_found = Qnil;
else
close (fd);
{":foreground", IMAGE_STRING_VALUE, 0},
{":background", IMAGE_STRING_VALUE, 0},
{":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
- {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
+ {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
{":relief", IMAGE_INTEGER_VALUE, 0},
- {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
+ {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
};
if (!NILP (value))
background = x_alloc_image_color (f, img, value, background);
-#if 0 /* NTEMACS_TODO : Port image display to W32 */
+#if 0 /* TODO : Port image display to W32 */
BLOCK_INPUT;
img->pixmap
= XCreatePixmapFromBitmapData (FRAME_W32_DISPLAY (f),
else
bits = XBOOL_VECTOR (data)->data;
-#if 0 /* NTEMACS_TODO : W32 XPM code */
+#if 0 /* TODO : W32 XPM code */
/* Create the pixmap. */
depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
img->pixmap
img->width, img->height,
foreground, background,
depth);
-#endif /* NTEMACS_TODO */
+#endif /* TODO */
if (img->pixmap)
success_p = 1;
{":file", IMAGE_STRING_VALUE, 0},
{":data", IMAGE_STRING_VALUE, 0},
{":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
- {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
+ {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
{":relief", IMAGE_INTEGER_VALUE, 0},
- {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
+ {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
};
#endif /* HAVE_XPM != 0 */
\f
-#if 0 /* NTEMACS_TODO : Color tables on W32. */
+#if 0 /* TODO : Color tables on W32. */
/***********************************************************************
Color table
***********************************************************************/
return colors;
}
-#endif /* NTEMACS_TODO */
+#endif /* TODO */
\f
/***********************************************************************
Algorithms
***********************************************************************/
-#if 0 /* NTEMACS_TODO : W32 versions of low level algorithms */
+#if 0 /* TODO : W32 versions of low level algorithms */
static void x_laplace_write_row P_ ((struct frame *, long *,
int, XImage *, int));
static void x_laplace_read_row P_ ((struct frame *, Colormap,
struct frame *f;
struct image *img;
{
-#if 0 /* NTEMACS_TODO : W32 version */
+#if 0 /* TODO : W32 version */
Colormap cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
XImage *ximg, *oimg;
XColor *in[3];
free_color_table ();
UNBLOCK_INPUT;
-#endif /* NTEMACS_TODO */
+#endif /* TODO */
}
struct image *img;
Lisp_Object how;
{
-#if 0 /* NTEMACS_TODO : W32 version */
+#if 0 /* TODO : W32 version */
Display *dpy = FRAME_W32_DISPLAY (f);
XImage *ximg, *mask_img;
int x, y, rc, look_at_corners_p;
XDestroyImage (ximg);
UNBLOCK_INPUT;
-#endif /* NTEMACS_TODO */
+#endif /* TODO */
return 1;
}
{":file", IMAGE_STRING_VALUE, 0},
{":data", IMAGE_STRING_VALUE, 0},
{":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
- {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
+ {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
{":relief", IMAGE_INTEGER_VALUE, 0},
- {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
+ {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
};
{":data", IMAGE_STRING_VALUE, 0},
{":file", IMAGE_STRING_VALUE, 0},
{":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
- {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
+ {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
{":relief", IMAGE_INTEGER_VALUE, 0},
- {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
+ {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
};
{":data", IMAGE_STRING_VALUE, 0},
{":file", IMAGE_STRING_VALUE, 0},
{":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
- {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
+ {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
{":relief", IMAGE_INTEGER_VALUE, 0},
- {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
+ {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
};
{":data", IMAGE_STRING_VALUE, 0},
{":file", IMAGE_STRING_VALUE, 0},
{":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
- {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
+ {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
{":relief", IMAGE_INTEGER_VALUE, 0},
- {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
+ {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
};
{":data", IMAGE_STRING_VALUE, 0},
{":file", IMAGE_STRING_VALUE, 0},
{":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
- {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
+ {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
{":relief", IMAGE_INTEGER_VALUE, 0},
- {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
+ {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0}
};
{":loader", IMAGE_FUNCTION_VALUE, 0},
{":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE, 1},
{":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
- {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
+ {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
{":relief", IMAGE_INTEGER_VALUE, 0},
- {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
+ {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
};
(prop, value, frame)
Lisp_Object frame, prop, value;
{
-#if 0 /* NTEMACS_TODO : port window properties to W32 */
+#if 0 /* TODO : port window properties to W32 */
struct frame *f = check_x_frame (frame);
Atom prop_atom;
XFlush (FRAME_W32_DISPLAY (f));
UNBLOCK_INPUT;
-#endif /* NTEMACS_TODO */
+#endif /* TODO */
return value;
}
(prop, frame)
Lisp_Object prop, frame;
{
-#if 0 /* NTEMACS_TODO : port window properties to W32 */
+#if 0 /* TODO : port window properties to W32 */
struct frame *f = check_x_frame (frame);
Atom prop_atom;
/* Make sure the property is removed when we return. */
XFlush (FRAME_W32_DISPLAY (f));
UNBLOCK_INPUT;
-#endif /* NTEMACS_TODO */
+#endif /* TODO */
return prop;
}
(prop, frame)
Lisp_Object prop, frame;
{
-#if 0 /* NTEMACS_TODO : port window properties to W32 */
+#if 0 /* TODO : port window properties to W32 */
struct frame *f = check_x_frame (frame);
Atom prop_atom;
return prop_value;
-#endif /* NTEMACS_TODO */
+#endif /* TODO */
return Qnil;
}
***********************************************************************/
/* If non-null, an asynchronous timer that, when it expires, displays
- a busy cursor on all frames. */
+ an hourglass cursor on all frames. */
-static struct atimer *busy_cursor_atimer;
+static struct atimer *hourglass_atimer;
-/* Non-zero means a busy cursor is currently shown. */
+/* Non-zero means an hourglass cursor is currently shown. */
-static int busy_cursor_shown_p;
+static int hourglass_shown_p;
-/* Number of seconds to wait before displaying a busy cursor. */
+/* Number of seconds to wait before displaying an hourglass cursor. */
-static Lisp_Object Vbusy_cursor_delay;
+static Lisp_Object Vhourglass_delay;
-/* Default number of seconds to wait before displaying a busy
+/* Default number of seconds to wait before displaying an hourglass
cursor. */
-#define DEFAULT_BUSY_CURSOR_DELAY 1
+#define DEFAULT_HOURGLASS_DELAY 1
/* Function prototypes. */
-static void show_busy_cursor P_ ((struct atimer *));
-static void hide_busy_cursor P_ ((void));
+static void show_hourglass P_ ((struct atimer *));
+static void hide_hourglass P_ ((void));
-/* Cancel a currently active busy-cursor timer, and start a new one. */
+/* Cancel a currently active hourglass timer, and start a new one. */
void
-start_busy_cursor ()
+start_hourglass ()
{
-#if 0 /* NTEMACS_TODO: cursor shape changes. */
+#if 0 /* TODO: cursor shape changes. */
EMACS_TIME delay;
int secs, usecs = 0;
- cancel_busy_cursor ();
+ cancel_hourglass ();
- if (INTEGERP (Vbusy_cursor_delay)
- && XINT (Vbusy_cursor_delay) > 0)
- secs = XFASTINT (Vbusy_cursor_delay);
- else if (FLOATP (Vbusy_cursor_delay)
- && XFLOAT_DATA (Vbusy_cursor_delay) > 0)
+ if (INTEGERP (Vhourglass_delay)
+ && XINT (Vhourglass_delay) > 0)
+ secs = XFASTINT (Vhourglass_delay);
+ else if (FLOATP (Vhourglass_delay)
+ && XFLOAT_DATA (Vhourglass_delay) > 0)
{
Lisp_Object tem;
- tem = Ftruncate (Vbusy_cursor_delay, Qnil);
+ tem = Ftruncate (Vhourglass_delay, Qnil);
secs = XFASTINT (tem);
- usecs = (XFLOAT_DATA (Vbusy_cursor_delay) - secs) * 1000000;
+ usecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000000;
}
else
- secs = DEFAULT_BUSY_CURSOR_DELAY;
+ secs = DEFAULT_HOURGLASS_DELAY;
EMACS_SET_SECS_USECS (delay, secs, usecs);
- busy_cursor_atimer = start_atimer (ATIMER_RELATIVE, delay,
- show_busy_cursor, NULL);
+ hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay,
+ show_hourglass, NULL);
#endif
}
-/* Cancel the busy cursor timer if active, hide a busy cursor if
- shown. */
+/* Cancel the hourglass cursor timer if active, hide an hourglass
+ cursor if shown. */
void
-cancel_busy_cursor ()
+cancel_hourglass ()
{
- if (busy_cursor_atimer)
+ if (hourglass_atimer)
{
- cancel_atimer (busy_cursor_atimer);
- busy_cursor_atimer = NULL;
+ cancel_atimer (hourglass_atimer);
+ hourglass_atimer = NULL;
}
- if (busy_cursor_shown_p)
- hide_busy_cursor ();
+ if (hourglass_shown_p)
+ hide_hourglass ();
}
-/* Timer function of busy_cursor_atimer. TIMER is equal to
- busy_cursor_atimer.
+/* Timer function of hourglass_atimer. TIMER is equal to
+ hourglass_atimer.
- Display a busy cursor on all frames by mapping the frames'
- busy_window. Set the busy_p flag in the frames' output_data.x
- structure to indicate that a busy cursor is shown on the
- frames. */
+ Display an hourglass cursor on all frames by mapping the frames'
+ hourglass_window. Set the hourglass_p flag in the frames'
+ output_data.x structure to indicate that an hourglass cursor is
+ shown on the frames. */
static void
-show_busy_cursor (timer)
+show_hourglass (timer)
struct atimer *timer;
{
-#if 0 /* NTEMACS_TODO: cursor shape changes. */
+#if 0 /* TODO: cursor shape changes. */
/* The timer implementation will cancel this timer automatically
- after this function has run. Set busy_cursor_atimer to null
+ after this function has run. Set hourglass_atimer to null
so that we know the timer doesn't have to be canceled. */
- busy_cursor_atimer = NULL;
+ hourglass_atimer = NULL;
- if (!busy_cursor_shown_p)
+ if (!hourglass_shown_p)
{
Lisp_Object rest, frame;
BLOCK_INPUT;
FOR_EACH_FRAME (rest, frame)
- if (FRAME_X_P (XFRAME (frame)))
+ if (FRAME_W32_P (XFRAME (frame)))
{
struct frame *f = XFRAME (frame);
- f->output_data.w32->busy_p = 1;
+ f->output_data.w32->hourglass_p = 1;
- if (!f->output_data.w32->busy_window)
+ if (!f->output_data.w32->hourglass_window)
{
unsigned long mask = CWCursor;
XSetWindowAttributes attrs;
- attrs.cursor = f->output_data.w32->busy_cursor;
+ attrs.cursor = f->output_data.w32->hourglass_cursor;
- f->output_data.w32->busy_window
+ f->output_data.w32->hourglass_window
= XCreateWindow (FRAME_X_DISPLAY (f),
FRAME_OUTER_WINDOW (f),
0, 0, 32000, 32000, 0, 0,
mask, &attrs);
}
- XMapRaised (FRAME_X_DISPLAY (f), f->output_data.w32->busy_window);
+ XMapRaised (FRAME_X_DISPLAY (f),
+ f->output_data.w32->hourglass_window);
XFlush (FRAME_X_DISPLAY (f));
}
- busy_cursor_shown_p = 1;
+ hourglass_shown_p = 1;
UNBLOCK_INPUT;
}
#endif
}
-/* Hide the busy cursor on all frames, if it is currently shown. */
+/* Hide the hourglass cursor on all frames, if it is currently shown. */
static void
-hide_busy_cursor ()
+hide_hourglass ()
{
-#if 0 /* NTEMACS_TODO: cursor shape changes. */
- if (busy_cursor_shown_p)
+#if 0 /* TODO: cursor shape changes. */
+ if (hourglass_shown_p)
{
Lisp_Object rest, frame;
{
struct frame *f = XFRAME (frame);
- if (FRAME_X_P (f)
+ if (FRAME_W32_P (f)
/* Watch out for newly created frames. */
- && f->output_data.x->busy_window)
+ && f->output_data.x->hourglass_window)
{
- XUnmapWindow (FRAME_X_DISPLAY (f), f->output_data.x->busy_window);
- /* Sync here because XTread_socket looks at the busy_p flag
- that is reset to zero below. */
+ XUnmapWindow (FRAME_X_DISPLAY (f),
+ f->output_data.x->hourglass_window);
+ /* Sync here because XTread_socket looks at the
+ hourglass_p flag that is reset to zero below. */
XSync (FRAME_X_DISPLAY (f), False);
- f->output_data.x->busy_p = 0;
+ f->output_data.x->hourglass_p = 0;
}
}
- busy_cursor_shown_p = 0;
+ hourglass_shown_p = 0;
UNBLOCK_INPUT;
}
#endif
/* The frame of a currently visible tooltip, or null. */
-struct frame *tip_frame;
+Lisp_Object tip_frame;
/* If non-nil, a timer started that hides the last tooltip when it
fires. */
Lisp_Object tip_timer;
Window tip_window;
+static Lisp_Object
+unwind_create_tip_frame (frame)
+ Lisp_Object frame;
+{
+ Lisp_Object deleted;
+
+ deleted = unwind_create_frame (frame);
+ if (EQ (deleted, Qt))
+ {
+ tip_window = NULL;
+ tip_frame = Qnil;
+ }
+
+ return deleted;
+}
+
+
/* Create a frame for a tooltip on the display described by DPYINFO.
- PARMS is a list of frame parameters. Value is the frame. */
+ PARMS is a list of frame parameters. Value is the frame.
+
+ Note that functions called here, esp. x_default_parameter can
+ signal errors, for instance when a specified color name is
+ undefined. We have to make sure that we're in a consistent state
+ when this happens. */
static Lisp_Object
x_create_tip_frame (dpyinfo, parms)
struct w32_display_info *dpyinfo;
Lisp_Object parms;
{
-#if 0 /* NTEMACS_TODO : w32 version */
+#if 0 /* TODO : w32 version */
struct frame *f;
Lisp_Object frame, tem;
Lisp_Object name;
long window_prompting = 0;
int width, height;
- int count = specpdl_ptr - specpdl;
+ int count = BINDING_STACK_SIZE ();
struct gcpro gcpro1, gcpro2, gcpro3;
struct kboard *kb;
frame = Qnil;
GCPRO3 (parms, name, frame);
- tip_frame = f = make_frame (1);
+ f = make_frame (1);
XSETFRAME (frame, f);
FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
+ record_unwind_protect (unwind_create_tip_frame, frame);
f->output_method = output_w32;
f->output_data.w32 =
f->output_data.w32->fontset = -1;
f->icon_name = Qnil;
+#ifdef GLYPH_DEBUG
+ image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount;
+ dpyinfo_refcount = dpyinfo->reference_count;
+#endif /* GLYPH_DEBUG */
#ifdef MULTI_KBOARD
FRAME_KBOARD (f) = kb;
#endif
below. And the frame needs to be on Vframe_list or making it
visible won't work. */
Vframe_list = Fcons (frame, Vframe_list);
+ tip_frame = frame;
/* Now that the frame is official, it counts as a reference to
its display. */
FRAME_W32_DISPLAY_INFO (f)->reference_count++;
return unbind_to (count, frame);
-#endif /* NTEMACS_TODO */
+#endif /* TODO */
return Qnil;
}
-
+#ifdef TODO /* Tooltip support not complete. */
DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
"Show STRING in a \"tooltip\" window on frame FRAME.\n\
-A tooltip window is a small X window displaying a string.\n\
+A tooltip window is a small window displaying a string.\n\
\n\
FRAME nil or omitted means use the selected frame.\n\
\n\
DX isn't specified). Likewise for the y-position; if a `top' frame\n\
parameter is specified, it determines the y-position of the tooltip\n\
window, otherwise it is displayed at the mouse position, with offset\n\
-DY added (default is -5).")
+DY added (default is 10).")
(string, frame, parms, timeout, dx, dy)
Lisp_Object string, frame, parms, timeout, dx, dy;
{
CHECK_NUMBER (dx, 5);
if (NILP (dy))
- dy = make_number (-5);
+ dy = make_number (-10);
else
CHECK_NUMBER (dy, 6);
+ if (NILP (last_show_tip_args))
+ last_show_tip_args = Fmake_vector (make_number (3), Qnil);
+
+ if (!NILP (tip_frame))
+ {
+ Lisp_Object last_string = AREF (last_show_tip_args, 0);
+ Lisp_Object last_frame = AREF (last_show_tip_args, 1);
+ Lisp_Object last_parms = AREF (last_show_tip_args, 2);
+
+ if (EQ (frame, last_frame)
+ && !NILP (Fequal (last_string, string))
+ && !NILP (Fequal (last_parms, parms)))
+ {
+ struct frame *f = XFRAME (tip_frame);
+
+ /* Only DX and DY have changed. */
+ if (!NILP (tip_timer))
+ {
+ Lisp_Object timer = tip_timer;
+ tip_timer = Qnil;
+ call1 (Qcancel_timer, timer);
+ }
+
+ BLOCK_INPUT;
+ compute_tip_xy (f, parms, dx, dy, &root_x, &root_y);
+ XMoveWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ root_x, root_y - PIXEL_HEIGHT (f));
+ UNBLOCK_INPUT;
+ goto start_timer;
+ }
+ }
+
/* Hide a previous tip, if any. */
Fx_hide_tip ();
+ ASET (last_show_tip_args, 0, string);
+ ASET (last_show_tip_args, 1, frame);
+ ASET (last_show_tip_args, 2, parms);
+
/* Add default values to frame parameters. */
if (NILP (Fassq (Qname, parms)))
parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
/* Create a frame for the tooltip, and record it in the global
variable tip_frame. */
frame = x_create_tip_frame (FRAME_W32_DISPLAY_INFO (f), parms);
- tip_frame = f = XFRAME (frame);
+ f = XFRAME (frame);
/* Set up the frame's root window. Currently we use a size of 80
columns x 40 lines. If someone wants to show a larger tip, he
will loose. I don't think this is a realistic case. */
w = XWINDOW (FRAME_ROOT_WINDOW (f));
w->left = w->top = make_number (0);
- w->width = 80;
- w->height = 40;
+ w->width = make_number (80);
+ w->height = make_number (40);
adjust_glyphs (f);
w->pseudo_window_p = 1;
old_buffer = current_buffer;
set_buffer_internal_1 (XBUFFER (buffer));
Ferase_buffer ();
- Finsert (make_number (1), &string);
+ Finsert (1, &string);
clear_glyph_matrix (w->desired_matrix);
clear_glyph_matrix (w->current_matrix);
SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
- /* User-specified position? */
- left = Fcdr (Fassq (Qleft, parms));
- top = Fcdr (Fassq (Qtop, parms));
-
/* Move the tooltip window where the mouse pointer is. Resize and
show it. */
-#if 0 /* NTEMACS_TODO : W32 specifics */
- BLOCK_INPUT;
- XQueryPointer (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
- &root, &child, &root_x, &root_y, &win_x, &win_y, &pmask);
- UNBLOCK_INPUT;
+ compute_tip_xy (f, parms, dx, dy, &root_x, &root_y);
- root_x += XINT (dx);
- root_y += XINT (dy);
-
- if (INTEGERP (left))
- root_x = XINT (left);
- if (INTEGERP (top))
- root_y = XINT (top);
-
+#if 0 /* TODO : W32 specifics */
BLOCK_INPUT;
XMoveResizeWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
root_x, root_y - height, width, height);
XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
UNBLOCK_INPUT;
-#endif /* NTEMACS_TODO */
+#endif /* TODO */
/* Draw into the window. */
w->must_be_updated_p = 1;
set_buffer_internal_1 (old_buffer);
windows_or_buffers_changed = old_windows_or_buffers_changed;
+ start_timer:
/* Let the tip disappear after timeout seconds. */
tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
intern ("x-hide-tip"));
Value is t is tooltip was open, nil otherwise.")
()
{
- int count = specpdl_ptr - specpdl;
- int deleted_p = 0;
+ int count;
+ Lisp_Object deleted, frame, timer;
+ struct gcpro gcpro1, gcpro2;
+
+ /* Return quickly if nothing to do. */
+ if (NILP (tip_timer) && NILP (tip_frame))
+ return Qnil;
+ frame = tip_frame;
+ timer = tip_timer;
+ GCPRO2 (frame, timer);
+ tip_frame = tip_timer = deleted = Qnil;
+
+ count = BINDING_STACK_SIZE ();
specbind (Qinhibit_redisplay, Qt);
+ specbind (Qinhibit_quit, Qt);
- if (!NILP (tip_timer))
- {
- call1 (intern ("cancel-timer"), tip_timer);
- tip_timer = Qnil;
- }
+ if (!NILP (timer))
+ call1 (Qcancel_timer, timer);
- if (tip_frame)
+ if (FRAMEP (frame))
{
- Lisp_Object frame;
-
- XSETFRAME (frame, tip_frame);
- Fdelete_frame (frame, Qt);
- tip_frame = NULL;
- deleted_p = 1;
+ Fdelete_frame (frame, Qnil);
+ deleted = Qt;
}
- return unbind_to (count, deleted_p ? Qt : Qnil);
+ UNGCPRO;
+ return unbind_to (count, deleted);
}
+#endif
\f
if (use_dialog_p)
{
OPENFILENAME file_details;
- char *filename_file;
/* Prevent redisplay. */
specbind (Qinhibit_redisplay, Qt);
SelectObject (hdc, oldobj);
ReleaseDC (FRAME_W32_WINDOW (f), hdc);
- if (!ChooseFont (&cf) || !w32_to_x_font (&lf, buf, 100))
+ if (!ChooseFont (&cf) || !w32_to_x_font (&lf, buf, 100, NULL))
return Qnil;
return build_string (buf);
(command, frame)
Lisp_Object command, frame;
{
- WPARAM code;
FRAME_PTR f = check_x_frame (frame);
CHECK_NUMBER (command, 0);
XINT (show_flag) : SW_SHOWDEFAULT))
> 32)
return Qt;
- error ("ShellExecute failed");
+ error ("ShellExecute failed: %s", w32_strerror (0));
}
/* Lookup virtual keycode from string representing the name of a
Lisp_Object key, new_state;
{
int vk_code;
- int cur_state;
if (EQ (key, intern ("capslock")))
vk_code = VK_CAPITAL;
return Qnil;
}
\f
+DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0,
+ "Return storage information about the file system FILENAME is on.\n\
+Value is a list of floats (TOTAL FREE AVAIL), where TOTAL is the total\n\
+storage of the file system, FREE is the free storage, and AVAIL is the\n\
+storage available to a non-superuser. All 3 numbers are in bytes.\n\
+If the underlying system call fails, value is nil.")
+ (filename)
+ Lisp_Object filename;
+{
+ Lisp_Object encoded, value;
+
+ CHECK_STRING (filename, 0);
+ filename = Fexpand_file_name (filename, Qnil);
+ encoded = ENCODE_FILE (filename);
+
+ value = Qnil;
+
+ /* Determining the required information on Windows turns out, sadly,
+ to be more involved than one would hope. The original Win32 api
+ call for this will return bogus information on some systems, but we
+ must dynamically probe for the replacement api, since that was
+ added rather late on. */
+ {
+ HMODULE hKernel = GetModuleHandle ("kernel32");
+ BOOL (*pfn_GetDiskFreeSpaceEx)
+ (char *, PULARGE_INTEGER, PULARGE_INTEGER, PULARGE_INTEGER)
+ = (void *) GetProcAddress (hKernel, "GetDiskFreeSpaceEx");
+
+ /* On Windows, we may need to specify the root directory of the
+ volume holding FILENAME. */
+ char rootname[MAX_PATH];
+ char *name = XSTRING (encoded)->data;
+
+ /* find the root name of the volume if given */
+ if (isalpha (name[0]) && name[1] == ':')
+ {
+ rootname[0] = name[0];
+ rootname[1] = name[1];
+ rootname[2] = '\\';
+ rootname[3] = 0;
+ }
+ else if (IS_DIRECTORY_SEP (name[0]) && IS_DIRECTORY_SEP (name[1]))
+ {
+ char *str = rootname;
+ int slashes = 4;
+ do
+ {
+ if (IS_DIRECTORY_SEP (*name) && --slashes == 0)
+ break;
+ *str++ = *name++;
+ }
+ while ( *name );
+
+ *str++ = '\\';
+ *str = 0;
+ }
+
+ if (pfn_GetDiskFreeSpaceEx)
+ {
+ LARGE_INTEGER availbytes;
+ LARGE_INTEGER freebytes;
+ LARGE_INTEGER totalbytes;
+
+ if (pfn_GetDiskFreeSpaceEx(rootname,
+ &availbytes,
+ &totalbytes,
+ &freebytes))
+ value = list3 (make_float ((double) totalbytes.QuadPart),
+ make_float ((double) freebytes.QuadPart),
+ make_float ((double) availbytes.QuadPart));
+ }
+ else
+ {
+ DWORD sectors_per_cluster;
+ DWORD bytes_per_sector;
+ DWORD free_clusters;
+ DWORD total_clusters;
+
+ if (GetDiskFreeSpace(rootname,
+ §ors_per_cluster,
+ &bytes_per_sector,
+ &free_clusters,
+ &total_clusters))
+ value = list3 (make_float ((double) total_clusters
+ * sectors_per_cluster * bytes_per_sector),
+ make_float ((double) free_clusters
+ * sectors_per_cluster * bytes_per_sector),
+ make_float ((double) free_clusters
+ * sectors_per_cluster * bytes_per_sector));
+ }
+ }
+
+ return value;
+}
+\f
syms_of_w32fns ()
{
/* This is zero if not using MS-Windows. */
staticpro (&Qline_spacing);
Qcenter = intern ("center");
staticpro (&Qcenter);
+ Qcancel_timer = intern ("cancel-timer");
+ staticpro (&Qcancel_timer);
/* This is the end of symbol initialization. */
Qhyper = intern ("hyper");
Vx_mode_pointer_shape = Qnil;
- DEFVAR_LISP ("x-busy-pointer-shape", &Vx_busy_pointer_shape,
+ DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape,
"The shape of the pointer when Emacs is busy.\n\
This variable takes effect when you create a new frame\n\
or when you set the mouse color.");
- Vx_busy_pointer_shape = Qnil;
+ Vx_hourglass_pointer_shape = Qnil;
- DEFVAR_BOOL ("display-busy-cursor", &display_busy_cursor_p,
- "Non-zero means Emacs displays a busy cursor on window systems.");
- display_busy_cursor_p = 1;
+ DEFVAR_BOOL ("display-hourglass", &display_hourglass_p,
+ "Non-zero means Emacs displays an hourglass pointer on window systems.");
+ display_hourglass_p = 1;
- DEFVAR_LISP ("busy-cursor-delay", &Vbusy_cursor_delay,
- "*Seconds to wait before displaying a busy-cursor.\n\
+ DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay,
+ "*Seconds to wait before displaying an hourglass pointer.\n\
Value must be an integer or float.");
- Vbusy_cursor_delay = make_number (DEFAULT_BUSY_CURSOR_DELAY);
+ Vhourglass_delay = make_number (DEFAULT_HOURGLASS_DELAY);
DEFVAR_LISP ("x-sensitive-text-pointer-shape",
&Vx_sensitive_text_pointer_shape,
or when you set the mouse color.");
Vx_sensitive_text_pointer_shape = Qnil;
+ DEFVAR_LISP ("x-window-horizontal-drag-cursor",
+ &Vx_window_horizontal_drag_shape,
+ "Pointer shape to use for indicating a window can be dragged horizontally.\n\
+This variable takes effect when you create a new frame\n\
+or when you set the mouse color.");
+ Vx_window_horizontal_drag_shape = Qnil;
+
DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
"A string indicating the foreground color of the cursor box.");
Vx_cursor_fore_pixel = Qnil;
where CHARSET_NAME is a string used in font names to identify the charset,\n\
WINDOWS_CHARSET is a symbol that can be one of:\n\
w32-charset-ansi, w32-charset-default, w32-charset-symbol,\n\
-w32-charset-shiftjis, w32-charset-hangul, w32-charset-gb2312,\n\
+w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,\n\
w32-charset-chinesebig5, "
#ifdef JOHAB_CHARSET
"w32-charset-johab, w32-charset-hebrew,\n\
Qw32_charset_symbol = intern ("w32-charset-symbol");
staticpro (&Qw32_charset_shiftjis);
Qw32_charset_shiftjis = intern ("w32-charset-shiftjis");
- staticpro (&Qw32_charset_hangul);
- Qw32_charset_hangul = intern ("w32-charset-hangul");
+ staticpro (&Qw32_charset_hangeul);
+ Qw32_charset_hangeul = intern ("w32-charset-hangeul");
staticpro (&Qw32_charset_chinesebig5);
Qw32_charset_chinesebig5 = intern ("w32-charset-chinesebig5");
staticpro (&Qw32_charset_gb2312);
#ifdef JOHAB_CHARSET
{
static int w32_extra_charsets_defined = 1;
- DEFVAR_BOOL ("w32-extra-charsets-defined", w32_extra_charsets_defined, "");
+ DEFVAR_BOOL ("w32-extra-charsets-defined", &w32_extra_charsets_defined, "");
staticpro (&Qw32_charset_johab);
Qw32_charset_johab = intern ("w32-charset-johab");
Qw32_charset_greek = intern ("w32-charset-greek");
staticpro (&Qw32_charset_hebrew);
Qw32_charset_hebrew = intern ("w32-charset-hebrew");
+ staticpro (&Qw32_charset_vietnamese);
+ Qw32_charset_vietnamese = intern ("w32-charset-vietnamese");
staticpro (&Qw32_charset_thai);
Qw32_charset_thai = intern ("w32-charset-thai");
staticpro (&Qw32_charset_mac);
{
static int w32_unicode_charset_defined = 1;
DEFVAR_BOOL ("w32-unicode-charset-defined",
- w32_unicode_charset_defined, "");
+ &w32_unicode_charset_defined, "");
staticpro (&Qw32_charset_unicode);
Qw32_charset_unicode = intern ("w32-charset-unicode");
#endif
defsubr (&Sx_get_resource);
-#if 0 /* NTEMACS_TODO: Port to W32 */
+#if 0 /* TODO: Port to W32 */
defsubr (&Sx_change_window_property);
defsubr (&Sx_delete_window_property);
defsubr (&Sx_window_property);
defsubr (&Sw32_toggle_lock_key);
defsubr (&Sw32_find_bdf_fonts);
+ defsubr (&Sfile_system_info);
+
/* Setting callback functions for fontset handler. */
get_font_info_func = w32_get_font_info;
set_frame_fontset_func = x_set_font;
check_window_system_func = check_w32;
-#if 0 /* NTEMACS_TODO Image support for W32 */
+#if 0 /* TODO Image support for W32 */
/* Images. */
Qxbm = intern ("xbm");
staticpro (&Qxbm);
QCtype = intern (":type");
staticpro (&QCtype);
- QCalgorithm = intern (":algorithm");
- staticpro (&QCalgorithm);
+ QCconversion = intern (":conversion");
+ staticpro (&QCconversion);
QCheuristic_mask = intern (":heuristic-mask");
staticpro (&QCheuristic_mask);
QCcolor_symbols = intern (":color-symbols");
defsubr (&Simagep);
defsubr (&Slookup_image);
#endif
-#endif /* NTEMACS_TODO */
-
- busy_cursor_atimer = NULL;
- busy_cursor_shown_p = 0;
+#endif /* TODO */
+ hourglass_atimer = NULL;
+ hourglass_shown_p = 0;
+#ifdef TODO /* Tooltip support not complete. */
defsubr (&Sx_show_tip);
defsubr (&Sx_hide_tip);
- staticpro (&tip_timer);
+#endif
tip_timer = Qnil;
+ staticpro (&tip_timer);
+ tip_frame = Qnil;
+ staticpro (&tip_frame);
defsubr (&Sx_file_dialog);
}
image_types = NULL;
Vimage_types = Qnil;
-#if 0 /* NTEMACS_TODO : Image support for W32 */
+#if 0 /* TODO : Image support for W32 */
define_image_type (&xbm_type);
define_image_type (&gs_type);
define_image_type (&pbm_type);
#if HAVE_PNG
define_image_type (&png_type);
#endif
-#endif /* NTEMACS_TODO */
+#endif /* TODO */
}
#undef abort
HCoop / bpt / emacs.git / blobdiff