X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/abf8c61b624d713f50912523d63deff2ad0ca6fb..296808a500931376ad44f071d801564ed1372d47:/src/w32fns.c diff --git a/src/w32fns.c b/src/w32fns.c index ab750acbac..113305ccc9 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -1,5 +1,5 @@ /* 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. @@ -32,12 +32,12 @@ Boston, MA 02111-1307, USA. */ #include "charset.h" #include "dispextern.h" #include "w32term.h" +#include "keyboard.h" #include "frame.h" #include "window.h" #include "buffer.h" #include "fontset.h" #include "intervals.h" -#include "keyboard.h" #include "blockinput.h" #include "epaths.h" #include "w32heap.h" @@ -146,15 +146,15 @@ Lisp_Object Vx_resource_name; /* Non nil if no window manager is in use. */ Lisp_Object Vx_no_window_manager; -/* Non-zero means we're allowed to display a busy cursor. */ +/* Non-zero means we're allowed to display a hourglass pointer. */ -int display_busy_cursor_p; +int display_hourglass_p; /* The background and shape of the mouse pointer, and shape when not over text or in the modeline. */ Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape; -Lisp_Object Vx_busy_pointer_shape, Vx_window_horizontal_drag_shape; +Lisp_Object Vx_hourglass_pointer_shape, Vx_window_horizontal_drag_shape; /* The shape when over mouse-sensitive text. */ @@ -196,42 +196,6 @@ Lisp_Object Vw32_charset_info_alist; #define VIETNAMESE_CHARSET 163 #endif - -/* Evaluate this expression to rebuild the section of syms_of_w32fns - that initializes and staticpros the symbols declared below. Note - that Emacs 18 has a bug that keeps C-x C-e from being able to - evaluate this expression. - -(progn - ;; Accumulate a list of the symbols we want to initialize from the - ;; declarations at the top of the file. - (goto-char (point-min)) - (search-forward "/\*&&& symbols declared here &&&*\/\n") - (let (symbol-list) - (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)") - (setq symbol-list - (cons (buffer-substring (match-beginning 1) (match-end 1)) - symbol-list)) - (forward-line 1)) - (setq symbol-list (nreverse symbol-list)) - ;; Delete the section of syms_of_... where we initialize the symbols. - (search-forward "\n /\*&&& init symbols here &&&*\/\n") - (let ((start (point))) - (while (looking-at "^ Q") - (forward-line 2)) - (kill-region start (point))) - ;; Write a new symbol initialization section. - (while symbol-list - (insert (format " %s = intern (\"" (car symbol-list))) - (let ((start (point))) - (insert (substring (car symbol-list) 1)) - (subst-char-in-region start (point) ?_ ?-)) - (insert (format "\");\n staticpro (&%s);\n" (car symbol-list))) - (setq symbol-list (cdr symbol-list))))) - - */ - -/*&&& symbols declared here &&&*/ Lisp_Object Qauto_raise; Lisp_Object Qauto_lower; Lisp_Object Qbar; @@ -264,6 +228,7 @@ 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; @@ -430,7 +395,7 @@ x_window_to_frame (dpyinfo, wdesc) f = XFRAME (frame); if (!FRAME_W32_P (f) || FRAME_W32_DISPLAY_INFO (f) != dpyinfo) continue; - if (f->output_data.w32->busy_window == wdesc) + if (f->output_data.w32->hourglass_window == wdesc) return f; /* TODO: Check tooltips when supported. */ @@ -1509,8 +1474,8 @@ COLORREF x_to_w32_color (colorname) char * colorname; { - register Lisp_Object tail, ret = Qnil; - + register Lisp_Object ret = Qnil; + BLOCK_INPUT; if (colorname[0] == '#') @@ -2066,14 +2031,14 @@ x_set_mouse_color (f, arg, oldval) 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"); @@ -2133,7 +2098,7 @@ x_set_mouse_color (f, arg, oldval) &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); } @@ -2149,10 +2114,10 @@ x_set_mouse_color (f, arg, oldval) 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) @@ -2347,8 +2312,6 @@ x_set_icon_name (f, arg, oldval) struct frame *f; Lisp_Object arg, oldval; { - int result; - if (STRINGP (arg)) { if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt)) @@ -2421,6 +2384,8 @@ x_set_font (f, arg, oldval) 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); } @@ -2579,6 +2544,10 @@ x_set_tool_bar_lines (f, value, oldval) 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) nlines = XFASTINT (value); @@ -3832,7 +3801,7 @@ w32_msg_pump (deferred_msg * msg_buf) 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; @@ -4876,6 +4845,10 @@ w32_wnd_proc (hwnd, msg, wParam, lParam) /* 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: @@ -5172,7 +5145,7 @@ This function is an internal primitive--use `make-frame' instead.") 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; @@ -5394,13 +5367,6 @@ This function is an internal primitive--use `make-frame' instead.") 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); @@ -5429,6 +5395,35 @@ This function is an internal primitive--use `make-frame' instead.") 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); @@ -5467,6 +5462,11 @@ This function is an internal primitive--use `make-frame' instead.") ; } UNGCPRO; + + /* Make sure windows on this frame appear in calls to next-window + and similar functions. */ + Vwindow_list = Qnil; + return unbind_to (count, frame); } @@ -5517,9 +5517,12 @@ char * xlfd_charset_of_font (char * fontname) struct font_info *w32_load_bdf_font (struct frame *f, char *fontname, int size, char* filename); -BOOL w32_to_x_font (LOGFONT * lplf, char * lpxstr, int len, char * charset); +static Lisp_Object w32_list_bdf_fonts (Lisp_Object pattern, int max_names); +static BOOL w32_to_x_font (LOGFONT * lplf, char * lpxstr, int len, + char * charset); +static BOOL x_to_w32_font (char *lpxstr, LOGFONT *lplogfont); -struct font_info * +static struct font_info * w32_load_system_font (f,fontname,size) struct frame *f; char * fontname; @@ -5729,7 +5732,7 @@ int size; 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)) { @@ -5790,7 +5793,7 @@ w32_unload_font (dpyinfo, font) * ) */ -LONG +static LONG x_to_w32_weight (lpw) char * lpw; { @@ -5811,7 +5814,7 @@ x_to_w32_weight (lpw) } -char * +static char * w32_to_x_weight (fnweight) int fnweight; { @@ -5828,7 +5831,7 @@ w32_to_x_weight (fnweight) return "*"; } -LONG +static LONG x_to_w32_charset (lpcs) char * lpcs; { @@ -5899,7 +5902,7 @@ x_to_w32_charset (lpcs) } -char * +static char * w32_to_x_charset (fncharset) int fncharset; { @@ -6109,7 +6112,7 @@ w32_codepage_for_font (char *fontname) } -BOOL +static BOOL w32_to_x_font (lplogfont, lpxstr, len, specific_charset) LOGFONT * lplogfont; char * lpxstr; @@ -6197,7 +6200,7 @@ w32_to_x_font (lplogfont, lpxstr, len, specific_charset) return (TRUE); } -BOOL +static BOOL x_to_w32_font (lpxstr, lplogfont) char * lpxstr; LOGFONT * lplogfont; @@ -6369,9 +6372,10 @@ x_to_w32_font (lpxstr, lplogfont) 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); @@ -6484,12 +6488,12 @@ int xlfd_strip_height (char *fontname) } /* 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; @@ -6556,7 +6560,7 @@ typedef struct enumfont_t Lisp_Object *tail; } enumfont_t; -int CALLBACK +static int CALLBACK enum_font_cb2 (lplf, lptm, FontType, lpef) ENUMLOGFONT * lplf; NEWTEXTMETRIC * lptm; @@ -6630,7 +6634,7 @@ enum_font_cb2 (lplf, lptm, FontType, lpef) return (1); } -int CALLBACK +static int CALLBACK enum_font_cb1 (lplf, lptm, FontType, lpef) ENUMLOGFONT * lplf; NEWTEXTMETRIC * lptm; @@ -6644,7 +6648,7 @@ enum_font_cb1 (lplf, lptm, FontType, lpef) } -int CALLBACK +static int CALLBACK enum_fontex_cb2 (lplf, lptm, font_type, lpef) ENUMLOGFONTEX * lplf; NEWTEXTMETRICEX * lptm; @@ -6658,7 +6662,7 @@ enum_fontex_cb2 (lplf, lptm, font_type, lpef) font_type, lpef); } -int CALLBACK +static int CALLBACK enum_fontex_cb1 (lplf, lptm, font_type, lpef) ENUMLOGFONTEX * lplf; NEWTEXTMETRICEX * lptm; @@ -6681,7 +6685,7 @@ enum_fontex_cb1 (lplf, lptm, font_type, lpef) /* 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; @@ -6712,8 +6716,9 @@ Lisp_Object w32_list_bdf_fonts (Lisp_Object pattern, int max_names) 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 @@ -6723,7 +6728,11 @@ Lisp_Object w32_list_synthesized_fonts (FRAME_PTR f, Lisp_Object pattern, 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; @@ -6920,7 +6929,7 @@ w32_list_fonts (FRAME_PTR f, Lisp_Object pattern, int size, int maxnames ) return newlist; } -Lisp_Object +static Lisp_Object w32_list_synthesized_fonts (f, pattern, size, max_names) FRAME_PTR f; Lisp_Object pattern; @@ -6930,7 +6939,7 @@ w32_list_synthesized_fonts (f, pattern, size, max_names) 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; @@ -7032,6 +7041,29 @@ w32_find_ccl_program (fontp) } +/* 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\ @@ -7059,28 +7091,6 @@ will not be included in the list. DIR may be a list of directories.") 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; -} - DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0, "Internal function called by `color-defined-p', which see.") @@ -7612,7 +7622,7 @@ Lisp_Object Qxbm; extern Lisp_Object QCwidth, QCheight, QCforeground, QCbackground, QCfile; extern Lisp_Object QCdata; Lisp_Object QCtype, QCascent, QCmargin, QCrelief; -Lisp_Object QCalgorithm, QCcolor_symbols, QCheuristic_mask; +Lisp_Object QCconversion, QCcolor_symbols, QCheuristic_mask; Lisp_Object QCindex; /* Other symbols. */ @@ -7720,6 +7730,7 @@ enum image_value_type 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, @@ -7824,6 +7835,15 @@ parse_image_spec (spec, keywords, nkeywords, type) 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; @@ -8003,7 +8023,7 @@ image_ascent (img, face) struct image *img; struct face *face; { - int height = img->height + img->margin; + int height = img->height + img->vmargin; int ascent; if (img->ascent == CENTERED_IMAGE_ASCENT) @@ -8268,10 +8288,10 @@ lookup_image (f, spec) /* 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 @@ -8291,8 +8311,7 @@ lookup_image (f, spec) { /* 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)) @@ -8302,25 +8321,94 @@ lookup_image (f, spec) 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'. */ @@ -8572,9 +8660,9 @@ static struct image_keyword xbm_format[XBM_LAST] = {":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} }; @@ -9162,9 +9250,9 @@ static struct image_keyword xpm_format[XPM_LAST] = {":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} }; @@ -9852,9 +9940,9 @@ static struct image_keyword pbm_format[PBM_LAST] = {":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} }; @@ -10208,9 +10296,9 @@ static struct image_keyword png_format[PNG_LAST] = {":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} }; @@ -10694,9 +10782,9 @@ static struct image_keyword jpeg_format[JPEG_LAST] = {":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} }; @@ -11057,9 +11145,9 @@ static struct image_keyword tiff_format[TIFF_LAST] = {":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} }; @@ -11376,9 +11464,9 @@ static struct image_keyword gif_format[GIF_LAST] = {":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} }; @@ -11691,9 +11779,9 @@ static struct image_keyword gs_format[GS_LAST] = {":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} }; @@ -12044,117 +12132,117 @@ value.") ***********************************************************************/ /* If non-null, an asynchronous timer that, when it expires, displays - a busy cursor on all frames. */ + an hourglass cursor on all frames. */ -static struct atimer *busy_cursor_atimer; +static struct atimer *hourglass_atimer; -/* Non-zero means a busy cursor is currently shown. */ +/* Non-zero means an hourglass cursor is currently shown. */ -static int busy_cursor_shown_p; +static int hourglass_shown_p; -/* Number of seconds to wait before displaying a busy cursor. */ +/* Number of seconds to wait before displaying an hourglass cursor. */ -static Lisp_Object Vbusy_cursor_delay; +static Lisp_Object Vhourglass_delay; -/* Default number of seconds to wait before displaying a busy +/* Default number of seconds to wait before displaying an hourglass cursor. */ -#define DEFAULT_BUSY_CURSOR_DELAY 1 +#define DEFAULT_HOURGLASS_DELAY 1 /* Function prototypes. */ -static void show_busy_cursor P_ ((struct atimer *)); -static void hide_busy_cursor P_ ((void)); +static void show_hourglass P_ ((struct atimer *)); +static void hide_hourglass P_ ((void)); -/* Cancel a currently active busy-cursor timer, and start a new one. */ +/* Cancel a currently active hourglass timer, and start a new one. */ void -start_busy_cursor () +start_hourglass () { #if 0 /* TODO: cursor shape changes. */ EMACS_TIME delay; int secs, usecs = 0; - cancel_busy_cursor (); + cancel_hourglass (); - if (INTEGERP (Vbusy_cursor_delay) - && XINT (Vbusy_cursor_delay) > 0) - secs = XFASTINT (Vbusy_cursor_delay); - else if (FLOATP (Vbusy_cursor_delay) - && XFLOAT_DATA (Vbusy_cursor_delay) > 0) + if (INTEGERP (Vhourglass_delay) + && XINT (Vhourglass_delay) > 0) + secs = XFASTINT (Vhourglass_delay); + else if (FLOATP (Vhourglass_delay) + && XFLOAT_DATA (Vhourglass_delay) > 0) { Lisp_Object tem; - tem = Ftruncate (Vbusy_cursor_delay, Qnil); + tem = Ftruncate (Vhourglass_delay, Qnil); secs = XFASTINT (tem); - usecs = (XFLOAT_DATA (Vbusy_cursor_delay) - secs) * 1000000; + usecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000000; } else - secs = DEFAULT_BUSY_CURSOR_DELAY; + secs = DEFAULT_HOURGLASS_DELAY; EMACS_SET_SECS_USECS (delay, secs, usecs); - busy_cursor_atimer = start_atimer (ATIMER_RELATIVE, delay, - show_busy_cursor, NULL); + hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay, + show_hourglass, NULL); #endif } -/* Cancel the busy cursor timer if active, hide a busy cursor if - shown. */ +/* Cancel the hourglass cursor timer if active, hide an hourglass + cursor if shown. */ void -cancel_busy_cursor () +cancel_hourglass () { - if (busy_cursor_atimer) + if (hourglass_atimer) { - cancel_atimer (busy_cursor_atimer); - busy_cursor_atimer = NULL; + cancel_atimer (hourglass_atimer); + hourglass_atimer = NULL; } - if (busy_cursor_shown_p) - hide_busy_cursor (); + if (hourglass_shown_p) + hide_hourglass (); } -/* Timer function of busy_cursor_atimer. TIMER is equal to - busy_cursor_atimer. +/* Timer function of hourglass_atimer. TIMER is equal to + hourglass_atimer. - Display a busy cursor on all frames by mapping the frames' - busy_window. Set the busy_p flag in the frames' output_data.x - structure to indicate that a busy cursor is shown on the - frames. */ + Display an hourglass cursor on all frames by mapping the frames' + hourglass_window. Set the hourglass_p flag in the frames' + output_data.x structure to indicate that an hourglass cursor is + shown on the frames. */ static void -show_busy_cursor (timer) +show_hourglass (timer) struct atimer *timer; { #if 0 /* TODO: cursor shape changes. */ /* The timer implementation will cancel this timer automatically - after this function has run. Set busy_cursor_atimer to null + after this function has run. Set hourglass_atimer to null so that we know the timer doesn't have to be canceled. */ - busy_cursor_atimer = NULL; + hourglass_atimer = NULL; - if (!busy_cursor_shown_p) + if (!hourglass_shown_p) { Lisp_Object rest, frame; BLOCK_INPUT; FOR_EACH_FRAME (rest, frame) - if (FRAME_X_P (XFRAME (frame))) + if (FRAME_W32_P (XFRAME (frame))) { struct frame *f = XFRAME (frame); - f->output_data.w32->busy_p = 1; + f->output_data.w32->hourglass_p = 1; - if (!f->output_data.w32->busy_window) + if (!f->output_data.w32->hourglass_window) { unsigned long mask = CWCursor; XSetWindowAttributes attrs; - attrs.cursor = f->output_data.w32->busy_cursor; + attrs.cursor = f->output_data.w32->hourglass_cursor; - f->output_data.w32->busy_window + f->output_data.w32->hourglass_window = XCreateWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), 0, 0, 32000, 32000, 0, 0, @@ -12163,24 +12251,25 @@ show_busy_cursor (timer) mask, &attrs); } - XMapRaised (FRAME_X_DISPLAY (f), f->output_data.w32->busy_window); + XMapRaised (FRAME_X_DISPLAY (f), + f->output_data.w32->hourglass_window); XFlush (FRAME_X_DISPLAY (f)); } - busy_cursor_shown_p = 1; + hourglass_shown_p = 1; UNBLOCK_INPUT; } #endif } -/* Hide the busy cursor on all frames, if it is currently shown. */ +/* Hide the hourglass cursor on all frames, if it is currently shown. */ static void -hide_busy_cursor () +hide_hourglass () { #if 0 /* TODO: cursor shape changes. */ - if (busy_cursor_shown_p) + if (hourglass_shown_p) { Lisp_Object rest, frame; @@ -12189,19 +12278,20 @@ hide_busy_cursor () { struct frame *f = XFRAME (frame); - if (FRAME_X_P (f) + if (FRAME_W32_P (f) /* Watch out for newly created frames. */ - && f->output_data.x->busy_window) + && f->output_data.x->hourglass_window) { - XUnmapWindow (FRAME_X_DISPLAY (f), f->output_data.x->busy_window); - /* Sync here because XTread_socket looks at the busy_p flag - that is reset to zero below. */ + XUnmapWindow (FRAME_X_DISPLAY (f), + f->output_data.x->hourglass_window); + /* Sync here because XTread_socket looks at the + hourglass_p flag that is reset to zero below. */ XSync (FRAME_X_DISPLAY (f), False); - f->output_data.x->busy_p = 0; + f->output_data.x->hourglass_p = 0; } } - busy_cursor_shown_p = 0; + hourglass_shown_p = 0; UNBLOCK_INPUT; } #endif @@ -12262,7 +12352,7 @@ x_create_tip_frame (dpyinfo, parms) 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; @@ -12495,7 +12585,7 @@ x_create_tip_frame (dpyinfo, parms) #ifdef TODO /* Tooltip support not complete. */ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, "Show STRING in a \"tooltip\" window on frame FRAME.\n\ -A tooltip window is a small X window displaying a string.\n\ +A tooltip window is a small window displaying a string.\n\ \n\ FRAME nil or omitted means use the selected frame.\n\ \n\ @@ -12511,7 +12601,7 @@ 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 -5).") +DY added (default is 10).") (string, frame, parms, timeout, dx, dy) Lisp_Object string, frame, parms, timeout, dx, dy; { @@ -12545,13 +12635,49 @@ DY added (default is -5).") CHECK_NUMBER (dx, 5); if (NILP (dy)) - dy = make_number (-5); + dy = make_number (-10); else CHECK_NUMBER (dy, 6); + if (NILP (last_show_tip_args)) + last_show_tip_args = Fmake_vector (make_number (3), Qnil); + + if (!NILP (tip_frame)) + { + Lisp_Object last_string = AREF (last_show_tip_args, 0); + Lisp_Object last_frame = AREF (last_show_tip_args, 1); + Lisp_Object last_parms = AREF (last_show_tip_args, 2); + + if (EQ (frame, last_frame) + && !NILP (Fequal (last_string, string)) + && !NILP (Fequal (last_parms, parms))) + { + struct frame *f = XFRAME (tip_frame); + + /* Only DX and DY have changed. */ + if (!NILP (tip_timer)) + { + Lisp_Object timer = tip_timer; + tip_timer = Qnil; + call1 (Qcancel_timer, timer); + } + + BLOCK_INPUT; + compute_tip_xy (f, parms, dx, dy, &root_x, &root_y); + XMoveWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + root_x, root_y - PIXEL_HEIGHT (f)); + UNBLOCK_INPUT; + goto start_timer; + } + } + /* Hide a previous tip, if any. */ Fx_hide_tip (); + ASET (last_show_tip_args, 0, string); + ASET (last_show_tip_args, 1, frame); + ASET (last_show_tip_args, 2, parms); + /* Add default values to frame parameters. */ if (NILP (Fassq (Qname, parms))) parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms); @@ -12575,8 +12701,8 @@ DY added (default is -5).") 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; @@ -12586,7 +12712,7 @@ DY added (default is -5).") 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); @@ -12626,26 +12752,11 @@ DY added (default is -5).") height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f); width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f); - /* User-specified position? */ - left = Fcdr (Fassq (Qleft, parms)); - top = Fcdr (Fassq (Qtop, parms)); - /* Move the tooltip window where the mouse pointer is. Resize and show it. */ -#if 0 /* TODO : W32 specifics */ - BLOCK_INPUT; - XQueryPointer (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window, - &root, &child, &root_x, &root_y, &win_x, &win_y, &pmask); - UNBLOCK_INPUT; + compute_tip_xy (f, parms, dx, dy, &root_x, &root_y); - root_x += XINT (dx); - root_y += XINT (dy); - - if (INTEGERP (left)) - root_x = XINT (left); - if (INTEGERP (top)) - root_y = XINT (top); - +#if 0 /* TODO : W32 specifics */ BLOCK_INPUT; XMoveResizeWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), root_x, root_y - height, width, height); @@ -12661,6 +12772,7 @@ DY added (default is -5).") 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")); @@ -12693,7 +12805,7 @@ Value is t is tooltip was open, nil otherwise.") specbind (Qinhibit_quit, Qt); if (!NILP (timer)) - call1 (intern ("cancel-timer"), timer); + call1 (Qcancel_timer, timer); if (FRAMEP (frame)) { @@ -12772,7 +12884,6 @@ selection dialog's entry field, if MUSTMATCH is non-nil.") if (use_dialog_p) { OPENFILENAME file_details; - char *filename_file; /* Prevent redisplay. */ specbind (Qinhibit_redisplay, Qt); @@ -12911,7 +13022,6 @@ If optional parameter FRAME is not specified, use selected frame.") (command, frame) Lisp_Object command, frame; { - WPARAM code; FRAME_PTR f = check_x_frame (frame); CHECK_NUMBER (command, 0); @@ -13164,7 +13274,6 @@ is set to off if the low bit of NEW-STATE is zero, otherwise on.") Lisp_Object key, new_state; { int vk_code; - int cur_state; if (EQ (key, intern ("capslock"))) vk_code = VK_CAPITAL; @@ -13355,6 +13464,8 @@ syms_of_w32fns () 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"); @@ -13528,20 +13639,20 @@ switches, if present."); Vx_mode_pointer_shape = Qnil; - DEFVAR_LISP ("x-busy-pointer-shape", &Vx_busy_pointer_shape, + DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape, "The shape of the pointer when Emacs is busy.\n\ This variable takes effect when you create a new frame\n\ or when you set the mouse color."); - Vx_busy_pointer_shape = Qnil; + Vx_hourglass_pointer_shape = Qnil; - DEFVAR_BOOL ("display-busy-cursor", &display_busy_cursor_p, - "Non-zero means Emacs displays a busy cursor on window systems."); - display_busy_cursor_p = 1; + DEFVAR_BOOL ("display-hourglass", &display_hourglass_p, + "Non-zero means Emacs displays an hourglass pointer on window systems."); + display_hourglass_p = 1; - DEFVAR_LISP ("busy-cursor-delay", &Vbusy_cursor_delay, - "*Seconds to wait before displaying a busy-cursor.\n\ + DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay, + "*Seconds to wait before displaying an hourglass pointer.\n\ Value must be an integer or float."); - Vbusy_cursor_delay = make_number (DEFAULT_BUSY_CURSOR_DELAY); + Vhourglass_delay = make_number (DEFAULT_HOURGLASS_DELAY); DEFVAR_LISP ("x-sensitive-text-pointer-shape", &Vx_sensitive_text_pointer_shape, @@ -13764,8 +13875,8 @@ versions of Windows) characters."); 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"); @@ -13824,8 +13935,8 @@ versions of Windows) characters."); #endif #endif /* TODO */ - busy_cursor_atimer = NULL; - busy_cursor_shown_p = 0; + hourglass_atimer = NULL; + hourglass_shown_p = 0; #ifdef TODO /* Tooltip support not complete. */ defsubr (&Sx_show_tip); defsubr (&Sx_hide_tip);