/* 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 "lisp.h"
#include "charset.h"
-#include "fontset.h"
+#include "dispextern.h"
#include "w32term.h"
#include "frame.h"
#include "window.h"
#include "buffer.h"
-#include "dispextern.h"
+#include "fontset.h"
#include "intervals.h"
#include "keyboard.h"
#include "blockinput.h"
#include <shellapi.h>
#include <ctype.h>
+#define max(a, b) ((a) > (b) ? (a) : (b))
+
extern void free_frame_menubar ();
extern double atof ();
-extern struct scroll_bar *x_window_to_scroll_bar ();
extern int w32_console_toggle_lock_key (int vk_code, Lisp_Object new_state);
extern int quit_char;
/* Modifier associated with Scroll Lock, or nil to act as a normal key. */
Lisp_Object Vw32_scroll_lock_modifier;
-/* Switch to control whether we inhibit requests for synthesyzed bold
+/* Switch to control whether we inhibit requests for synthesized bold
and italic versions of fonts. */
Lisp_Object Vw32_enable_synthesized_fonts;
/* 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. */
-int display_busy_cursor_p;
+/* Non-zero means we're allowed to display a hourglass pointer. */
+
+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. */
+
Lisp_Object Vx_sensitive_text_pointer_shape;
/* Color of chars displayed in cursor box. */
+
Lisp_Object Vx_cursor_fore_pixel;
/* Nonzero if using Windows. */
+
static int w32_in_use;
/* Search path for bitmap files. */
+
Lisp_Object Vx_bitmap_file_path;
/* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
+
Lisp_Object Vx_pixel_size_width_font_regexp;
/* Alist of bdf fonts and the files that define them. */
indicates there is an update region. */
int w32_strict_painting;
-/* 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 &&&*/
+/* Associative list linking character set strings to Windows codepages. */
+Lisp_Object Vw32_charset_info_alist;
+
+/* VIETNAMESE_CHARSET is not defined in some versions of MSVC. */
+#ifndef VIETNAMESE_CHARSET
+#define VIETNAMESE_CHARSET 163
+#endif
+
Lisp_Object Qauto_raise;
Lisp_Object Qauto_lower;
Lisp_Object Qbar;
Lisp_Object Quser_position;
Lisp_Object Quser_size;
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 Qcontrol;
Lisp_Object Qshift;
+Lisp_Object Qw32_charset_ansi;
+Lisp_Object Qw32_charset_default;
+Lisp_Object Qw32_charset_symbol;
+Lisp_Object Qw32_charset_shiftjis;
+Lisp_Object Qw32_charset_hangeul;
+Lisp_Object Qw32_charset_gb2312;
+Lisp_Object Qw32_charset_chinesebig5;
+Lisp_Object Qw32_charset_oem;
+
+#ifndef JOHAB_CHARSET
+#define JOHAB_CHARSET 130
+#endif
+#ifdef JOHAB_CHARSET
+Lisp_Object Qw32_charset_easteurope;
+Lisp_Object Qw32_charset_turkish;
+Lisp_Object Qw32_charset_baltic;
+Lisp_Object Qw32_charset_russian;
+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;
+#endif
+
+#ifdef UNICODE_CHARSET
+Lisp_Object Qw32_charset_unicode;
+#endif
+
extern Lisp_Object Qtop;
extern Lisp_Object Qdisplay;
extern Lisp_Object Qtool_bar_lines;
#define MOUSE_MOVE_ID 2
/* The below are defined in frame.c. */
+
extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
extern Lisp_Object Qtool_bar_lines;
Lisp_Object Qface_set_after_frame_default;
-extern Lisp_Object last_mouse_scroll_bar;
-extern int last_mouse_scroll_bar_pos;
+#ifdef GLYPH_DEBUG
+int image_cache_refcount, dpyinfo_refcount;
+#endif
+
/* From w32term.c. */
extern Lisp_Object Vw32_num_mouse_buttons;
f = XFRAME (frame);
if (!FRAME_W32_P (f) || FRAME_W32_DISPLAY_INFO (f) != dpyinfo)
continue;
+ if (f->output_data.w32->hourglass_window == wdesc)
+ return f;
+
+ /* 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));
void x_set_mouse_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
void x_set_cursor_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
"vertical-scroll-bars", x_set_vertical_scroll_bars,
"visibility", x_set_visibility,
"tool-bar-lines", x_set_tool_bar_lines,
- "screen-gamma", x_set_screen_gamma
+ "screen-gamma", x_set_screen_gamma,
+ "line-spacing", x_set_line_spacing
};
/* Attach the `x-frame-parameter' properties to
the Lisp symbol names of parameters relevant to W32. */
+void
init_x_parm_symbols ()
{
int i;
make_number (i));
}
\f
-/* Change the parameters of FRAME as specified by ALIST.
+/* Change the parameters of frame F as specified by ALIST.
If a parameter is not specially recognized, do nothing;
otherwise call the `x_set_...' function for that parameter. */
values[i] = Fcdr (elt);
i++;
}
-
/* TAIL and ALIST are not used again below here. */
alist = tail = Qnil;
icon_left = icon_top = Qunbound;
/* Provide default values for HEIGHT and WIDTH. */
- width = FRAME_WIDTH (f);
- height = FRAME_HEIGHT (f);
+ if (FRAME_NEW_WIDTH (f))
+ width = FRAME_NEW_WIDTH (f);
+ else
+ width = FRAME_WIDTH (f);
+
+ if (FRAME_NEW_HEIGHT (f))
+ height = FRAME_NEW_HEIGHT (f);
+ else
+ height = FRAME_HEIGHT (f);
/* Process foreground_color and background_color before anything else.
They are independent of other properties, but other properties (e.g.,
XSETFRAME (frame, f);
- if (XINT (width) != FRAME_WIDTH (f)
- || XINT (height) != FRAME_HEIGHT (f))
+ if (width != FRAME_WIDTH (f)
+ || height != FRAME_HEIGHT (f)
+ || FRAME_NEW_HEIGHT (f) || FRAME_NEW_WIDTH (f))
Fset_frame_size (frame, make_number (width), make_number (height));
if ((!NILP (left) || !NILP (top))
and whose values are not correctly recorded in the frame's
param_alist need to be considered here. */
+void
x_report_frame_params (f, alistptr)
struct frame *f;
Lisp_Object *alistptr;
x_to_w32_color (colorname)
char * colorname;
{
- register Lisp_Object tail, ret = Qnil;
-
+ register Lisp_Object ret = Qnil;
+
BLOCK_INPUT;
if (colorname[0] == '#')
return def;
}
\f
+/* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
+ the previous value of that parameter, NEW_VALUE is the new value. */
+
+static void
+x_set_line_spacing (f, new_value, old_value)
+ struct frame *f;
+ Lisp_Object new_value, old_value;
+{
+ if (NILP (new_value))
+ f->extra_line_spacing = 0;
+ else if (NATNUMP (new_value))
+ f->extra_line_spacing = XFASTINT (new_value);
+ else
+ Fsignal (Qerror, Fcons (build_string ("Invalid line-spacing"),
+ Fcons (new_value, Qnil)));
+ if (FRAME_VISIBLE_P (f))
+ redraw_frame (f);
+}
+
+
/* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
the previous value of that parameter, NEW_VALUE is the new value. */
/* The value 0.4545 is the normal viewing gamma. */
f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
else
- Fsignal (Qerror, Fcons (build_string ("Illegal screen-gamma"),
+ Fsignal (Qerror, Fcons (build_string ("Invalid screen-gamma"),
Fcons (new_value, Qnil)));
clear_face_cache (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 (!EQ (Vx_cursor_fore_pixel, Qnil))
+ 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);
}
}
update_face_from_frame_parameter (f, Qborder_color, arg);
}
-void
-x_set_cursor_type (f, arg, oldval)
- FRAME_PTR f;
- Lisp_Object arg, oldval;
+/* Value is the internal representation of the specified cursor type
+ ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
+ of the bar cursor. */
+
+enum text_cursor_kinds
+x_specified_cursor_type (arg, width)
+ Lisp_Object arg;
+ int *width;
{
+ enum text_cursor_kinds type;
+
if (EQ (arg, Qbar))
{
- FRAME_DESIRED_CURSOR (f) = BAR_CURSOR;
- f->output_data.w32->cursor_width = 2;
+ type = BAR_CURSOR;
+ *width = 2;
}
- else if (CONSP (arg) && EQ (XCAR (arg), Qbar)
- && INTEGERP (XCDR (arg)))
+ else if (CONSP (arg)
+ && EQ (XCAR (arg), Qbar)
+ && INTEGERP (XCDR (arg))
+ && XINT (XCDR (arg)) >= 0)
{
- FRAME_DESIRED_CURSOR (f) = BAR_CURSOR;
- f->output_data.w32->cursor_width = XINT (XCDR (arg));
+ type = BAR_CURSOR;
+ *width = XINT (XCDR (arg));
}
+ else if (NILP (arg))
+ type = NO_CURSOR;
else
/* Treat anything unknown as "box cursor".
It was bad to signal an error; people have trouble fixing
.Xdefaults with Emacs, when it has something bad in it. */
- FRAME_DESIRED_CURSOR (f) = FILLED_BOX_CURSOR;
+ type = FILLED_BOX_CURSOR;
+
+ return type;
+}
+
+void
+x_set_cursor_type (f, arg, oldval)
+ FRAME_PTR f;
+ Lisp_Object arg, oldval;
+{
+ int width;
+
+ FRAME_DESIRED_CURSOR (f) = x_specified_cursor_type (arg, &width);
+ f->output_data.w32->cursor_width = width;
/* Make sure the cursor gets redrawn. This is overkill, but how
often do people change cursor types? */
update_mode_lines++;
}
-
+\f
void
x_set_icon_type (f, arg, oldval)
struct frame *f;
struct frame *f;
Lisp_Object arg, oldval;
{
- int result;
-
if (STRINGP (arg))
{
if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
UNBLOCK_INPUT;
if (EQ (result, Qnil))
- error ("Font \"%s\" is not defined", XSTRING (arg)->data);
+ error ("Font `%s' is not defined", XSTRING (arg)->data);
else if (EQ (result, Qt))
- error ("the characters of the given font have varying widths");
+ 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;
+ }
}
if (FRAME_W32_WINDOW (f))
{
if (STRING_MULTIBYTE (name))
- name = string_make_unibyte (name);
+ name = ENCODE_SYSTEM (name);
BLOCK_INPUT;
SetWindowText(FRAME_W32_WINDOW (f), XSTRING (name)->data);
if (FRAME_W32_WINDOW (f))
{
if (STRING_MULTIBYTE (name))
- name = string_make_unibyte (name);
+ name = ENCODE_SYSTEM (name);
BLOCK_INPUT;
SetWindowText(FRAME_W32_WINDOW (f), XSTRING (name)->data);
unsigned char *p = XSTRING (Vx_resource_name)->data;
int i;
- len = XSTRING (Vx_resource_name)->size;
+ len = STRING_BYTES (XSTRING (Vx_resource_name));
/* Only letters, digits, - and _ are valid in resource names.
Count the valid characters and count the invalid ones. */
/* Allocate space for the components, the dots which separate them,
and the final '\0'. Make them big enough for the worst case. */
- name_key = (char *) alloca (XSTRING (Vx_resource_name)->size
+ name_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name))
+ (STRINGP (component)
- ? XSTRING (component)->size : 0)
- + XSTRING (attribute)->size
+ ? STRING_BYTES (XSTRING (component)) : 0)
+ + STRING_BYTES (XSTRING (attribute))
+ 3);
class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
- + XSTRING (class)->size
+ + STRING_BYTES (XSTRING (class))
+ (STRINGP (subclass)
- ? XSTRING (subclass)->size : 0)
+ ? STRING_BYTES (XSTRING (subclass)) : 0)
+ 3);
/* Start with emacs.FRAMENAME for the name (the specific one)
/* Allocate space for the components, the dots which separate them,
and the final '\0'. */
- name_key = (char *) alloca (XSTRING (Vinvocation_name)->size
+ name_key = (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name))
+ strlen (attribute) + 2);
class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
+ strlen (class) + 2);
}
/* Record in frame F the specified or default value according to ALIST
- of the parameter named PARAM (a Lisp symbol).
- If no value is specified for PARAM, look for an X default for XPROP
+ of the parameter named PROP (a Lisp symbol).
+ If no value is specified for PROP, look for an X default for XPROP
on the frame named NAME.
If that is not found either, use the value DEFLT. */
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;
are used together, but only if user has two button mouse. */
case WM_LBUTTONDOWN:
case WM_RBUTTONDOWN:
- if (XINT (Vw32_num_mouse_buttons) == 3)
+ if (XINT (Vw32_num_mouse_buttons) > 2)
goto handle_plain_button;
{
case WM_LBUTTONUP:
case WM_RBUTTONUP:
- if (XINT (Vw32_num_mouse_buttons) == 3)
+ if (XINT (Vw32_num_mouse_buttons) > 2)
goto handle_plain_button;
{
f->output_data.w32->menubar_active = 0;
goto dflt;
+ case WM_MENUSELECT:
+ wmsg.dwModifiers = w32_get_modifiers ();
+ my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
+ return 0;
+
case WM_MEASUREITEM:
f = x_window_to_frame (dpyinfo, hwnd);
if (f)
menu_font = CreateFontIndirect (&menu_logfont);
old_font = SelectObject (hdc, menu_font);
- GetTextExtentPoint32 (hdc, title, strlen (title), &size);
- pMis->itemWidth = size.cx;
- pMis->itemHeight = GetSystemMetrics (SM_CYMENUSIZE);
- if (pMis->itemHeight < size.cy)
- pMis->itemHeight = size.cy;
+ pMis->itemHeight = GetSystemMetrics (SM_CYMENUSIZE);
+ if (title)
+ {
+ GetTextExtentPoint32 (hdc, title, strlen (title), &size);
+ pMis->itemWidth = size.cx;
+ if (pMis->itemHeight < size.cy)
+ pMis->itemHeight = size.cy;
+ }
+ else
+ pMis->itemWidth = 0;
SelectObject (hdc, old_font);
DeleteObject (menu_font);
{
/* Draw popup menu title. */
char * title = (char *) pDis->itemData;
- HDC hdc = pDis->hDC;
- HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
- LOGFONT menu_logfont;
- HFONT old_font;
-
- GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
- menu_logfont.lfWeight = FW_BOLD;
- menu_font = CreateFontIndirect (&menu_logfont);
- old_font = SelectObject (hdc, menu_font);
-
- /* Always draw title as if not selected. */
- ExtTextOut (hdc,
- pDis->rcItem.left + GetSystemMetrics (SM_CXMENUCHECK),
- pDis->rcItem.top,
- ETO_OPAQUE, &pDis->rcItem,
- title, strlen (title), NULL);
-
- SelectObject (hdc, old_font);
- DeleteObject (menu_font);
+ if (title)
+ {
+ HDC hdc = pDis->hDC;
+ HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
+ LOGFONT menu_logfont;
+ HFONT old_font;
+
+ GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
+ menu_logfont.lfWeight = FW_BOLD;
+ menu_font = CreateFontIndirect (&menu_logfont);
+ old_font = SelectObject (hdc, menu_font);
+
+ /* Always draw title as if not selected. */
+ ExtTextOut (hdc,
+ pDis->rcItem.left
+ + GetSystemMetrics (SM_CXMENUCHECK),
+ pDis->rcItem.top,
+ ETO_OPAQUE, &pDis->rcItem,
+ title, strlen (title), NULL);
+
+ SelectObject (hdc, old_font);
+ DeleteObject (menu_font);
+ }
return TRUE;
}
}
/* 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;
it to make_frame_without_minibuffer. */
frame = Qnil;
GCPRO4 (parms, parent, name, frame);
- tem = w32_get_arg (parms, Qminibuffer, 0, 0, RES_TYPE_SYMBOL);
+ tem = w32_get_arg (parms, Qminibuffer, "minibuffer", "Minibuffer",
+ RES_TYPE_SYMBOL);
if (EQ (tem, Qnone) || NILP (tem))
f = make_frame_without_minibuffer (Qnil, kb, display);
else if (EQ (tem, Qonly))
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);
if (!NILP (parent))
{
- f->output_data.w32->parent_desc = (Window) parent;
+ f->output_data.w32->parent_desc = (Window) XFASTINT (parent);
f->output_data.w32->explicit_parent = 1;
}
else
specbind (Qx_resource_name, name);
}
- /* Create fontsets from `global_fontset_alist' before handling fonts. */
- for (tem = Vglobal_fontset_alist; CONSP (tem); tem = XCDR (tem))
- fs_register_fontset (f, XCAR (tem));
-
/* Extract the window parameters from the supplied values
that are needed to determine window geometry. */
{
}
/* Try out a font which we hope has bold and italic variations. */
if (!STRINGP (font))
- font = x_new_font (f, "-*-Courier New-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
+ font = x_new_font (f, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
if (! STRINGP (font))
font = x_new_font (f, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
/* If those didn't work, look for something which will at least work. */
}
x_default_parameter (f, parms, Qborder_width, make_number (2),
- "borderwidth", "BorderWidth", RES_TYPE_NUMBER);
+ "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
/* This defaults to 2 in order to match xterm. We recognize either
internalBorderWidth or internalBorder (which is what xterm calls
it). */
Lisp_Object value;
value = w32_get_arg (parms, Qinternal_border_width,
- "internalBorder", "BorderWidth", RES_TYPE_NUMBER);
+ "internalBorder", "InternalBorder", RES_TYPE_NUMBER);
if (! EQ (value, Qunbound))
parms = Fcons (Fcons (Qinternal_border_width, value),
parms);
}
/* Default internalBorderWidth to 0 on Windows to match other programs. */
x_default_parameter (f, parms, Qinternal_border_width, make_number (0),
- "internalBorderWidth", "BorderWidth", RES_TYPE_NUMBER);
- x_default_parameter (f, parms, Qvertical_scroll_bars, Qt,
- "verticalScrollBars", "ScrollBars", RES_TYPE_BOOLEAN);
+ "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER);
+ x_default_parameter (f, parms, Qvertical_scroll_bars, Qright,
+ "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL);
/* Also do the stuff which must be set before the window exists. */
x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
"borderColor", "BorderColor", RES_TYPE_STRING);
x_default_parameter (f, parms, Qscreen_gamma, Qnil,
"screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
+ x_default_parameter (f, parms, Qline_spacing, Qnil,
+ "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
/* Init faces before x_default_parameter is called for scroll-bar
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);
- /* Set up faces after all frame parameters are known. */
- call1 (Qface_set_after_frame_default, frame);
-
/* Tell the server what size and position, etc, we want, and how
badly we want them. This should be done after we have the menu
bar so that its size can be taken into account. */
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);
+BOOL w32_to_x_font (LOGFONT * lplf, char * lpxstr, int len, char * charset);
-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;
return NULL;
font = (XFontStruct *) xmalloc (sizeof (XFontStruct));
+ bzero (font, sizeof (*font));
/* Set bdf to NULL to indicate that this is a Windows font. */
font->bdf = NULL;
{
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);
+ 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
? VARIABLE_PITCH : FIXED_PITCH);
lf.lfOutPrecision = ((font->tm.tmPitchAndFamily & TMPF_VECTOR)
? OUT_STROKE_PRECIS : OUT_STRING_PRECIS);
+
+ w32_cache_char_metrics (font);
}
UNBLOCK_INPUT;
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
{
/* The slot `encoding' specifies how to map a character
code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
- the font code-points (0:0x20..0x7F, 1:0xA0..0xFF, 0:0x2020..0x7F7F,
- the font code-points (0:0x20..0x7F, 1:0xA0..0xFF,
- 0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF, or
+ the font code-points (0:0x20..0x7F, 1:0xA0..0xFF), or
+ (0:0x20..0x7F, 1:0xA0..0xFF,
+ (0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF,
2:0xA020..0xFF7F). For the moment, we don't know which charset
uses this font. So, we set information in fontp->encoding[1]
which is never used by any charset. If mapping can't be
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))
{
{
if (font)
{
+ if (font->per_char) xfree (font->per_char);
if (font->bdf) w32_free_bdf_font (font->bdf);
if (font->hfont) DeleteObject(font->hfont);
* (registry "[^-]+")
* (encoding "[^-]+")
* )
- * (setq x-font-regexp
- * (concat "\\`\\*?[-?*]"
- * foundry - family - weight\? - slant\? - swidth - adstyle -
- * pixelsize - pointsize - resx - resy - spacing - registry -
- * encoding "[-?*]\\*?\\'"
- * ))
- * (setq x-font-regexp-head
- * (concat "\\`[-?*]" foundry - family - weight\? - slant\?
- * "\\([-*?]\\|\\'\\)"))
- * (setq x-font-regexp-slant (concat - slant -))
- * (setq x-font-regexp-weight (concat - weight -))
- * nil)
*/
-
-#define FONT_START "[-?]"
-#define FONT_FOUNDRY "[^-]+"
-#define FONT_FAMILY "\\([^-]+\\)" /* 1 */
-#define FONT_WEIGHT "\\(bold\\|demibold\\|medium\\)" /* 2 */
-#define FONT_WEIGHT_Q "\\([^-]*\\)" /* 2 */
-#define FONT_SLANT "\\([ior]\\)" /* 3 */
-#define FONT_SLANT_Q "\\([^-]?\\)" /* 3 */
-#define FONT_SWIDTH "\\([^-]*\\)" /* 4 */
-#define FONT_ADSTYLE "[^-]*"
-#define FONT_PIXELSIZE "[^-]*"
-#define FONT_POINTSIZE "\\([0-9][0-9]+\\|\\*\\)" /* 5 */
-#define FONT_RESX "[0-9][0-9]+"
-#define FONT_RESY "[0-9][0-9]+"
-#define FONT_SPACING "[cmp?*]"
-#define FONT_AVGWIDTH "[0-9]+"
-#define FONT_REGISTRY "[^-]+"
-#define FONT_ENCODING "[^-]+"
-
-#define FONT_REGEXP ("\\`\\*?[-?*]" \
- FONT_FOUNDRY "-" \
- FONT_FAMILY "-" \
- FONT_WEIGHT_Q "-" \
- FONT_SLANT_Q "-" \
- FONT_SWIDTH "-" \
- FONT_ADSTYLE "-" \
- FONT_PIXELSIZE "-" \
- FONT_POINTSIZE "-" \
- "[-?*]\\|\\'")
-
-#define FONT_REGEXP_HEAD ("\\`[-?*]" \
- FONT_FOUNDRY "-" \
- FONT_FAMILY "-" \
- FONT_WEIGHT_Q "-" \
- FONT_SLANT_Q \
- "\\([-*?]\\|\\'\\)")
-
-#define FONT_REGEXP_SLANT "-" FONT_SLANT "-"
-#define FONT_REGEXP_WEIGHT "-" FONT_WEIGHT "-"
-
-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;
{
- if (!lpcs) return (0);
-
- if (stricmp (lpcs,"ansi") == 0) return ANSI_CHARSET;
- else if (stricmp (lpcs,"iso8859-1") == 0) return ANSI_CHARSET;
- else if (stricmp (lpcs, "ms-symbol") == 0) return SYMBOL_CHARSET;
- /* Map all Japanese charsets to the Windows Shift-JIS charset. */
- else if (strnicmp (lpcs, "jis", 3) == 0) return SHIFTJIS_CHARSET;
- /* Map all GB charsets to the Windows GB2312 charset. */
- else if (strnicmp (lpcs, "gb2312", 6) == 0) return GB2312_CHARSET;
- /* Map all Big5 charsets to the Windows Big5 charset. */
- else if (strnicmp (lpcs, "big5", 4) == 0) return CHINESEBIG5_CHARSET;
- else if (stricmp (lpcs, "ksc5601.1987") == 0) return HANGEUL_CHARSET;
- else if (stricmp (lpcs, "ms-oem") == 0) return OEM_CHARSET;
+ Lisp_Object this_entry, w32_charset;
-#ifdef EASTEUROPE_CHARSET
- else if (stricmp (lpcs, "iso8859-2") == 0) return EASTEUROPE_CHARSET;
- else if (stricmp (lpcs, "iso8859-3") == 0) return TURKISH_CHARSET;
- else if (stricmp (lpcs, "iso8859-4") == 0) return BALTIC_CHARSET;
- else if (stricmp (lpcs, "iso8859-5") == 0) return RUSSIAN_CHARSET;
- else if (stricmp (lpcs, "koi8") == 0) return RUSSIAN_CHARSET;
- else if (stricmp (lpcs, "iso8859-6") == 0) return ARABIC_CHARSET;
- else if (stricmp (lpcs, "iso8859-7") == 0) return GREEK_CHARSET;
- else if (stricmp (lpcs, "iso8859-8") == 0) return HEBREW_CHARSET;
- else if (stricmp (lpcs, "iso8859-9") == 0) return TURKISH_CHARSET;
-#ifndef VIETNAMESE_CHARSET
-#define VIETNAMESE_CHARSET 163
-#endif
- /* Map all Viscii charsets to the Windows Vietnamese charset. */
- else if (strnicmp (lpcs, "viscii", 6) == 0) return VIETNAMESE_CHARSET;
- else if (strnicmp (lpcs, "vscii", 5) == 0) return VIETNAMESE_CHARSET;
- /* Map all TIS charsets to the Windows Thai charset. */
- else if (strnicmp (lpcs, "tis620", 6) == 0) return THAI_CHARSET;
- else if (stricmp (lpcs, "mac") == 0) return MAC_CHARSET;
- else if (stricmp (lpcs, "ksc5601.1992") == 0) return JOHAB_CHARSET;
- /* For backwards compatibility with previous 20.4 pretests, map
- non-specific KSC charsets to the Windows Hangeul charset. */
- else if (strnicmp (lpcs, "ksc5601", 7) == 0) return HANGEUL_CHARSET;
- else if (stricmp (lpcs, "johab") == 0) return JOHAB_CHARSET;
-#endif
+ /* Look through w32-charset-info-alist for the character set.
+ Format of each entry is
+ (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
+ */
+ this_entry = Fassoc (build_string(lpcs), Vw32_charset_info_alist);
+ 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_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
- else if (stricmp (lpcs,"iso10646") == 0) return UNICODE_CHARSET;
- else if (stricmp (lpcs, "unicode") == 0) return UNICODE_CHARSET;
+ if (w32_charset == Qw32_charset_unicode)
+ return UNICODE_CHARSET;
#endif
- else if (lpcs[0] == '#') return atoi (lpcs + 1);
- else
- return DEFAULT_CHARSET;
+
+ return DEFAULT_CHARSET;
}
-char *
+
+static char *
w32_to_x_charset (fncharset)
int fncharset;
{
static char buf[16];
+ Lisp_Object charset_type;
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;
+ }
}
-BOOL
-w32_to_x_font (lplogfont, lpxstr, len)
+
+/* Get the Windows codepage corresponding to the specified font. The
+ charset info in the font name is used to look up
+ w32-charset-to-codepage-alist. */
+int
+w32_codepage_for_font (char *fontname)
+{
+ Lisp_Object codepage, entry;
+ char *charset_str, *charset, *end;
+
+ 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;
+ else
+ charset = charset_str;
+
+ /* Stop match at wildcard (including preceding '-'). */
+ if (end = strchr (charset, '*'))
+ {
+ if (end > charset && *(end-1) == '-')
+ end--;
+ *end = '\0';
+ }
+
+ 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_UNKNOWN;
+}
+
+
+static BOOL
+w32_to_x_font (lplogfont, lpxstr, len, specific_charset)
LOGFONT * lplogfont;
char * lpxstr;
int len;
+ char * specific_charset;
{
char* fonttype;
char *fontname;
setup_coding_system (Fcheck_coding_system (Vw32_system_coding_system),
&coding);
+ coding.src_multibyte = 0;
+ coding.dst_multibyte = 1;
coding.mode |= CODING_MODE_LAST_BLOCK;
bufsz = decoding_buffer_size (&coding, LF_FACESIZE);
((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;
char name[50], weight[20], slant, pitch, pixels[10], height[10],
width[10], resy[10], remainder[20];
char * encoding;
- int dpi = one_w32_display_info.height_in;
+ int dpi = one_w32_display_info.resy;
fields = sscanf (lpxstr,
"-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%9[^-]-%c-%9[^-]-%19s",
setup_coding_system
(Fcheck_coding_system (Vw32_system_coding_system), &coding);
+ coding.src_multibyte = 1;
+ coding.dst_multibyte = 1;
bufsize = encoding_buffer_size (&coding, strlen (name));
buf = (unsigned char *) alloca (bufsize);
coding.mode |= CODING_MODE_LAST_BLOCK;
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,
- "Return non-nil if color COLOR is supported on frame FRAME.\n\
-If FRAME is omitted or nil, use the selected frame.")
+ "Internal function called by `color-defined-p', which see.")
(color, frame)
Lisp_Object color, frame;
{
}
DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
- "Return a description of the color named COLOR on frame FRAME.\n\
-The value is a list of integer RGB values--(RED GREEN BLUE).\n\
-These values appear to range from 0 to 65280 or 65535, depending\n\
-on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
-If FRAME is omitted or nil, use the selected frame.")
+ "Internal function called by `color-values', which see.")
(color, frame)
Lisp_Object color, frame;
{
}
DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
- "Return t if the X display supports color.\n\
-The optional argument DISPLAY specifies which display to ask about.\n\
-DISPLAY should be either a frame or a display name (a string).\n\
-If omitted or nil, that stands for the selected frame's display.")
+ "Internal function called by `display-color-p', which see.")
(display)
Lisp_Object display;
{
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);
(display)
Lisp_Object display;
{
- struct w32_display_info *dpyinfo = check_x_display_info (display);
- char *vendor = "Microsoft Corp.";
-
- if (! vendor) vendor = "";
- return build_string (vendor);
+ return build_string ("Microsoft Corp.");
}
DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
(display)
Lisp_Object display;
{
- struct w32_display_info *dpyinfo = check_x_display_info (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,
If omitted or nil, that stands for the selected frame's display.")
(display)
Lisp_Object display;
-{
- struct w32_display_info *dpyinfo = check_x_display_info (display);
-
+{
return make_number (1);
}
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,
(display)
Lisp_Object display;
{
- struct w32_display_info *dpyinfo = check_x_display_info (display);
-
return Qnil;
}
\f
for (i = 0; i < dpyinfo->n_fonts; i++)
if (dpyinfo->font_table[i].name)
{
+ if (dpyinfo->font_table[i].name != dpyinfo->font_table[i].full_name)
+ xfree (dpyinfo->font_table[i].full_name);
xfree (dpyinfo->font_table[i].name);
- /* Don't free the full_name string;
- it is always shared with something else. */
w32_unload_font (dpyinfo, dpyinfo->font_table[i].font);
}
x_destroy_all_bitmaps (dpyinfo);
(on, display)
Lisp_Object display, on;
{
- struct w32_display_info *dpyinfo = check_x_display_info (display);
-
return Qnil;
}
static struct image_type *image_types;
-/* A list of symbols, one for each supported image type. */
-
-Lisp_Object Vimage_types;
-
/* The symbol `image' which is the car of the lists used to represent
images in Lisp. */
/* Keywords. */
-Lisp_Object QCtype, QCdata, QCascent, QCmargin, QCrelief;
extern Lisp_Object QCwidth, QCheight, QCforeground, QCbackground, QCfile;
-Lisp_Object QCalgorithm, QCcolor_symbols, QCheuristic_mask;
-extern Lisp_Object QCindex;
+extern Lisp_Object QCdata;
+Lisp_Object QCtype, QCascent, QCmargin, QCrelief;
+Lisp_Object QCconversion, QCcolor_symbols, QCheuristic_mask;
+Lisp_Object QCindex;
/* Other symbols. */
static int x_build_heuristic_mask P_ ((struct frame *, struct image *,
Lisp_Object));
+
/* Define a new image type from TYPE. This adds a copy of TYPE to
image_types and adds the symbol *TYPE->type to Vimage_types. */
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,
IMAGE_FUNCTION_VALUE,
IMAGE_NUMBER_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;
+ else if (INTEGERP (value)
+ && XINT (value) >= 0
+ && XINT (value) <= 100)
+ break;
+ return 0;
+
case IMAGE_NON_NEGATIVE_INTEGER_VALUE:
if (!INTEGERP (value) || XINT (value) < 0)
return 0;
}
+/* Value is the number of pixels for the ascent of image IMG when
+ drawn in face FACE. */
+
+int
+image_ascent (img, face)
+ struct image *img;
+ struct face *face;
+{
+ int height = img->height + img->vmargin;
+ int ascent;
+
+ if (img->ascent == CENTERED_IMAGE_ASCENT)
+ {
+ if (face->font)
+ ascent = height / 2 - (FONT_DESCENT(face->font)
+ - FONT_BASE(face->font)) / 2;
+ else
+ ascent = height / 2;
+ }
+ else
+ ascent = height * img->ascent / 100.0;
+
+ return ascent;
+}
+
+
\f
/***********************************************************************
Helper functions for X image types
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;
/* Clear image cache of frame F. FORCE_P non-zero means free all
images. FORCE_P zero means clear only images that haven't been
displayed for some time. Should be called from time to time to
- reduce the number of loaded images. If image-cache-eveiction-delay
- is non-nil, this frees images in the cache which weren't displayed for
+ reduce the number of loaded images. If image-eviction-seconds is
+ non-nil, this frees images in the cache which weren't displayed for
at least that many seconds. */
void
/* 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))
img->ascent = XFASTINT (ascent);
-
+ else if (EQ (ascent, Qcenter))
+ img->ascent = CENTERED_IMAGE_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}
};
/* Configure the XPM lib. Use the visual of frame F. Allocate
close colors. Return colors allocated. */
bzero (&attrs, sizeof attrs);
- attrs.visual = FRAME_W32_DISPLAY_INFO (f)->visual;
+ attrs.visual = FRAME_X_VISUAL (f);
+ attrs.colormap = FRAME_X_COLORMAP (f);
attrs.valuemask |= XpmVisual;
+ attrs.valuemask |= XpmColormap;
attrs.valuemask |= XpmReturnAllocPixels;
+#ifdef XpmAllocCloseColors
attrs.alloc_close_colors = 1;
attrs.valuemask |= XpmAllocCloseColors;
+#else
+ attrs.closeness = 600;
+ attrs.valuemask |= XpmCloseness;
+#endif
/* If image specification contains symbolic color definitions, add
these to `attrs'. */
#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}
};
return 0;
}
- if (*magic != 'P')
- {
- fclose (fp);
- image_error ("Not a PBM image file: %s", file, Qnil);
- UNGCPRO;
- return 0;
- }
-
switch (*p++)
{
case '1':
if (r < 0 || g < 0 || b < 0)
{
-b xfree (ximg->data);
+ xfree (ximg->data);
ximg->data = NULL;
XDestroyImage (ximg);
UNBLOCK_INPUT;
{":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_error ("PNG warning: %s", build_string (msg), Qnil);
}
-
/* Memory source for PNG decoding. */
struct png_memory_storage
tbr->index = tbr->index + length;
}
-
/* Load PNG image IMG for use on frame F. Value is non-zero if
successful. */
tbr.bytes += sizeof (sig);
}
-
/* Initialize read and info structs for PNG lib. */
png_ptr = png_create_read_struct (PNG_LIBPNG_VER_STRING, NULL,
my_png_error, my_png_warning);
{":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}
};
longjmp (mgr->setjmp_buffer, 1);
}
-
/* Init source method for JPEG data source manager. Called by
jpeg_read_header() before any data is actually read. See
libjpeg.doc from the JPEG lib distribution. */
file = Qnil;
GCPRO1 (file);
-
if (NILP (specified_data))
{
file = x_find_image_file (specified_file);
{":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}
};
return ((tiff_memory_source *) data)->len;
}
-
/* Load TIFF image IMG for use on frame F. Value is non-zero if
successful. */
{":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}
};
specified_file = image_spec_value (img->spec, QCfile, NULL);
specified_data = image_spec_value (img->spec, QCdata, NULL);
file = Qnil;
+ GCPRO1 (file);
if (NILP (specified_data))
{
file = x_find_image_file (specified_file);
- GCPRO1 (file);
if (!STRINGP (file))
{
image_error ("Cannot find image file `%s'", specified_file, Qnil);
{":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;
}
Busy cursor
***********************************************************************/
-/* The implementation partly follows a patch from
- F.Pierresteguy@frcl.bull.fr dated 1994. */
+/* If non-null, an asynchronous timer that, when it expires, displays
+ an hourglass cursor on all frames. */
-/* Setting inhibit_busy_cursor to 2 inhibits busy-cursor display until
- the next X event is read and we enter XTread_socket again. Setting
- it to 1 inhibits busy-cursor display for direct commands. */
+static struct atimer *hourglass_atimer;
-int inhibit_busy_cursor;
+/* Non-zero means an hourglass cursor is currently shown. */
-/* Incremented with each call to x-display-busy-cursor.
- Decremented in x-undisplay-busy-cursor. */
+static int hourglass_shown_p;
-static int busy_count;
+/* Number of seconds to wait before displaying an hourglass cursor. */
+static Lisp_Object Vhourglass_delay;
-DEFUN ("x-show-busy-cursor", Fx_show_busy_cursor,
- Sx_show_busy_cursor, 0, 0, 0,
- "Show a busy cursor, if not already shown.\n\
-Each call to this function must be matched by a call to\n\
-x-undisplay-busy-cursor to make the busy pointer disappear again.")
- ()
+/* Default number of seconds to wait before displaying an hourglass
+ cursor. */
+
+#define DEFAULT_HOURGLASS_DELAY 1
+
+/* Function prototypes. */
+
+static void show_hourglass P_ ((struct atimer *));
+static void hide_hourglass P_ ((void));
+
+
+/* Cancel a currently active hourglass timer, and start a new one. */
+
+void
+start_hourglass ()
{
- ++busy_count;
- if (busy_count == 1)
+#if 0 /* TODO: cursor shape changes. */
+ EMACS_TIME delay;
+ int secs, usecs = 0;
+
+ cancel_hourglass ();
+
+ if (INTEGERP (Vhourglass_delay)
+ && XINT (Vhourglass_delay) > 0)
+ secs = XFASTINT (Vhourglass_delay);
+ else if (FLOATP (Vhourglass_delay)
+ && XFLOAT_DATA (Vhourglass_delay) > 0)
{
- Lisp_Object rest, frame;
+ Lisp_Object tem;
+ tem = Ftruncate (Vhourglass_delay, Qnil);
+ secs = XFASTINT (tem);
+ usecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000000;
+ }
+ else
+ secs = DEFAULT_HOURGLASS_DELAY;
+
+ EMACS_SET_SECS_USECS (delay, secs, usecs);
+ hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay,
+ show_hourglass, NULL);
+#endif
+}
+
+
+/* Cancel the hourglass cursor timer if active, hide an hourglass
+ cursor if shown. */
+
+void
+cancel_hourglass ()
+{
+ if (hourglass_atimer)
+ {
+ cancel_atimer (hourglass_atimer);
+ hourglass_atimer = NULL;
+ }
+
+ if (hourglass_shown_p)
+ hide_hourglass ();
+}
+
+
+/* Timer function of hourglass_atimer. TIMER is equal to
+ hourglass_atimer.
+
+ 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_hourglass (timer)
+ struct atimer *timer;
+{
+#if 0 /* TODO: cursor shape changes. */
+ /* The timer implementation will cancel this timer automatically
+ after this function has run. Set hourglass_atimer to null
+ so that we know the timer doesn't have to be canceled. */
+ hourglass_atimer = NULL;
+
+ 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);
-#if 0 /* NTEMACS_TODO : busy cursor */
-
- BLOCK_INPUT;
- f->output_data.w32->busy_p = 1;
-
- if (!f->output_data.w32->busy_window)
+
+ f->output_data.w32->hourglass_p = 1;
+
+ if (!f->output_data.w32->hourglass_window)
{
unsigned long mask = CWCursor;
XSetWindowAttributes attrs;
-
- attrs.cursor = f->output_data.w32->busy_cursor;
- f->output_data.w32->busy_window
- = XCreateWindow (FRAME_W32_DISPLAY (f),
+
+ attrs.cursor = f->output_data.w32->hourglass_cursor;
+
+ f->output_data.w32->hourglass_window
+ = XCreateWindow (FRAME_X_DISPLAY (f),
FRAME_OUTER_WINDOW (f),
0, 0, 32000, 32000, 0, 0,
- InputOnly, CopyFromParent,
+ InputOnly,
+ CopyFromParent,
mask, &attrs);
}
-
- XMapRaised (FRAME_W32_DISPLAY (f), f->output_data.w32->busy_window);
- UNBLOCK_INPUT;
-#endif
+
+ XMapRaised (FRAME_X_DISPLAY (f),
+ f->output_data.w32->hourglass_window);
+ XFlush (FRAME_X_DISPLAY (f));
}
- }
- return Qnil;
+ hourglass_shown_p = 1;
+ UNBLOCK_INPUT;
+ }
+#endif
}
-DEFUN ("x-hide-busy-cursor", Fx_hide_busy_cursor,
- Sx_hide_busy_cursor, 0, 1, 0,
- "Hide a busy-cursor.\n\
-A busy-cursor will actually be undisplayed when a matching\n\
-`x-undisplay-busy-cursor' is called for each `x-display-busy-cursor'\n\
-issued. FORCE non-nil means undisplay the busy-cursor forcibly,\n\
-not counting calls.")
- (force)
- Lisp_Object force;
-{
- Lisp_Object rest, frame;
-
- if (busy_count == 0)
- return Qnil;
-
- if (!NILP (force) && busy_count != 0)
- busy_count = 1;
+/* Hide the hourglass cursor on all frames, if it is currently shown. */
- --busy_count;
- if (busy_count != 0)
- return Qnil;
-
- FOR_EACH_FRAME (rest, frame)
+static void
+hide_hourglass ()
+{
+#if 0 /* TODO: cursor shape changes. */
+ if (hourglass_shown_p)
{
- struct frame *f = XFRAME (frame);
-
- if (FRAME_X_P (f)
- /* Watch out for newly created frames. */
- && f->output_data.w32->busy_window)
+ Lisp_Object rest, frame;
+
+ BLOCK_INPUT;
+ FOR_EACH_FRAME (rest, frame)
{
-#if 0 /* NTEMACS_TODO : busy cursor */
- BLOCK_INPUT;
- XUnmapWindow (FRAME_W32_DISPLAY (f), f->output_data.w32->busy_window);
- /* Sync here because XTread_socket looks at the busy_p flag
- that is reset to zero below. */
- XSync (FRAME_W32_DISPLAY (f), False);
- UNBLOCK_INPUT;
- f->output_data.w32->busy_p = 0;
-#endif
+ struct frame *f = XFRAME (frame);
+
+ if (FRAME_W32_P (f)
+ /* Watch out for newly created frames. */
+ && f->output_data.x->hourglass_window)
+ {
+ 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->hourglass_p = 0;
+ }
}
- }
- return Qnil;
+ 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
specbind (Qx_resource_name, name);
}
- /* Create fontsets from `global_fontset_alist' before handling fonts. */
- for (tem = Vglobal_fontset_alist; CONSP (tem); tem = XCDR (tem))
- fs_register_fontset (f, XCAR (tem));
-
/* Extract the window parameters from the supplied values
that are needed to determine window geometry. */
{
/* Try out a font which we hope has bold and italic variations. */
if (!STRINGP (font))
- font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
+ font = x_new_font (f, "-*-courier new-normal-r-*-*-*-100-*-*-*-*-iso8859-1");
if (!STRINGP (font))
font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
if (! STRINGP (font))
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;
}
-
-DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 4, 0,
+#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 STRING at\n\
-the current mouse position.\n\
+A tooltip window is a small window displaying a string.\n\
+\n\
FRAME nil or omitted means use the selected frame.\n\
+\n\
PARMS is an optional list of frame parameters which can be\n\
used to change the tooltip's appearance.\n\
+\n\
Automatically hide the tooltip after TIMEOUT seconds.\n\
-TIMEOUT nil means use the default timeout of 5 seconds.")
- (string, frame, parms, timeout)
- Lisp_Object string, frame, parms, timeout;
+TIMEOUT nil means use the default timeout of 5 seconds.\n\
+\n\
+If the list of frame parameters PARAMS contains a `left' parameters,\n\
+the tooltip is displayed at that x-position. Otherwise it is\n\
+displayed at the mouse position, with offset DX added (default is 5 if\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 10).")
+ (string, frame, parms, timeout, dx, dy)
+ Lisp_Object string, frame, parms, timeout, dx, dy;
{
struct frame *f;
struct window *w;
Window root, child;
- Lisp_Object buffer;
+ Lisp_Object buffer, top, left;
struct buffer *old_buffer;
struct text_pos pos;
int i, width, height;
specbind (Qinhibit_redisplay, Qt);
- GCPRO3 (string, parms, frame, timeout);
+ GCPRO4 (string, parms, frame, timeout);
CHECK_STRING (string, 0);
f = check_x_frame (frame);
else
CHECK_NATNUM (timeout, 2);
+ if (NILP (dx))
+ dx = make_number (5);
+ else
+ CHECK_NUMBER (dx, 5);
+
+ if (NILP (dy))
+ 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);
/* Move the tooltip window where the mouse pointer is. Resize and
show it. */
-#if 0 /* NTEMACS_TODO : W32 specifics */
+ compute_tip_xy (f, parms, dx, dy, &root_x, &root_y);
+
+#if 0 /* TODO : W32 specifics */
BLOCK_INPUT;
- XQueryPointer (FRAME_W32_DISPLAY (f), FRAME_W32_DISPLAY_INFO (f)->root_window,
- &root, &child, &root_x, &root_y, &win_x, &win_y, &pmask);
- XMoveResizeWindow (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
- root_x + 5, root_y - height - 5, width, height);
- XMapRaised (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f));
+ 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"));
- UNGCPRO;
+ UNGCPRO;
return unbind_to (count, Qnil);
}
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);
if (NILP (file))
Fsignal (Qquit, Qnil);
- return file;
+ return unbind_to (count, file);
}
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
&& !NILP (Vw32_alt_is_meta))
lisp_modifiers |= alt_modifier;
+ /* Supply defs missing from mingw32. */
+#ifndef MOD_ALT
+#define MOD_ALT 0x0001
+#define MOD_CONTROL 0x0002
+#define MOD_SHIFT 0x0004
+#define MOD_WIN 0x0008
+#endif
+
/* Convert lisp modifiers to Windows hot-key form. */
w32_modifiers = (lisp_modifiers & hyper_modifier) ? MOD_WIN : 0;
w32_modifiers |= (lisp_modifiers & alt_modifier) ? MOD_ALT : 0;
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 (&Quser_position);
Quser_size = intern ("user-size");
staticpro (&Quser_size);
-#if 0 /* Duplicate initialization in xdisp.c */
- Qdisplay = intern ("display");
- staticpro (&Qdisplay);
-#endif
Qscreen_gamma = intern ("screen-gamma");
staticpro (&Qscreen_gamma);
+ Qline_spacing = intern ("line-spacing");
+ 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");
Any other value will cause the key to be ignored.");
Vw32_apps_modifier = Qnil;
- DEFVAR_LISP ("w32-enable-synthesized_fonts", &Vw32_enable_synthesized_fonts,
+ DEFVAR_LISP ("w32-enable-synthesized-fonts", &Vw32_enable_synthesized_fonts,
"Non-nil enables selection of artificially italicized and bold fonts.");
Vw32_enable_synthesized_fonts = Qnil;
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 ("hourglass-delay", &Vhourglass_delay,
+ "*Seconds to wait before displaying an hourglass pointer.\n\
+Value must be an integer or float.");
+ Vhourglass_delay = make_number (DEFAULT_HOURGLASS_DELAY);
+
DEFVAR_LISP ("x-sensitive-text-pointer-shape",
&Vx_sensitive_text_pointer_shape,
"The shape of the pointer when over mouse-sensitive text.\n\
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;
meaning don't clear the cache.");
Vimage_cache_eviction_delay = make_number (30 * 60);
- DEFVAR_LISP ("image-types", &Vimage_types,
- "List of supported image types.\n\
-Each element of the list is a symbol for a supported image type.");
- Vimage_types = Qnil;
-
DEFVAR_LISP ("w32-bdf-filename-alist",
&Vw32_bdf_filename_alist,
"List of bdf fonts and their corresponding filenames.");
"Coding system used by Windows system functions, such as for font names.");
Vw32_system_coding_system = Qnil;
+ DEFVAR_LISP ("w32-charset-info-alist",
+ &Vw32_charset_info_alist,
+ "Alist linking Emacs character sets to Windows fonts\n\
+and codepages. Each entry should be of the form:\n\
+\n\
+ (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))\n\
+\n\
+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-hangeul, w32-charset-gb2312,\n\
+w32-charset-chinesebig5, "
+#ifdef JOHAB_CHARSET
+"w32-charset-johab, w32-charset-hebrew,\n\
+w32-charset-arabic, w32-charset-greek, w32-charset-turkish,\n\
+w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,\n\
+w32-charset-russian, w32-charset-mac, w32-charset-baltic,\n"
+#endif
+#ifdef UNICODE_CHARSET
+"w32-charset-unicode, "
+#endif
+"or w32-charset-oem.\n\
+CODEPAGE should be an integer specifying the codepage that should be used\n\
+to display the character set, t to do no translation and output as Unicode,\n\
+or nil to do no translation and output as 8 bit (or multibyte on far-east\n\
+versions of Windows) characters.");
+ Vw32_charset_info_alist = Qnil;
+
+ staticpro (&Qw32_charset_ansi);
+ Qw32_charset_ansi = intern ("w32-charset-ansi");
+ staticpro (&Qw32_charset_symbol);
+ Qw32_charset_symbol = intern ("w32-charset-symbol");
+ staticpro (&Qw32_charset_shiftjis);
+ Qw32_charset_shiftjis = intern ("w32-charset-shiftjis");
+ 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);
+ Qw32_charset_gb2312 = intern ("w32-charset-gb2312");
+ staticpro (&Qw32_charset_oem);
+ Qw32_charset_oem = intern ("w32-charset-oem");
+
+#ifdef JOHAB_CHARSET
+ {
+ static int w32_extra_charsets_defined = 1;
+ DEFVAR_BOOL ("w32-extra-charsets-defined", &w32_extra_charsets_defined, "");
+
+ staticpro (&Qw32_charset_johab);
+ Qw32_charset_johab = intern ("w32-charset-johab");
+ staticpro (&Qw32_charset_easteurope);
+ Qw32_charset_easteurope = intern ("w32-charset-easteurope");
+ staticpro (&Qw32_charset_turkish);
+ Qw32_charset_turkish = intern ("w32-charset-turkish");
+ staticpro (&Qw32_charset_baltic);
+ Qw32_charset_baltic = intern ("w32-charset-baltic");
+ staticpro (&Qw32_charset_russian);
+ Qw32_charset_russian = intern ("w32-charset-russian");
+ staticpro (&Qw32_charset_arabic);
+ Qw32_charset_arabic = intern ("w32-charset-arabic");
+ staticpro (&Qw32_charset_greek);
+ 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);
+ Qw32_charset_mac = intern ("w32-charset-mac");
+ }
+#endif
+
+#ifdef UNICODE_CHARSET
+ {
+ static int w32_unicode_charset_defined = 1;
+ DEFVAR_BOOL ("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");
staticpro (&QCcolor_symbols);
- QCdata = intern (":data");
- staticpro (&QCdata);
QCascent = intern (":ascent");
staticpro (&QCascent);
QCmargin = intern (":margin");
defsubr (&Simagep);
defsubr (&Slookup_image);
#endif
-#endif /* NTEMACS_TODO */
-
- /* Busy-cursor. */
- defsubr (&Sx_show_busy_cursor);
- defsubr (&Sx_hide_busy_cursor);
- busy_count = 0;
- inhibit_busy_cursor = 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