Index: src/keyboard.c =================================================================== --- src/keyboard.c (.../trunk) (revision 10) +++ src/keyboard.c (.../branches/ime) (revision 10) @@ -4600,11 +4600,25 @@ "pause", /* VK_PAUSE 0x13 */ "capslock", /* VK_CAPITAL 0x14 */ +#ifdef MEADOW /* 95.8.27 Modified by himi */ + "kana", /* VK_KANA 0x15 */ + 0, 0, 0, /* 0x16 .. 0x18 */ + "kanji", /* VK_KANJI 0x19 */ + "compend", /* VK_COMPEND 0x1A */ +#else 0, 0, 0, 0, 0, 0, /* 0x15 .. 0x1A */ +#endif "escape", /* VK_ESCAPE 0x1B */ + +#ifdef MEADOW + "convert", /* VK_CONVERT */ + "noconvert", /* VK_NOCONVERT */ + 0, 0, /* 0x1C .. 0x1F */ +#else 0, 0, 0, 0, /* 0x1C .. 0x1F */ +#endif 0, /* VK_SPACE 0x20 */ "prior", /* VK_PRIOR 0x21 */ @@ -8432,6 +8446,13 @@ volatile Lisp_Object from_string; volatile int count = SPECPDL_INDEX (); + /* To control IME ( by himi ) */ +#ifdef IME_CONTROL + extern Lisp_Object Ffep_force_on (), Ffep_force_off (), Ffep_get_mode (); + extern Lisp_Object VIME_command_off_flag; + Lisp_Object IME_command_loop_flag = Qnil; +#endif /* IME_CONTROL */ + /* How many keys there are in the current key sequence. */ volatile int t; @@ -8527,6 +8548,10 @@ struct gcpro gcpro1; +#ifdef IME_CONTROL + VIME_command_off_flag = Qnil; +#endif + GCPRO1 (fake_prefixed_keys); raw_keybuf_count = 0; @@ -8578,6 +8603,12 @@ keybuf[0..mock_input] holds the sequence we should reread. */ replay_sequence: +#ifdef IME_CONTROL +/* If key sequences are to replay, IME_loop_flag should not be set. + Because event has never been occured. (by himi 96.10.13) */ + IME_command_loop_flag = Qnil; +#endif + starting_buffer = current_buffer; first_unbound = bufsize + 1; @@ -8696,6 +8727,16 @@ goto replay_sequence; } +#ifdef IME_CONTROL + if (!NILP (IME_command_loop_flag) && NILP (VIME_command_off_flag)) + { + VIME_command_off_flag = Ffep_get_mode (); + if (!NILP (VIME_command_off_flag)) + Ffep_force_off (Qnil); + } + IME_command_loop_flag = Qt; +#endif /* IME_CONTROL */ + if (t >= bufsize) error ("Key sequence too long"); @@ -9385,6 +9426,12 @@ ? defs[first_binding] : Qnil); + /* to control IME (by himi) */ +#ifdef IME_CONTROL + if (!NILP (VIME_command_off_flag)) + Ffep_force_on (Qnil); +#endif /* IME_CONTROL */ + unread_switch_frame = delayed_switch_frame; unbind_to (count, Qnil); Index: src/w32term.c =================================================================== --- src/w32term.c (.../trunk) (revision 10) +++ src/w32term.c (.../branches/ime) (revision 10) @@ -2736,7 +2736,14 @@ /* If the dirty region is not what we expected, redraw the entire frame. */ if (!EqualRgn (combined, expect_dirty)) SET_FRAME_GARBAGED (f); +#ifdef MEADOW + DeleteObject (dirty); + DeleteObject (combined); +#endif } +#ifdef MEADOW + DeleteObject (expect_dirty); +#endif UNBLOCK_INPUT; } @@ -4739,6 +4746,75 @@ check_visibility = 1; break; +#ifdef IME_CONTROL + case WM_MULE_IME_STATUS: + f = x_window_to_frame (dpyinfo, msg.msg.hwnd); + +#if 0 + if (f && !f->iconified && f->visible && numchars > 0) + { + bufp->kind = NON_ASCII_KEYSTROKE_EVENT; + bufp->code = VK_KANJI; + bufp->modifiers = 0; + XSETFRAME (bufp->frame_or_window, f); + bufp->timestamp = msg.msg.time; + bufp++; + numchars--; + count++; +#else + if (f && !f->iconified && f->visible) + { + inev.kind = NON_ASCII_KEYSTROKE_EVENT; + inev.code = VK_KANJI; + inev.modifiers = 0; + XSETFRAME (inev.frame_or_window, f); + inev.timestamp = msg.msg.time; +#endif + } + break; + case WM_MULE_IME_REPORT: + { + LPTSTR lpStr; + struct input_event buf; + HANDLE hw32_ime_string = (HANDLE) msg.msg.wParam; + +#if 0 + if (count != 0) { + exit_message_loop = 1; + break; + } +#endif + f = (struct frame *) msg.msg.lParam; + if (f && !f->iconified && f->visible) + { + lpStr = GlobalLock(hw32_ime_string); + while(1) + { + XSETFRAME (buf.frame_or_window, f); + buf.timestamp = msg.msg.time; + buf.modifiers = 0; + if (*lpStr) + { + buf.kind = ASCII_KEYSTROKE_EVENT; + buf.code = *lpStr; + kbd_buffer_store_event(&buf); + lpStr++; + } + else + { + buf.kind = NON_ASCII_KEYSTROKE_EVENT; + buf.code = VK_COMPEND; + kbd_buffer_store_event(&buf); + break; + } + } + GlobalUnlock(hw32_ime_string); + GlobalFree(hw32_ime_string); + } + } + break; +#endif /* IME_CONTROL */ + default: /* Check for messages registered at runtime. */ if (msg.msg.message == msh_mousewheel) @@ -5100,6 +5176,10 @@ struct frame *f = XFRAME (WINDOW_FRAME (w)); HWND hwnd = FRAME_W32_WINDOW (f); +#ifdef IME_CONTROL + if ((f == FRAME_W32_DISPLAY_INFO (f)->x_highlight_frame)) + w32_set_ime_conv_window(f); +#endif w32_system_caret_x = WINDOW_TEXT_TO_FRAME_PIXEL_X (w, w->phys_cursor.x); w32_system_caret_y @@ -5359,8 +5439,13 @@ rt.left = rt.right = rt.top = rt.bottom = 0; BLOCK_INPUT; +#if defined(CLIENTEDGE) + AdjustWindowRectEx(&rt, f->output_data.w32->dwStyle, + FRAME_EXTERNAL_MENU_BAR (f), WS_EX_CLIENTEDGE); +#else AdjustWindowRect(&rt, f->output_data.w32->dwStyle, FRAME_EXTERNAL_MENU_BAR (f)); +#endif UNBLOCK_INPUT; pt.x += (rt.right - rt.left); @@ -5490,8 +5575,13 @@ rect.right = pixelwidth; rect.bottom = pixelheight; +#if defined(CLIENTEDGE) + AdjustWindowRectEx(&rect, f->output_data.w32->dwStyle, + FRAME_EXTERNAL_MENU_BAR (f), WS_EX_CLIENTEDGE); +#else AdjustWindowRect(&rect, f->output_data.w32->dwStyle, FRAME_EXTERNAL_MENU_BAR (f)); +#endif my_set_window_pos (FRAME_W32_WINDOW (f), NULL, @@ -6418,6 +6508,9 @@ vertical_scroll_bar_top_border = vertical_scroll_bar_bottom_border = GetSystemMetrics (SM_CYVSCROLL); } +#ifdef IME_CONTROL + w32_ime_control_init(); +#endif } void Index: src/w32term.h =================================================================== --- src/w32term.h (.../trunk) (revision 10) +++ src/w32term.h (.../branches/ime) (revision 10) @@ -613,6 +613,53 @@ #define WM_EMACS_SETCURSOR (WM_EMACS_START + 19) #define WM_EMACS_END (WM_EMACS_START + 20) +#if defined (MEADOW) || defined (IME_CONTROL) +#ifndef VK_KANJI +#define VK_KANJI 0x19 +#endif +#ifndef VK_KANA +#define VK_KANA 0x15 +#endif +#define VK_COMPEND 0x1A +#define WM_MEADOW_CREATE_WINDOW (WM_USER+2100) +#define WM_MEADOW_CREATE_SCROLLBAR (WM_USER+2101) + +/* For internal communications + from window procedure to event loop. */ +#define WM_MULE_IME_REPORT (WM_USER+2200) +#define WM_MULE_IME_STATUS (WM_USER+2201) +#endif + +#ifdef IME_CONTROL +/* For internal communications + from main thread to window procedure. */ +#define WM_MULE_IMM_MESSAGE_START (WM_USER+2300) +#define WM_MULE_IMM_SET_STATUS (WM_USER+2300) +#define WM_MULE_IMM_GET_STATUS (WM_USER+2301) +#define WM_MULE_IMM_DEAL_WITH_CONTEXT (WM_USER+2302) +#define WM_MULE_IMM_SET_COMPOSITION_STRING (WM_USER+2303) +#define WM_MULE_IMM_GET_COMPOSITION_STRING (WM_USER+2304) +#define WM_MULE_IMM_SET_MODE (WM_USER+2305) +#define WM_MULE_IMM_NOTIFY (WM_USER+2310) +#define WM_MULE_IMM_GET_UNDETERMINED_STRING_LENGTH (WM_USER+2320) +#define WM_MULE_IMM_MESSAGE_END (WM_USER+2399) +#define MESSAGE_IMM_COM_P(message) \ + (((message) >= WM_MULE_IMM_MESSAGE_START) && \ + ((message) <= WM_MULE_IMM_MESSAGE_END)) + +/* For synchronization + to create conversion agent + between main thread and event loop. */ +#define WM_MULE_IME_CREATE_AGENT (WM_USER+2400) +#define WM_MULE_IME_CREATE_AGENT_REPLY (WM_USER+2401) +#define WM_MULE_IME_DESTROY_AGENT (WM_USER+2402) +#define WM_MULE_IME_DESTROY_AGENT_REPLY (WM_USER+2403) +#define CONVAGENT_CLASS "ConvAgent" + +#define WM_MULE_IMM_SET_COMPOSITION_FONT (WM_USER+2404) +#define WM_MULE_IMM_SET_COMPOSITION_FONT_REPLY (WM_USER+2405) +#endif + #define WND_FONTWIDTH_INDEX (0) #define WND_LINEHEIGHT_INDEX (4) #define WND_BORDER_INDEX (8) @@ -723,6 +770,98 @@ EXFUN (Fx_display_grayscale_p, 1); int image_ascent P_ ((struct image *, struct face *)); +#if defined (MEADOW) || defined (IME_CONTROL) +/* for decoding to "w32_coding_system". */ +extern Lisp_Object Vlocale_coding_system; + +#define MEADOW_DECODE_BUF buf_mule_decode_01211 + +#define MEADOW_DECODE_ALLOC_PREDEFINE \ +TCHAR *MEADOW_DECODE_BUF; \ +struct coding_system mccode_mule_decode_01211; \ +int bufsize_mule_decoding_01211 + +#define MEADOW_DECODE_ALLOC(len) \ +setup_coding_system(Fcheck_coding_system(Vlocale_coding_system), \ + &mccode_mule_decode_01211); \ +bufsize_mule_decoding_01211 = decoding_buffer_size(&mccode_mule_decode_01211, (len));\ +MEADOW_DECODE_BUF = alloca(bufsize_mule_decoding_01211); + +#define MEADOW_DECODE(string, len) \ +(decode_coding(&mccode_mule_decode_01211, \ + (string), MEADOW_DECODE_BUF, (len), bufsize)) + +#define MEADOW_DECODE_PRODUCED (mccode_mule_decode_01211.produced) + +/* for encoding. */ + +#define MEADOW_ENCODE_BUF buf_mule_encode_01211 + +#define MEADOW_ENCODE_ALLOC_PREDEFINE \ +TCHAR *MEADOW_ENCODE_BUF; \ +struct coding_system mccode_mule_encode_01211; \ +int bufsize_mule_encoding_01211 + + +#define MEADOW_ENCODE_ALLOC(len) \ +(setup_coding_system(Fcheck_coding_system(Vlocale_coding_system), \ + &mccode_mule_encode_01211)); \ +bufsize_mule_encoding_01211 = encoding_buffer_size(&mccode_mule_encode_01211, (len));\ +MEADOW_ENCODE_BUF = alloca(bufsize_mule_encoding_01211); + +#define MEADOW_ENCODE(string, len) \ +(encode_coding(&mccode_mule_encode_01211, \ + (string), MEADOW_ENCODE_BUF, (len), bufsize_mule_encoding_01211)) + +#define MEADOW_ENCODE_PRODUCED (mccode_mule_encode_01211.produced) +#endif + +#define LISPY_STRING_BYTES(str) (STRING_BYTES(XSTRING(str))) +#define LISPY_STRING_CHARS(str) (XSTRING(str)->size) + +/* I don't know the following codes are usefull ? */ +/* This method guarantee message reachability. + But you must deal with any messages sent by this method in + window procedure. You cannot deal with them in the thread + message loop(W32read_socket). */ +#define SEND_INFORM_MESSAGE(window, message, wparam, lparam) \ + (SendMessage ((window), (message), (wparam), (lparam))) + +/* + You should avoid using this method to send message to the + message thread if possible. Although this method guarantee + message reachablity even when message thread has no window, + you must deal with any messages sent by this method + both in the thread message loop(W32read_socket) and + in the window procedure(normally w32_WndProc). +*/ +#define SEND_MSGTHREAD_INFORM_MESSAGE(message, wparam, lparam) \ + do { \ + if (FRAME_W32_WINDOW(SELECTED_FRAME()) != INVALID_HANDLE_VALUE) \ + SendMessage(FRAME_W32_WINDOW(SELECTED_FRAME()), (message), \ + (wparam), (lparam)); \ + else \ + while (!PostThreadMessage (dwWindowsThreadId, (message), \ + (wparam), (lparam))) \ + sleep(1); \ + }while(0) + +/* This method does NOT guarantee message reachability + if its destination is the message thread. */ +#define POST_THREAD_INFORM_MESSAGE(thread, message, wparam, lparam) \ + while (!PostThreadMessage ((thread), (message), (wparam), (lparam))) \ + sleep(1) + +/* This method does NOT guarantee message reachability in any case. */ +#define POST_INFORM_MESSAGE(window, message, wparam, lparam) \ + while (!PostMessage ((window), (message), (wparam), (lparam))) \ + sleep(1) + +#define WAIT_REPLY_MESSAGE(ret, msgno) \ + do { \ + GetMessage ((ret), NULL, 0, 0); \ + } while((ret)->message != (msgno)) + #define FONT_TYPE_FOR_UNIBYTE(font, ch) \ ((font)->bdf ? BDF_1D_FONT : ANSI_FONT) Index: src/w32fns.c =================================================================== --- src/w32fns.c (.../trunk) (revision 10) +++ src/w32fns.c (.../branches/ime) (revision 10) @@ -53,6 +53,10 @@ #include #include +#if IME_CONTROL +#include +#endif /* IME_CONTROL */ + #include #define FILE_NAME_TEXT_FIELD edt1 @@ -195,6 +199,12 @@ Lisp_Object Qnone; Lisp_Object Qsuppress_icon; Lisp_Object Qundefined_color; +Lisp_Object Qcenter; + +#ifdef IME_CONTROL +Lisp_Object Qime_font; +#endif + Lisp_Object Qcancel_timer; Lisp_Object Qhyper; Lisp_Object Qsuper; @@ -410,6 +420,7 @@ void x_set_tool_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object)); static void x_edge_detection P_ ((struct frame *, struct image *, Lisp_Object, Lisp_Object)); +void x_set_ime_font (struct frame *, Lisp_Object, Lisp_Object); @@ -427,7 +438,11 @@ RECT rect; GetClientRect(FRAME_W32_WINDOW(f), &rect); +#if defined(CLIENTEDGE) + AdjustWindowRectEx(&rect, f->output_data.w32->dwStyle, FRAME_EXTERNAL_MENU_BAR(f), WS_EX_CLIENTEDGE); +#else AdjustWindowRect(&rect, f->output_data.w32->dwStyle, FRAME_EXTERNAL_MENU_BAR(f)); +#endif pt.x = rect.left; pt.y = rect.top; @@ -1586,6 +1601,26 @@ update_face_from_frame_parameter (f, Qcursor_color, arg); } +static BOOL x_to_w32_font (char *lpxstr, LOGFONT *lplogfont); + +#ifdef IME_CONTROL +void +x_set_ime_font (f, arg, oldval) + struct frame *f; + Lisp_Object arg, oldval; +{ + LOGFONT lf; + + CHECK_STRING (arg); + + if (!x_to_w32_font (XSTRING (arg)->data, &lf)) + error ("Font `%s' is not defined", XSTRING (arg)->data); + SEND_INFORM_MESSAGE(FRAME_W32_WINDOW(f), + WM_MULE_IMM_SET_COMPOSITION_FONT, + (WPARAM) f, (LPARAM) &lf); +} +#endif /* IME_CONTROL */ + /* Set the border-color of frame F to pixel value PIX. Note that this does not fully take effect if done before F has a window. */ @@ -2000,14 +2035,14 @@ Cursor w32_load_cursor (LPCTSTR name) { - /* Try first to load cursor from application resource. */ - Cursor cursor = LoadImage ((HINSTANCE) GetModuleHandle(NULL), - name, IMAGE_CURSOR, 0, 0, - LR_DEFAULTCOLOR | LR_DEFAULTSIZE | LR_SHARED); - if (!cursor) + /* Try first to load a shared predefined cursor. */ + Cursor cursor = LoadImage (NULL, name, IMAGE_CURSOR, 0, 0, + LR_DEFAULTCOLOR | LR_DEFAULTSIZE | LR_SHARED); + if (!cursor) { - /* Then try to load a shared predefined cursor. */ - cursor = LoadImage (NULL, name, IMAGE_CURSOR, 0, 0, + /* Then try to load cursor from application resource. */ + cursor = LoadImage ((HINSTANCE) GetModuleHandle(NULL), + name, IMAGE_CURSOR, 0, 0, LR_DEFAULTCOLOR | LR_DEFAULTSIZE | LR_SHARED); } return cursor; @@ -2063,8 +2098,13 @@ rect.right = FRAME_PIXEL_WIDTH (f); rect.bottom = FRAME_PIXEL_HEIGHT (f); +#if defined(CLIENTEDGE) + AdjustWindowRectEx (&rect, f->output_data.w32->dwStyle, + FRAME_EXTERNAL_MENU_BAR (f), WS_EX_CLIENTEDGE); +#else AdjustWindowRect (&rect, f->output_data.w32->dwStyle, FRAME_EXTERNAL_MENU_BAR (f)); +#endif /* Do first time app init */ @@ -2074,6 +2114,19 @@ } FRAME_W32_WINDOW (f) = hwnd +#if defined(CLIENTEDGE) + = CreateWindowEx (WS_EX_CLIENTEDGE, EMACS_CLASS, + f->namebuf, + f->output_data.w32->dwStyle | WS_CLIPCHILDREN, + f->left_pos, + f->top_pos, + rect.right - rect.left, + rect.bottom - rect.top, + NULL, + NULL, + hinst, + NULL); +#else = CreateWindow (EMACS_CLASS, f->namebuf, f->output_data.w32->dwStyle | WS_CLIPCHILDREN, @@ -2085,6 +2138,7 @@ NULL, hinst, NULL); +#endif /* CLIENTEDGE */ if (hwnd) { @@ -2753,6 +2807,9 @@ WPARAM wParam; LPARAM lParam; { +#ifdef IME_CONTROL + extern int IME_event_off_count; +#endif struct frame *f; struct w32_display_info *dpyinfo = &one_w32_display_info; W32Msg wmsg; @@ -3603,9 +3660,13 @@ leave_crit (); memset (&rect, 0, sizeof (rect)); +#if defined(CLIENTEDGE) + AdjustWindowRectEx (&rect, GetWindowLong (hwnd, GWL_STYLE), + GetMenu (hwnd) != NULL, WS_EX_CLIENTEDGE); +#else AdjustWindowRect (&rect, GetWindowLong (hwnd, GWL_STYLE), GetMenu (hwnd) != NULL); - +#endif /* Force width and height of client area to be exact multiples of the character cell dimensions. */ wdiff = (lppos->cx - (rect.right - rect.left) @@ -3801,8 +3862,56 @@ return retval; } +#if defined(MEADOW) && defined(IME_CONTROL) + case WM_IME_NOTIFY: + if (wParam == IMN_SETOPENSTATUS) + { + if (!IME_event_off_count) + my_post_msg (&wmsg, hwnd, WM_MULE_IME_STATUS, 0, 0); + else + IME_event_off_count--; + } + goto dflt; + case WM_IME_STARTCOMPOSITION: +#if 0 + w32_set_ime_conv_window (hwnd); +#endif + case WM_IME_ENDCOMPOSITION: + goto dflt; + + case WM_IME_COMPOSITION: + { + if (lParam & GCS_RESULTSTR) + { + extern BOOL w32_get_ime_composition_string (HWND); + if (w32_get_ime_composition_string (hwnd)) + return 0; + else + break; + } + goto dflt; + } + + case WM_MULE_IMM_SET_COMPOSITION_FONT: + w32_set_ime_font (hwnd, (LPLOGFONT) lParam); + POST_THREAD_INFORM_MESSAGE(dwWindowsThreadId, + WM_MULE_IMM_SET_COMPOSITION_FONT_REPLY, + (WPARAM) 0, (LPARAM) 0); + break; +#endif /* not MEADOW and IME_CONTROL */ + default: +#if defined(MEADOW) && defined(IME_CONTROL) /* && defined(W32_VER4) */ + { + extern LRESULT CALLBACK + conversion_agent_wndproc(HWND hwnd, UINT message, + WPARAM wparam, LPARAM lparam); + if (MESSAGE_IMM_COM_P(msg)) + return conversion_agent_wndproc(hwnd, msg, wParam, lParam); + } +#endif + /* Check for messages registered at runtime. */ if (msg == msh_mousewheel) { @@ -4193,6 +4302,12 @@ x_default_parameter (f, parms, Qfont, font, "font", "Font", RES_TYPE_STRING); +#ifdef IME_CONTROL + /* fix me. I don't know how to get a font name.*/ + x_default_parameter (f, parms, Qime_font, font, + "ime-font", "IME-Font", RES_TYPE_STRING); +#endif + } x_default_parameter (f, parms, Qborder_width, make_number (2), @@ -8333,6 +8448,9 @@ x_set_cursor_color, x_set_cursor_type, x_set_font, +#ifdef IME_CONTROL + x_set_ime_font, +#endif /* IME_CONTROL */ x_set_foreground_color, x_set_icon_name, x_set_icon_type, @@ -8372,6 +8490,12 @@ staticpro (&Qsuppress_icon); Qundefined_color = intern ("undefined-color"); staticpro (&Qundefined_color); +#ifdef MEADOW + Qime_font = intern ("ime-font"); + staticpro (&Qime_font); +#endif /* MEADOW */ + Qcenter = intern ("center"); + staticpro (&Qcenter); Qcancel_timer = intern ("cancel-timer"); staticpro (&Qcancel_timer); Index: src/ChangeLog =================================================================== --- src/ChangeLog (.../trunk) (revision 10) +++ src/ChangeLog (.../branches/ime) (revision 10) @@ -1,3 +1,11 @@ +2004-03-13 Eli Zaretskii + + * Makefile.in (XMENU_OBJ): Include xmenu.o if HAVE_MENUS is + defined. + + * emacs.c (main): Call syms_of_xmenu only if HAVE_MENUS is + defined. + 2004-03-12 Richard M. Stallman * fns.c (internal_equal): New arg PROPS controls comparing @@ -44,6 +52,7 @@ (obj): Add $(GTK_OBJ) to list. 2004-03-11 Steven Tamm + * image.c [MAC_OSX]: Include sys/stat.h * macfns.c (syms_of_macfns): Remove definitions of things now Index: src/blockinput.h =================================================================== --- src/blockinput.h (.../trunk) (revision 10) +++ src/blockinput.h (.../branches/ime) (revision 10) @@ -101,6 +101,21 @@ /* Don't use a prototype here; it causes trouble in some files. */ extern void reinvoke_input_signal (); +#if 0 +/* W32 API is reentrant. So block input system is not needed. */ +/* 96.10.2 by himi */ +#ifdef MEADOW +#undef BLOCK_INPUT +#undef UNBLOCK_INPUT +#define BLOCK_INPUT +#define UNBLOCK_INPUT +#else +#define W32_BLOCK_INPUT +#define W32_UNBLOCK_INPUT +#define W32_SPECIAL_INPUT +#define W32_SPECIAL_INPUT_END +#endif +#endif /* #if 0 */ #endif /* EMACS_BLOCKINPUT_H */ /* arch-tag: 51a9ec86-945a-4966-8f04-2d1341250e03 Index: src/w32.c =================================================================== --- src/w32.c (.../trunk) (revision 10) +++ src/w32.c (.../branches/ime) (revision 10) @@ -620,6 +620,83 @@ } while (*fp++); } +#ifdef MEADOW +void +unixtodos_argument (p, ep, h2sp, qp, s2isp) + register char *p; + int ep, h2sp, qp, s2isp; +{ + int qf; + char *o; + + qf = 0; + o = p; + while (-1) + { + if (*p == '\\' && + ep) + { + p++; + *o = *p; + if (!*p) break; + o++; + p++; + continue; + } + if (qf) + { + if (*p == qf) + { + qf = 0; + p++; + continue; + } + else *o = *p; + } + else + { + switch (*p) + { + case '/': + if (!s2isp) + *o = *p; + else + *o = '\\'; + break; + case '-': + if (!h2sp) + *o = *p; + else + *o = '/'; + break; + + case '\'': + case '"': + if (!qp) + *o = *p; + else + { + qf = *p; + p++; + continue; + } + break; + default : + *o = *p; + break; + } + } + if (!*p) + { + *o = *p; + break; + } + o++; + p++; + } +} +#endif /* MEADOW */ + /* Destructively turn backslashes into slashes. */ void dostounix_filename (p) @@ -713,7 +790,11 @@ int len = 0; /* must be valid filename, no wild cards or other invalid characters */ +#ifndef MEADOW if (strpbrk (name, "*?|<>\"")) +#else + if (_mbspbrk (name, "*?|<>\"")) +#endif return 0; dir_handle = FindFirstFile (name, &find_data); @@ -788,7 +869,11 @@ if (!IS_DIRECTORY_SEP (ptr[0]) || !IS_DIRECTORY_SEP (ptr[1]) || !ptr[2]) return 0; +#ifndef MEADOW if (strpbrk (ptr + 2, "*?|<>\"\\/")) +#else + if (_mbspbrk (ptr + 2, "*?|<>\"\\/")) +#endif return 0; return 1; @@ -2285,7 +2370,11 @@ name = (char *) map_w32_filename (path, &path); /* must be valid filename, no wild cards or other invalid characters */ +#ifndef MEADOW if (strpbrk (name, "*?|<>\"")) +#else + if (_mbspbrk (name, "*?|<>\"")) +#endif { errno = ENOENT; return -1; @@ -3979,6 +4068,125 @@ g_b_init_get_sid_identifier_authority = 0; } +#ifdef MEADOW +Lisp_Object Vexec_suffix_list; + +void setup_exec_suffix_list() +{ + static char exec_suffix[] = ""; + Lisp_Object slot; + char *s, *e; + int bytes; + int len = strlen(exec_suffix); + + Vexec_suffix_list = Qnil; + s = exec_suffix; + do { + e = strchr (s, ':'); + if (!e) e = &exec_suffix[len]; + + bytes = e - s; + if (bytes > 0) + { + slot = make_string (s, bytes); + Vexec_suffix_list = Fcons (slot, Vexec_suffix_list); + } + s = e + 1; + }while (*e); + + Vexec_suffix_list = Fnreverse (Vexec_suffix_list); + + return; +} + +DEFUN ("dos-to-unix-filename", Fdos_to_unix_filename, Sdos_to_unix_filename, + 1, 1, 0, + "Return filename in unix form. To put it concretely, make '\\' in a \n\ +filename into '/'.(indestructively)") + (filename) + Lisp_Object filename; +{ + int size; + Lisp_Object rfilename; + char* filetmp; + + CHECK_STRING (filename); + size = STRING_BYTES (XSTRING (filename)); + filetmp = (char *) alloca (size + 1); + if (!filetmp) + { + error ("Cannot allocate memory!."); + } + memcpy (filetmp, XSTRING (filename)->data, size + 1); + + dostounix_filename (filetmp); + + return make_string (filetmp, size); +} + +DEFUN ("unix-to-dos-filename", Funix_to_dos_filename, Sunix_to_dos_filename, + 1, 1, 0, + "Return filename in dos form. To put it concretely, make '/' in a \n\ +filename into '\\'.(indestructively). ") + (filename) + Lisp_Object filename; +{ + int size; + Lisp_Object rfilename; + char *filetmp; + + CHECK_STRING (filename); + size = STRING_BYTES (XSTRING (filename)); + filetmp = (char *) alloca (size + 1); + if (!filetmp) + { + error ("Cannot allocate memory!."); + } + memcpy (filetmp, XSTRING (filename)->data, size + 1); + + unixtodos_filename (filetmp); + + return make_string (filetmp, size); +} + +DEFUN ("unix-to-dos-argument", Funix_to_dos_argument, + Sunix_to_dos_argument, + 5, 5, 0, + "Return argument in dos form.") + (filename, ep, h2sp, qp, s2isp) + Lisp_Object filename, ep, h2sp, qp, s2isp; +{ + char *filetmp; + + CHECK_STRING (filename); + + filetmp = (char *) alloca (STRING_BYTES (XSTRING (filename)) + 1); + if (!filetmp) + { + error ("Cannot allocate memory!."); + } + memcpy (filetmp, XSTRING (filename)->data, + STRING_BYTES (XSTRING (filename)) + 1); + unixtodos_argument (filetmp, !NILP (ep), !NILP (h2sp), + !NILP (qp), !NILP (s2isp)); + + return build_string (filetmp); + +} + +void +syms_of_w32misc () +{ + DEFVAR_LISP ("exec-suffix-list", &Vexec_suffix_list, + "*List of suffixes for executable."); + setup_exec_suffix_list(); + + defsubr (&Sdos_to_unix_filename); + defsubr (&Sunix_to_dos_filename); + defsubr (&Sunix_to_dos_argument); +} + +#endif /* MEADOW */ /* end of nt.c */ /* arch-tag: 90442dd3-37be-482b-b272-ac752e3049f1 Index: src/w32proc.c =================================================================== --- src/w32proc.c (.../trunk) (revision 10) +++ src/w32proc.c (.../branches/ime) (revision 10) @@ -94,6 +94,12 @@ allows the possibility of hash collisions. */ Lisp_Object Vw32_generate_fake_inodes; +#ifdef MEADOW +/* Control whether file_attributes_stat() attempts to count + subdirectories. */ +Lisp_Object Vw32_get_true_file_link_count; +#endif /* MEADOW */ + /* Control whether stat() attempts to determine file type and link count exactly, at the expense of slower operation. Since true hard links are supported on NTFS volumes, this is only relevant on NT. */ @@ -743,6 +749,18 @@ /* Handle executable names without an executable suffix. */ program = make_string (cmdname, strlen (cmdname)); +#ifdef MEADOW + { + struct gcpro gcpro1; + + full = Qnil; + GCPRO1 (program); + openp (Vexec_path, program, Vexec_suffixes, &full, 1); + UNGCPRO; + if (!NILP (full)) + program = full; + } +#else if (NILP (Ffile_executable_p (program))) { struct gcpro gcpro1; @@ -758,6 +776,7 @@ } program = full; } +#endif /* make sure argv[0] and cmdname are both in DOS format */ cmdname = SDATA (program); @@ -789,7 +808,93 @@ } unixtodos_filename (cmdname); } + +#ifdef MEADOW + { + char *new_cmdname; + Lisp_Object func, arg, result; + new_cmdname = alloca(strlen(cmdname) + 1); + strcpy(new_cmdname, cmdname); + dostounix_filename(new_cmdname); + func = call1(intern("find-process-argument-editing-function"), + build_string(new_cmdname)); + if (NILP(func)) + { + arglen = 0; + targ = argv; + while (*targ) + { + arglen += strlen (*targ++) + 1; + } + cmdline = alloca (arglen); + targ = argv; + parg = cmdline; + while (*targ) + { + strcpy (parg, *targ); + parg += strlen (*targ++); + *parg++ = ' '; + } + *--parg = '\0'; + cmdname = new_cmdname; + argv[0] = cmdname; + } + else + { + struct gcpro gcpro1, gcpro2; + arg = Qnil; + GCPRO2(arg, func); + targ = argv; + while (*targ) + { + arg = Fcons(build_string(*targ++), arg); + } + arg = Fnreverse(arg); + UNGCPRO; + result = call1(func, arg); + if (CONSP(result)) + { + int size; + + CHECK_STRING(XCONS(result)->car); + CHECK_STRING(XCONS(result)->cdr); + cmdline = XSTRING(XCONS(result)->cdr)->data; + size = STRING_BYTES(XSTRING(XCONS(result)->car)) + 1; + cmdname = alloca(size); + memcpy(cmdname, XSTRING(XCONS(result)->car)->data, size); + } + else + { + CHECK_STRING(result); + cmdline = XSTRING(result)->data; + cmdname = new_cmdname; + } + } + /* printf("cmdline:%s\n", cmdline); */ + dostounix_filename(cmdname); + + /* Checks whether the cmdname exists. */ + program = build_string (cmdname); + { + struct gcpro gcpro1; + + GCPRO1 (program); + openp (Vexec_path, program, Vexec_suffixes, &full, 1); + UNGCPRO; + if (NILP (full)) + { + struct stat st; + if (stat (cmdname, &st) == 0) + errno = ENOEXEC; + return -1; + } + } + + unixtodos_filename(cmdname); + } +#else /* not MEADOW */ + /* we have to do some conjuring here to put argv and envp into the form CreateProcess wants... argv needs to be a space separated/null terminated list of parameters, and envp is a null @@ -966,6 +1071,7 @@ targ++; } *--parg = '\0'; +#endif /* not MEADOW */ /* and envp... */ arglen = 1; @@ -1208,11 +1314,15 @@ /* Wait for input or child death to be signalled. If user input is allowed, then also accept window messages. */ +#ifdef MEADOW + active = WaitForMultipleObjects (nh + nc, wait_hnd, FALSE, timeout_ms); +#else if (FD_ISSET (0, &orfds)) active = MsgWaitForMultipleObjects (nh + nc, wait_hnd, FALSE, timeout_ms, QS_ALLINPUT); else active = WaitForMultipleObjects (nh + nc, wait_hnd, FALSE, timeout_ms); +#endif if (active == WAIT_FAILED) { @@ -1248,6 +1358,7 @@ processed - otherwise higher numbered channels could be starved. */ do { +#ifndef MEADOW if (active == nh + nc) { /* There are messages in the lisp thread's queue; we must @@ -1268,6 +1379,23 @@ drain_message_queue (); } else if (active >= nh) +#else /* MEADOW */ + if (active >= nh) + /* + On Meadow, the message queue of the lisp thread is only for + communication with window proc thread. So the above problem + cannot be caused from window message. On the contrary, + if we discard thread message, we cannot reply important message + (e.g. system crucial message). The above operation is not + preferable. + If we must make modeless dialog on Meadow, we SHOULD NOT create + such windows on lisp(main) thread!!!!! And even if we can't help + doing it, we should deal with all messages generated by such windows + at the point. + According to my research on Windows98, if we pass GUI handle + to main thread, some handle can be invalid. + */ +#endif /* MEADOW */ { cp = cps[active - nh]; Index: src/Makefile.in =================================================================== --- src/Makefile.in (.../trunk) (revision 10) +++ src/Makefile.in (.../branches/ime) (revision 10) @@ -448,6 +448,10 @@ #else /* not HAVE_X11 */ LIBX= $(LIBXMENU) LD_SWITCH_X_SITE -lX10 LIBX10_MACHINE LIBX10_SYSTEM #endif /* not HAVE_X11 */ +#else /* not HAVE_X_WINDOWS */ +#ifdef HAVE_MENUS +XMENU_OBJ = xmenu.o +#endif #endif /* not HAVE_X_WINDOWS */ LIBSOUND= @LIBSOUND@ Index: src/makefile.w32-in =================================================================== --- src/makefile.w32-in (.../trunk) (revision 10) +++ src/makefile.w32-in (.../branches/ime) (revision 10) @@ -129,7 +129,8 @@ $(BLD)/w32select.$(O) \ $(BLD)/w32menu.$(O) \ $(BLD)/w32reg.$(O) \ - $(BLD)/w32bdf.$(O) + $(BLD)/w32bdf.$(O) \ + $(BLD)/w32ime.$(O) LIBS = $(TLIB0) \ $(TLIB1) \ @@ -1472,4 +1473,14 @@ $(SRC)/w32gui.h \ $(SRC)/w32term.h +$(BLD)/w32ime.$(O): \ + $(EMACS_ROOT)/src/s/ms-w32.h \ + $(EMACS_ROOT)/src/m/intel386.h \ + $(EMACS_ROOT)/src/config.h \ + $(SRC)/w32ime.c \ + $(SRC)/frame.h \ + $(SRC)/w32term.h \ + $(SRC)/charset.h \ + $(SRC)/coding.h + # arch-tag: 9fd7aba8-f826-4111-b3c0-497a8e7db9a0 Index: src/process.c =================================================================== --- src/process.c (.../trunk) (revision 10) +++ src/process.c (.../branches/ime) (revision 10) @@ -1624,7 +1624,16 @@ tem = Qnil; GCPRO4 (name, program, buffer, current_dir); +#ifndef MEADOW openp (Vexec_path, program, Vexec_suffixes, &tem, make_number (X_OK)); +#else + /* for script execution on Windows, not apply exec_only for openp */ + /* openp without exec_only returns fd not used, free it immediately */ + { + int fd = openp (Vexec_path, program, Vexec_suffixes, &tem, Qnil); + if (fd > 0) close(fd); + } +#endif /* MEADOW */ UNGCPRO; if (NILP (tem)) report_file_error ("Searching for program", Fcons (program, Qnil)); Index: src/emacs.c =================================================================== --- src/emacs.c (.../trunk) (revision 10) +++ src/emacs.c (.../branches/ime) (revision 10) @@ -1506,6 +1506,9 @@ #endif /* VMS */ #ifdef WINDOWSNT syms_of_ntproc (); +#ifdef MEADOW + syms_of_w32misc (); +#endif /* MEADOW */ #endif /* WINDOWSNT */ syms_of_window (); syms_of_xdisp (); @@ -1525,12 +1528,14 @@ #endif #endif /* HAVE_X_WINDOWS */ +#ifdef HAVE_MENUS #ifndef HAVE_NTGUI #ifndef MAC_OS /* Called before init_window_once for Mac OS Classic. */ syms_of_xmenu (); #endif #endif +#endif #ifdef HAVE_NTGUI syms_of_w32term (); @@ -1538,6 +1543,9 @@ syms_of_w32select (); syms_of_w32menu (); syms_of_fontset (); +#ifdef IME_CONTROL + syms_of_w32ime(); +#endif /* IME_CONTROL */ #endif /* HAVE_NTGUI */ #ifdef HAVE_CARBON Index: src/w32ime.c =================================================================== --- src/w32ime.c (revision 0) +++ src/w32ime.c (revision 10) @@ -0,0 +1,1453 @@ +/* IME specific staff for later W32 version4. + Copyright (C) 1992, 1995 Free Software Foundation, Inc. + +This file is part of Meadow. + +Meadow is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +Meadow is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with Meadow; see the file COPYING. If not, write to +the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ + +/* 97.10.13 written by himi */ + +#include "config.h" + +#ifdef NULL +#undef NULL +#endif +#include "lisp.h" + +#ifdef HAVE_NTGUI +#include "frame.h" +#include "window.h" +#include "dispextern.h" +#include "w32term.h" +#include "charset.h" +#include "coding.h" +#else /* not HAVE_NTGUI */ +#include +#endif /* not HAVE_NTGUI */ + +#include +#ifdef IME_CONTROL +#include +#endif /* IME_CONTROL */ + +#ifndef HAVE_NTGUI +extern HWND hwndConsole; +#endif /* not HAVE_NTGUI */ + +#define CHECK_IME_FACILITY \ + if (!fIME) error ("System have no IME facility.") + +#define IMMCONTEXTCAR(imc) \ + (XFASTINT((((unsigned long)(imc)) >> 16) & 0xffff)) + +#define IMMCONTEXTCDR(imc) \ + (XFASTINT(((unsigned long)(imc)) & 0xffff)) + +#ifdef IME_CONTROL + +#ifndef IME_SETOPEN +#define IME_SETOPEN 4 +#endif +#ifndef IME_GETOPEN +#define IME_GETOPEN 5 +#endif +#ifndef IME_SETCONVERSIONFONTEX +#define IME_SETCONVERSIONFONTEX 25 +#endif +#ifndef IME_SETCONVERSIONWINDOW +#define IME_SETCONVERSIONWINDOW 8 +#endif +#ifndef MCW_WINDOW +#define MCW_WINDOW 2 +#endif + +#if 0 +#define IMC_SETCOMPOSITIONWINDOW 0x000C +typedef struct COMPOSITIONFORM { + DWORD dwStyle; + POINT ptCurrentPos; + RECT rcArea; +} COMPOSITIONFORM; +#define CFS_FORCE_POSITION 0x20 +#define CFS_POINT 0x02 +#endif + +#define MAX_CONVAGENT 100 + +typedef struct conversion_agent { + HIMC himc; + HWND hwnd; +} conversion_agent; + +static conversion_agent agent[MAX_CONVAGENT]; +static int conversion_agent_num = -1; + +BOOL fIME = FALSE; +typedef LRESULT (WINAPI *SENDIMEMESSAGEEXPROC)(HWND, LPARAM); +SENDIMEMESSAGEEXPROC SendIMEMessageExProc; + +typedef BOOL (WINAPI *IMMGETOPENSTATUSPROC)(HIMC); +IMMGETOPENSTATUSPROC ImmGetOpenStatusProc; +typedef BOOL (WINAPI *IMMSETOPENSTATUSPROC)(HIMC, BOOL); +IMMSETOPENSTATUSPROC ImmSetOpenStatusProc; + +typedef HWND (WINAPI *IMMGETDEFAULTIMEWNDPROC)(HWND); +IMMGETDEFAULTIMEWNDPROC ImmGetDefaultIMEWndProc; +typedef LONG (WINAPI *IMMGETCOMPOSITIONSTRINGPROC) + (HIMC, DWORD, LPVOID, DWORD); +IMMGETCOMPOSITIONSTRINGPROC ImmGetCompositionStringProc; +typedef LONG (WINAPI *IMMSETCOMPOSITIONSTRINGPROC) + (HIMC, DWORD, LPCVOID, DWORD, LPCVOID, DWORD); +IMMSETCOMPOSITIONSTRINGPROC ImmSetCompositionStringProc; +typedef BOOL (WINAPI *IMMSETCOMPOSITIONFONTPROC) (HIMC, LPLOGFONTA); +IMMSETCOMPOSITIONFONTPROC ImmSetCompositionFontProc; +typedef HIMC (WINAPI *IMMGETCONTEXTPROC)(HWND); +IMMGETCONTEXTPROC ImmGetContextProc; +typedef BOOL (WINAPI *IMMGETCONVERSIONSTATUSPROC)(HIMC, LPDWORD, LPDWORD); +IMMGETCONVERSIONSTATUSPROC ImmGetConversionStatusProc; +typedef BOOL (WINAPI *IMMSETCONVERSIONSTATUSPROC)(HIMC, DWORD, DWORD); +IMMSETCONVERSIONSTATUSPROC ImmSetConversionStatusProc; +typedef BOOL (WINAPI *IMMGETCONVERSIONLISTPROC) + (HKL, HIMC, LPCTSTR, LPCANDIDATELIST, DWORD, UINT); +IMMGETCONVERSIONLISTPROC ImmGetConversionListProc; +typedef BOOL (WINAPI *IMMCONFIGUREIMEPROC)(HKL, HWND, DWORD, LPVOID); +IMMCONFIGUREIMEPROC ImmConfigureIMEProc; +typedef BOOL (WINAPI *IMMNOTIFYIMEPROC)(HIMC, DWORD, DWORD, DWORD); +IMMNOTIFYIMEPROC ImmNotifyIMEProc; +typedef BOOL (WINAPI *IMMRELEASECONTEXTPROC)(HWND, HIMC); +IMMRELEASECONTEXTPROC ImmReleaseContextProc; +typedef HIMC (WINAPI *IMMCREATECONTEXTPROC)(void); +IMMCREATECONTEXTPROC ImmCreateContextProc; +typedef BOOL (WINAPI *IMMDESTROYCONTEXTPROC)(HIMC); +IMMDESTROYCONTEXTPROC ImmDestroyContextProc; +typedef BOOL (WINAPI *IMMASSOCIATECONTEXTPROC) (HWND, HIMC); +IMMASSOCIATECONTEXTPROC ImmAssociateContextProc; +typedef BOOL (WINAPI *IMMGETCANDIDATELISTPROC) +(HIMC, DWORD, LPCANDIDATELIST, DWORD); +IMMGETCANDIDATELISTPROC ImmGetCandidateListProc; +typedef BOOL (WINAPI *IMMGETCANDIDATELISTCOUNTPROC) (HIMC, LPDWORD); +IMMGETCANDIDATELISTCOUNTPROC ImmGetCandidateListCountProc; +typedef BOOL (WINAPI *IMMGETHOTKEYPROC)(DWORD , LPUINT, LPUINT, LPHKL); +IMMGETHOTKEYPROC ImmGetHotKeyProc; +extern Lisp_Object Vime_control; + +static WPARAM wIMEOpen; + +Lisp_Object Vime_control; +Lisp_Object VIME_command_off_flag; +Lisp_Object Qim_info; + +int IME_event_off_count; + +void w32_set_ime_conv_window (struct frame *f) +{ + if (fIME && !NILP (Vime_control)) + { + HWND IMEhwnd; + COMPOSITIONFORM compform; + struct window *w = XWINDOW (FRAME_SELECTED_WINDOW(f)); + + IMEhwnd = (ImmGetDefaultIMEWndProc)(FRAME_W32_WINDOW(f)); + compform.dwStyle = CFS_POINT; /* CFS_FORCE_POSITION or CFS_POINT; */ + + compform.ptCurrentPos.x = + WINDOW_TO_FRAME_PIXEL_X (w, w->phys_cursor.x) + + WINDOW_LEFT_FRINGE_WIDTH (w); + compform.ptCurrentPos.y = WINDOW_TO_FRAME_PIXEL_Y (w, w->phys_cursor.y); + + SendMessage(IMEhwnd, WM_IME_CONTROL, (WPARAM)IMC_SETCOMPOSITIONWINDOW, + (LPARAM)(&compform)); + return; + } +} + +void w32_set_ime_status (HWND hwnd, int openp) +{ + HIMC himc; + + himc = (ImmGetContextProc)(hwnd); + (ImmSetOpenStatusProc)(himc, openp); + (ImmReleaseContextProc)(hwnd, himc); + + return; +} + +int w32_get_ime_status (HWND hwnd) +{ + HIMC himc; + int ret; + + himc = (ImmGetContextProc)(hwnd); + ret = (ImmGetOpenStatusProc)(himc); + (ImmReleaseContextProc)(hwnd, himc); + + return ret; +} + +int w32_set_ime_mode (HWND hwnd, int mode, int mask) +{ + HIMC himc; + DWORD cmode, smode; + + himc = (ImmGetContextProc)(hwnd); + if (!(ImmGetConversionStatusProc)(himc, &cmode, &smode)) return 0; + + cmode = (cmode & (~mask)) | (mode & mask); + + (ImmSetConversionStatusProc)(himc, cmode, smode); + (ImmReleaseContextProc) (hwnd, himc); + + return 1; +} + +int w32_get_ime_undetermined_string_length (HWND hwnd) +{ + long len; + HIMC himc; + + himc = (ImmGetContextProc) (hwnd); + if (!himc) return 0; + len = (ImmGetCompositionStringProc) (himc, GCS_COMPSTR, NULL, 0); + (ImmReleaseContextProc) (hwnd, himc); + return len; +} + +BOOL w32_get_ime_composition_string (HWND hwnd) +{ + HIMC hIMC; + int size; + HANDLE himestr; + LPSTR lpstr; + struct frame *f; + + hIMC = (ImmGetContextProc)(hwnd); + if (!hIMC) return FALSE; + + size = (ImmGetCompositionStringProc)(hIMC, GCS_RESULTSTR, NULL, 0); + size += sizeof(TCHAR); + himestr = GlobalAlloc(GHND,size); + if (!himestr) abort(); + lpstr = GlobalLock(himestr); + if (!lpstr) abort(); + (ImmGetCompositionStringProc)(hIMC, GCS_RESULTSTR, lpstr, size); + (ImmReleaseContextProc)(hwnd, hIMC); + GlobalUnlock(himestr); + /* himestr will be GlobalFree in w32_read_socket@w32term.c*/ + { + extern void my_post_msg(W32Msg *, HWND, UINT, WPARAM, LPARAM); + W32Msg wmsg; + f = SELECTED_FRAME(); + my_post_msg(&wmsg, hwnd, WM_MULE_IME_REPORT, + (WPARAM) himestr,(LPARAM) f); + } + return TRUE; +} + +void w32_ime_control_init (void) +{ + HMODULE hImm32; + HMODULE hUser32; + hImm32 = GetModuleHandle ("IMM32.DLL"); + if (!hImm32) hImm32 = LoadLibrary("IMM32.DLL"); + + fIME = FALSE; + Vime_control = Qnil; + IME_event_off_count = 0; + + if (hImm32) + { + ImmGetOpenStatusProc = + (IMMGETOPENSTATUSPROC) + GetProcAddress (hImm32, + "ImmGetOpenStatus"); + ImmSetOpenStatusProc = + (IMMSETOPENSTATUSPROC) + GetProcAddress (hImm32, + "ImmSetOpenStatus"); + ImmGetDefaultIMEWndProc = + (IMMGETDEFAULTIMEWNDPROC) + GetProcAddress (hImm32, + "ImmGetDefaultIMEWnd"); + ImmGetCompositionStringProc = + (IMMGETCOMPOSITIONSTRINGPROC) + GetProcAddress (hImm32, "ImmGetCompositionStringA"); + ImmSetCompositionStringProc = + (IMMSETCOMPOSITIONSTRINGPROC) + GetProcAddress (hImm32, "ImmSetCompositionStringA"); + ImmSetCompositionFontProc = + (IMMSETCOMPOSITIONFONTPROC) + GetProcAddress (hImm32, "ImmSetCompositionFontA"); + ImmGetContextProc = + (IMMGETCONTEXTPROC) + GetProcAddress (hImm32, + "ImmGetContext"); + ImmGetConversionStatusProc = + (IMMGETCONVERSIONSTATUSPROC) + GetProcAddress (hImm32, + "ImmGetConversionStatus"); + ImmSetConversionStatusProc = + (IMMSETCONVERSIONSTATUSPROC) + GetProcAddress (hImm32, + "ImmSetConversionStatus"); + ImmGetConversionListProc = + (IMMGETCONVERSIONLISTPROC) + GetProcAddress (hImm32, + "ImmGetConversionListA"); + ImmConfigureIMEProc = + (IMMCONFIGUREIMEPROC) + GetProcAddress (hImm32, + "ImmConfigureIMEA"); + ImmNotifyIMEProc = + (IMMNOTIFYIMEPROC) + GetProcAddress (hImm32, + "ImmNotifyIME"); + ImmReleaseContextProc = + (IMMRELEASECONTEXTPROC) + GetProcAddress (hImm32, + "ImmReleaseContext"); + ImmCreateContextProc = + (IMMCREATECONTEXTPROC) + GetProcAddress (hImm32, + "ImmCreateContext"); + ImmDestroyContextProc = + (IMMDESTROYCONTEXTPROC) + GetProcAddress (hImm32, + "ImmDestroyContext"); + ImmAssociateContextProc = + (IMMASSOCIATECONTEXTPROC) + GetProcAddress (hImm32, + "ImmAssociateContext"); + ImmGetCandidateListProc = + (IMMGETCANDIDATELISTPROC) + GetProcAddress (hImm32, + "ImmGetCandidateListA"); + ImmGetCandidateListCountProc = + (IMMGETCANDIDATELISTCOUNTPROC) + GetProcAddress (hImm32, + "ImmGetCandidateListCountA"); + ImmGetHotKeyProc = + (IMMGETHOTKEYPROC) + GetProcAddress (hImm32, + "ImmGetHotKey"); + + if (ImmGetOpenStatusProc && + ImmSetOpenStatusProc && + ImmGetDefaultIMEWndProc && + ImmGetCompositionStringProc && + ImmSetCompositionStringProc && + ImmSetCompositionFontProc && + ImmGetContextProc && + ImmGetConversionStatusProc && + ImmSetConversionStatusProc && + ImmGetConversionListProc && + ImmConfigureIMEProc && + ImmNotifyIMEProc && + ImmReleaseContextProc && + ImmCreateContextProc && + ImmDestroyContextProc && + ImmAssociateContextProc && + ImmGetCandidateListProc && + ImmGetCandidateListCountProc && + ImmGetHotKeyProc) + { + fIME = TRUE; + Vime_control = Qt; + } + } +} + +#ifdef HAVE_NTGUI +void w32_set_ime_font(HWND hwnd, LPLOGFONT psetlf) +{ + HIMC himc; + if (fIME && psetlf && !NILP (Vime_control)) + { + himc = (ImmGetContextProc)(hwnd); + if (!himc) return; + (ImmSetCompositionFontProc)(himc, psetlf); + (ImmReleaseContextProc) (hwnd, himc); + } +} +#endif /* HAVE_NTGUI */ + +/* From here, communication programs to make IME a conversion machine. */ + +void +check_immcontext(Lisp_Object context) +{ + if (NUMBERP(context)) + { + if (!((XFASTINT(context) >= 0) && + (XFASTINT(context) < MAX_CONVAGENT))) + error("Wrong number of agent"); + } + else + { + CHECK_LIST(context); + CHECK_NUMBER(XCONS(context)->car); + CHECK_NUMBER(XCONS(context)->cdr); + } +} + +HIMC +immcontext(Lisp_Object context) +{ + if (NUMBERP(context)) + return agent[XFASTINT(context)].himc; + else + return ((((unsigned long)(XCONS(context)->car)) << 16) | + (((unsigned long)(XCONS(context)->cdr)) & 0xffff)); +} + +LRESULT CALLBACK +conversion_agent_wndproc(HWND hwnd, UINT message, + WPARAM wparam, LPARAM lparam) +{ + HIMC himc, holdimc; + + switch (message) + { + case WM_CREATE: + himc = (ImmCreateContextProc)(); + holdimc = (ImmAssociateContextProc)(hwnd, himc); + SetWindowLong(hwnd, 0, himc); + SetWindowLong(hwnd, 4, holdimc); + break; + + case WM_DESTROY: + holdimc = GetWindowLong(hwnd, 4); + himc = (ImmAssociateContextProc)(hwnd, holdimc); + (ImmDestroyContextProc)(himc); + break; + + case WM_MULE_IMM_SET_STATUS: + w32_set_ime_status(hwnd, (int)wparam); + break; + + case WM_MULE_IMM_GET_STATUS: + return w32_get_ime_status(hwnd); + + case WM_MULE_IMM_GET_UNDETERMINED_STRING_LENGTH: + return w32_get_ime_undetermined_string_length(hwnd); + + case WM_MULE_IMM_SET_MODE: + return w32_set_ime_mode(hwnd, (int)wparam, (int)lparam); + + case WM_MULE_IMM_SET_COMPOSITION_STRING: +#if 0 + return w32_set_ime_composition_string(hwnd, (int)wparam, (int)lparam); +#endif + + case WM_MULE_IMM_GET_COMPOSITION_STRING: + return w32_get_ime_composition_string(hwnd); + + case WM_MULE_IMM_NOTIFY: +#if 0 + return w32_ime_notify(hwnd, (int)wparam, (int)lparam); +#endif + + default: + return DefWindowProc(hwnd, message, wparam, lparam); + } + return 0; +} + +int +initialize_conversion_agent() +{ + int i; + WNDCLASS wc; + + for (i = 0;i < MAX_CONVAGENT;i++) + { + agent[i].hwnd = 0; + agent[i].himc = 0; + } + + wc.style = 0; + wc.lpfnWndProc = conversion_agent_wndproc; + wc.cbClsExtra = 0; + wc.cbWndExtra = sizeof(long) * 2; + wc.hInstance = hinst; + wc.hIcon = NULL; + wc.hCursor = NULL; + wc.hbrBackground = NULL; + wc.lpszMenuName = NULL; + wc.lpszClassName = CONVAGENT_CLASS; + + if (!RegisterClass(&wc)) + return 0; + + return 1; +} + +#if 0 +void +generate_ime_hot_key(HWND hwnd) +{ + HKL imehkl; + UINT modifier; + UINT vkey; + (ImmGetHotKeyProc)(IME_JHOTKEY_CLOSE_OPEN, + &modifier, &vkey, &imehkl); +#endif + +Lisp_Object +get_style_lisp_object (DWORD dwStyle) +{ + switch (dwStyle) + { + case IME_CAND_READ: + return intern ("read"); + case IME_CAND_CODE: + return intern ("code"); + case IME_CAND_MEANING: + return intern ("meaning"); + case IME_CAND_RADICAL: + return intern ("radical"); + case IME_CAND_STROKE: + return intern ("stroke"); + case IME_CAND_UNKNOWN: + return intern ("unknown"); + default: + break; + } + + return Qnil; +} + +Lisp_Object +get_attribute_lisp_object (BYTE attr) +{ + switch (attr) + { + case ATTR_INPUT: + return intern ("input"); + case ATTR_TARGET_CONVERTED: + return intern ("target-converted"); + case ATTR_CONVERTED: + return intern ("converted"); + case ATTR_TARGET_NOTCONVERTED: + return intern ("target-not-converted"); + case ATTR_INPUT_ERROR: + return intern ("input-error"); + default: + break; + } + return Qnil; +} + +BYTE lisp_object_to_attribute_data (Lisp_Object attr) +{ + if (EQ (attr, intern ("input"))) + return ATTR_INPUT; + else if (EQ (attr, intern ("target-converted"))) + return ATTR_TARGET_CONVERTED; + else if (EQ (attr, intern ("converted"))) + return ATTR_CONVERTED; + else if (EQ (attr, intern ("target-not-converted"))) + return ATTR_TARGET_NOTCONVERTED; + else if (EQ (attr, intern ("input-error"))) + return ATTR_INPUT_ERROR; + else + error ("Wrong attribute"); + + return 0; +} + + + +/* + Emacs Lisp function entries +*/ + +DEFUN ("fep-force-on", Ffep_force_on, Sfep_force_on, 0, 1, 0, + doc: /* Force status of IME open. */) + (eventp) + Lisp_Object eventp; +{ + if (fIME && !NILP (Vime_control)) + { + HIMC himc; + HWND hwnd; + + if (!NILP(Ffep_get_mode())) return Qnil; +#ifdef HAVE_NTGUI + if (NILP(eventp)) + IME_event_off_count++; + hwnd = FRAME_W32_WINDOW(SELECTED_FRAME()); +#else + hwnd = hwndConsole; +#endif + SendMessage(hwnd, WM_MULE_IMM_SET_STATUS, 1, 0); + } + return Qnil; +} + + +DEFUN ("fep-force-off", Ffep_force_off, Sfep_force_off, 0, 1, 0, + doc: /* Force status of IME close. */) + (eventp) + Lisp_Object eventp; +{ + if (fIME && !NILP (Vime_control)) + { + HIMC himc; + HWND hwnd; + + if (NILP(Ffep_get_mode())) return Qnil; +#ifdef HAVE_NTGUI + if (NILP(eventp)) + IME_event_off_count++; + hwnd = FRAME_W32_WINDOW(SELECTED_FRAME()); +#else + hwnd = hwndConsole; +#endif + SendMessage(hwnd, WM_MULE_IMM_SET_STATUS, 0, 0); + } + return Qnil; +} + + +DEFUN ("fep-get-mode", Ffep_get_mode, Sfep_get_mode, 0, 0, "", + doc: /* Get IME status. +t means status of IME is open. nil means it is close. */) + () +{ + if (fIME && !NILP (Vime_control)) + { + HWND hwnd; + int result; + +#ifdef HAVE_NTGUI + hwnd = FRAME_W32_WINDOW(SELECTED_FRAME()); +#else + hwnd = hwndConsole; +#endif + result = SendMessage(hwnd, WM_MULE_IMM_GET_STATUS, 0, 0); + + return result ? Qt : Qnil; + } + else + return Qnil; +} + +DEFUN ("w32-ime-undetermined-string-length", + Fw32_ime_undetermined_string_length, + Sw32_ime_undetermined_string_length, 0, 0, "", + doc: /* Return length in byte of undetermined strings the current IME have. */) + () +{ + + if (fIME && !NILP (Vime_control)) + { + HWND hwnd; + long len; + +#ifdef HAVE_NTGUI + hwnd = FRAME_W32_WINDOW(SELECTED_FRAME()); +#else + hwnd = hwndConsole; +#endif + len = SendMessage(hwnd, WM_MULE_IMM_GET_UNDETERMINED_STRING_LENGTH, + 0, 0); + + return make_number(len); + } + else + return Qnil; +} + +DEFUN ("w32-set-ime-mode", + Fw32_set_ime_mode, + Sw32_set_ime_mode, 1, 2, 0, + doc: /* Set IME mode to MODE. If FRAME is omitted, the selected frame is used. */) + (mode, frame) + Lisp_Object mode, frame; +{ + FRAME_PTR f; + + if (NILP(frame)) + { + f = SELECTED_FRAME(); + } + else + { + CHECK_FRAME(frame); + f = XFRAME(frame); + } + if (fIME && !NILP (Vime_control)) + { + HWND hwnd; + int ret; + int newmode, mask; + + newmode = 0; + mask = 0; + + hwnd = FRAME_W32_WINDOW(f); + + if (EQ(mode, intern("katakana"))) + { + newmode |= IME_CMODE_KATAKANA; + mask |= IME_CMODE_KATAKANA; + } + else if (EQ(mode, intern("hiragana"))) + { + newmode &= ~IME_CMODE_KATAKANA; + mask |= IME_CMODE_KATAKANA; + } + else if (EQ(mode, intern("kanji"))) + { + newmode |= IME_CMODE_HANJACONVERT; + mask |= IME_CMODE_HANJACONVERT; + } + else if (EQ(mode, intern("nokanji"))) + { + newmode &= ~IME_CMODE_HANJACONVERT; + mask |= IME_CMODE_HANJACONVERT; + } + else if (EQ(mode, intern("code"))) + { + newmode |= IME_CMODE_CHARCODE; + mask |= IME_CMODE_CHARCODE; + } + else if (EQ(mode, intern("nocode"))) + { + newmode &= ~IME_CMODE_CHARCODE; + mask |= IME_CMODE_CHARCODE; + } + else if (EQ(mode, intern("noconvert"))) + { + newmode |= IME_CMODE_NOCONVERSION; + mask |= IME_CMODE_NOCONVERSION; + } + else if (EQ(mode, intern("convert"))) + { + newmode &= ~IME_CMODE_NOCONVERSION; + mask |= IME_CMODE_NOCONVERSION; + } + else + error("unknown mode!!"); + + ret = SendMessage(hwnd, WM_MULE_IMM_SET_MODE, + (WPARAM)newmode, (LPARAM)mask); + + if (!ret) return Qnil; + return Qt; + } + return Qnil; +} + +DEFUN ("w32-ime-register-word-dialog", + Fw32_ime_register_word_dialog, + Sw32_ime_register_word_dialog, 2, 2, 0, + doc: /* Open IME regist word dialog. */) + (reading, word) + Lisp_Object reading, word; +{ + HKL hkl; + int len; + REGISTERWORD regword; + MEADOW_ENCODE_ALLOC_PREDEFINE; + + CHECK_STRING(reading); + CHECK_STRING(word); + + if (fIME && !NILP (Vime_control) && ImmConfigureIMEProc) + { + hkl = GetKeyboardLayout(0); + MEADOW_ENCODE_ALLOC(LISPY_STRING_BYTES(reading)); + MEADOW_ENCODE(XSTRING(reading)->data, LISPY_STRING_BYTES(reading)); + len = MEADOW_ENCODE_PRODUCED; + MEADOW_ENCODE_BUF[len] = '\0'; + regword.lpReading = MEADOW_ENCODE_BUF; + MEADOW_ENCODE_ALLOC(LISPY_STRING_BYTES(word)); + MEADOW_ENCODE(XSTRING(word)->data, LISPY_STRING_BYTES(word)); + len = MEADOW_ENCODE_PRODUCED; + MEADOW_ENCODE_BUF[len] = '\0'; + regword.lpWord = MEADOW_ENCODE_BUF; + (ImmConfigureIMEProc)(hkl, FRAME_W32_WINDOW(SELECTED_FRAME()), + IME_CONFIG_REGISTERWORD, ®word); + } + return Qnil; +} + +#if 0 /* incomplete */ + +DEFUN ("w32-ime-get-conversion-list", + Fw32_ime_get_conversion_list, + Sw32_ime_get_conversion_list, 2, 2, 0, + doc: /* Get IME conversion list. +OBJECT is converted by IME. Return candidates. +OPTION is as follows currently. +1....'forward + convert normally. +2....'backward + convert backward. + +OPTION will be revised in the future. + +Result have the form as follow. +(STYLE CANDIDATE1 CANDIDATE2 ...) */) + (object, option) + Lisp_Object object, option; +{ + Lisp_Object result, style; + struct gcpro gcpro1, gcpro2; + HKL hkl; + HIMC himc; + UINT flag; + int i, len, nbytes; + LPCANDIDATELIST lpcd; + MEADOW_ENCODE_ALLOC_PREDEFINE; + + CHECK_STRING (object, 0); + if (EQ (option, intern ("forward"))) + flag = GCL_CONVERSION; + else if (EQ (option, intern ("backward"))) + flag = GCL_REVERSECONVERSION; + else + error ("Unknown option %s", option); + + hkl = GetKeyboardLayout (0); + himc = (ImmCreateContextProc)(); + + MEADOW_ENCODE_ALLOC(LISPY_STRING_BYTES(object)); + MEADOW_ENCODE(XSTRING(object)->data, LISPY_STRING_BYTES(object)); + len = MEADOW_ENCODE_PRODUCED; + MEADOW_ENCODE_BUF[len] = '\0'; + + nbytes = (ImmGetConversionListProc)(hkl, himc, MEADOW_ENCODE_BUF, + NULL, 0, flag); + + lpcd = (LPCANDIDATELIST) alloca (nbytes); + if (!lpcd) return Qnil; + + (ImmGetConversionListProc)(hkl, himc, MEADOW_ENCODE_BUF, + lpcd, nbytes, flag); + + (ImmDestroyContextProc)(himc); + + result = Qnil; + + style = get_style_lisp_object (lpcd->dwStyle); + + GCPRO2 (style, result); + + for (i = lpcd->dwCount - 1;i >= 0;i--) + { + result = Fcons (build_string (((unsigned char *) lpcd) + + lpcd->dwOffset[i]), + result); + } + + UNGCPRO; + + return result; +} + +#endif + +#ifdef ENABLE_IMM_CONTEXT + +DEFUN ("w32-ime-create-context", + Fw32_ime_create_context, + Sw32_ime_create_context, 0, 0, 0, + doc: /* Create IME context. */) + () +{ + HIMC himc; + + CHECK_IME_FACILITY; + + himc = (ImmCreateContextProc)(); + + return Fcons(IMMCONTEXTCAR(himc), IMMCONTEXTCDR(himc)); +} + +DEFUN ("w32-ime-destroy-context", + Fw32_ime_destroy_context, + Sw32_ime_destroy_context, 1, 1, 0, + doc: /* Destroy IME context. */) + (context) + Lisp_Object context; +{ + HIMC himc; + + CHECK_IME_FACILITY; + + check_immcontext(context); + himc = immcontext(context); + + (ImmDestroyContextProc)(himc); + return Qnil; +} + +DEFUN ("w32-ime-associate-context", + Fw32_ime_associate_context, + Sw32_ime_associate_context, 1, 2, 0, + doc: /* Associate IME CONTEXT to FRAME. +Return an old context handle. */) + (context, frame) + Lisp_Object context, frame; +{ + HWND hwnd; + HIMC himc; + + CHECK_IME_FACILITY; + + check_immcontext(context); + + if (NILP(frame)) + hwnd = FRAME_W32_WINDOW(SELECTED_FRAME()); + else + { + CHECK_FRAME(frame, 0); + hwnd = FRAME_W32_WINDOW(XFRAME(frame)); + } + + himc = immcontext(context); + himc = (ImmAssociateContextProc)(hwnd, himc); + + return Fcons(IMMCONTEXTCAR(himc), IMMCONTEXTCDR(himc)); +} + +#endif /* ENABLE_IMM_CONTEXT */ + +DEFUN ("w32-ime-create-conversion-agent", + Fw32_ime_create_conversion_agent, + Sw32_ime_create_conversion_agent, 0, 0, 0, + doc: /* Create conversion agent. */) + () +{ + int i; + MSG msg; + HWND hwnd; + HIMC himc; + + CHECK_IME_FACILITY; + + if (conversion_agent_num == -1) + { + if (!initialize_conversion_agent()) + return Qnil; + conversion_agent_num = 0; + } + else if (conversion_agent_num == MAX_CONVAGENT) + return Qnil; + + conversion_agent_num++; + + for (i = 0;i < MAX_CONVAGENT;i++) + if (!agent[i].himc) break; + + SEND_MSGTHREAD_INFORM_MESSAGE (WM_MULE_IME_CREATE_AGENT, + (WPARAM) 0, (LPARAM) 0); + WAIT_REPLY_MESSAGE (&msg, WM_MULE_IME_CREATE_AGENT_REPLY); + hwnd = (HWND) msg.wParam; + agent[i].hwnd = hwnd; + agent[i].himc = GetWindowLong(hwnd, 0); + + /* ShowWindow(hwnd, SW_SHOW); */ + + SendMessage(hwnd, WM_MULE_IMM_SET_STATUS, 1, 0); + + return XFASTINT(i); +} + +DEFUN ("w32-ime-destroy-conversion-agent", + Fw32_ime_destroy_conversion_agent, + Sw32_ime_destroy_conversion_agent, 1, 1, 0, + doc: /* Destroy conversion agent. */) + (convagent) + Lisp_Object convagent; +{ + int num; + MSG msg; + HWND hwnd; + + CHECK_IME_FACILITY; + CHECK_NUMBER(convagent); + num = XINT(convagent); + + if ((conversion_agent_num == 0) || + (num < 0) || + (num > MAX_CONVAGENT) || + (agent[num].himc == 0)) + error ("Fail to destroy agent"); + + conversion_agent_num--; + + (ImmSetOpenStatusProc) (agent[num].himc, FALSE); + + SEND_INFORM_MESSAGE (agent[num].hwnd, WM_MULE_IME_DESTROY_AGENT, + (WPARAM) 0, (LPARAM) 0); + WAIT_REPLY_MESSAGE (&msg, WM_MULE_IME_DESTROY_AGENT_REPLY); + agent[num].hwnd = 0; + agent[num].himc = 0; + + return Qnil; +} + +DEFUN ("w32-ime-set-composition-string", + Fw32_ime_set_composition_string, + Sw32_ime_set_composition_string, 3, 4, 0, + doc: /* Set IME composition string. +CONTEXT must be a valid context handle. +COMPOSITION must be an alist consists of clause information. +FIELD specifies the field of composition strings which must be +one of the follows. + 'clause + 'string + 'attribute +When READINGP is non-nil, reading strings would be set. */) + (context, composition, field, readingp) + Lisp_Object context, composition, field, readingp; +{ + HIMC himc; + Lisp_Object curclause, curelem, str, attr; + unsigned char *context_string, *cs; + BYTE *attr_array, *aa; + DWORD *clause_array, *ca; + int clause_num, size, strsize, str_total_size; + /* int start_idx, end_idx; */ + struct coding_system coding; + + clause_num = size = 0; + + CHECK_IME_FACILITY; + + check_immcontext(context); + CHECK_LIST(composition); + CHECK_SYMBOL(field); + himc = immcontext(context); + + for (curclause = composition;CONSP(curclause); + curclause = XCONS(curclause)->cdr) + { + CHECK_LIST(curclause); + curelem = XCONS(curclause)->car; + CHECK_LIST(curelem); + str = XCONS(curelem)->car; + attr = XCONS(curelem)->cdr; + CHECK_STRING(str); + CHECK_SYMBOL(attr); + size += LISPY_STRING_BYTES(str); + clause_num++; + } + + if (size == 0) return Qnil; + + setup_coding_system(Fcheck_coding_system(Vlocale_coding_system), + &coding); + size = encoding_buffer_size(&coding, size); + + attr_array = (BYTE *) alloca(size * sizeof(BYTE)); + context_string = (unsigned char *) alloca(size * sizeof(char)); + clause_array = (DWORD *) alloca((clause_num + 1) * sizeof(DWORD)); + if ((!attr_array) || (!context_string) || (!clause_array)) + error ("Can't allocate memory!"); + + aa = attr_array; + cs = context_string; + ca = clause_array; + *ca = 0; + + str_total_size = 0; + for (curclause = composition;CONSP(curclause); + curclause = XCONS(curclause)->cdr) + { + curelem = XCONS(curclause)->car; + str = XCONS(curelem)->car; + attr = XCONS(curelem)->cdr; + encode_coding(&coding, XSTRING(str)->data, cs, + LISPY_STRING_BYTES(str), size); + strsize = coding.produced; + str_total_size += strsize; + size -= strsize; + cs += strsize; + memset(aa, + lisp_object_to_attribute_data(attr), + strsize); + aa += strsize; + *(ca + 1) = *ca + strsize; + ca++; + } + + if (!NILP(readingp)) + { + if (EQ(field, intern("string"))) + (ImmSetCompositionStringProc)(himc, SCS_SETSTR, NULL, 0, + context_string, str_total_size); + else if (EQ(field, intern("clause"))) + (ImmSetCompositionStringProc)(himc, SCS_CHANGECLAUSE, NULL, 0, + clause_array, + (clause_num + 1) * sizeof(DWORD)); + else if (EQ(field, intern("attribute"))) + (ImmSetCompositionStringProc)(himc, SCS_CHANGEATTR, NULL, 0, + attr_array, str_total_size); + else + error("Unknown field:%s", SYMBOL_NAME(field)); + } + else + { + if (EQ(field, intern("string"))) + (ImmSetCompositionStringProc)(himc, SCS_SETSTR, + context_string, str_total_size, + NULL, 0); + else if (EQ(field, intern("clause"))) + (ImmSetCompositionStringProc)(himc, SCS_CHANGECLAUSE, + clause_array, + (clause_num + 1) * sizeof(DWORD), + NULL, 0); + else if (EQ(field, intern("attribute"))) + (ImmSetCompositionStringProc)(himc, SCS_CHANGEATTR, + attr_array, str_total_size, + NULL, 0); + else + error("Unknown field:%s", SYMBOL_NAME(field)); + } + + return Qnil; + +} + +DEFUN ("w32-ime-get-composition-string", + Fw32_ime_get_composition_string, + Sw32_ime_get_composition_string, 2, 2, 0, + doc: /* Get IME composition strings. +INFO means as follows. + + 'comp.........current composition information. + 'compread.....current reading composition information. + 'result.......resultant composition information. + 'resultread...resultant reading composition information. */) + (context, info) + Lisp_Object context, info; +{ + HIMC himc; + DWORD clause_index, attr_index, str_index; + + DWORD *clause_array; + BYTE *attr_array, *aa; + unsigned char *compstr, *cs; + long clause_size, attr_size, compstr_size; + + int start_idx, end_idx; + + int i, clause_num, size; + + Lisp_Object str; + + Lisp_Object result = Qnil; + + CHECK_IME_FACILITY; + + check_immcontext(context); + himc = immcontext(context); + + if (EQ(info, intern("comp"))) + { + clause_index = GCS_COMPCLAUSE; + attr_index = GCS_COMPATTR; + str_index = GCS_COMPSTR; + } + else if (EQ(info, intern("compread"))) + { + clause_index = GCS_COMPREADCLAUSE; + attr_index = GCS_COMPREADATTR; + str_index = GCS_COMPREADSTR; + } + else if (EQ(info, intern("result"))) + { + clause_index = GCS_RESULTCLAUSE; + attr_index = GCS_COMPATTR; + str_index = GCS_RESULTSTR; + } + else if (EQ(info, intern("resultread"))) + { + clause_index = GCS_RESULTREADCLAUSE; + attr_index = GCS_COMPREADATTR; + str_index = GCS_RESULTREADSTR; + } + else + error ("Invalid option!"); + + clause_size = (ImmGetCompositionStringProc)(himc, clause_index, NULL, 0); + attr_size = (ImmGetCompositionStringProc)(himc, attr_index, NULL, 0); + compstr_size = (ImmGetCompositionStringProc)(himc, str_index, NULL, 0); + + if ((clause_size < 0) || + (attr_size < 0) || + (compstr_size < 0)) + error ("IME internal error!"); + + clause_array = (DWORD *) alloca(clause_size); + attr_array = (BYTE *) alloca(attr_size); + compstr = (unsigned char *) alloca(compstr_size); + + if ((!attr_array) || (!compstr) || (!clause_array)) + error ("Can't allocate memory!"); + + if (((ImmGetCompositionStringProc) + (himc, clause_index, clause_array, clause_size) < 0) || + ((ImmGetCompositionStringProc) + (himc, attr_index, attr_array, attr_size) < 0) || + ((ImmGetCompositionStringProc) + (himc, str_index, compstr, compstr_size) < 0)) + error ("IME internal error!"); + + clause_num = clause_size / sizeof(DWORD) - 2; + end_idx = 0; + for (i = clause_num;i >= 0;i--) + { + cs = compstr + clause_array[i]; + aa = attr_array + clause_array[i]; + size = clause_array[i + 1] - clause_array[i]; + + start_idx = end_idx; + str = Fdecode_coding_string(make_string(cs, size), + Vlocale_coding_system, + Qt); + end_idx = start_idx + LISPY_STRING_BYTES(str); + result = Fconcat(result, str); + + Fput_text_property(start_idx, end_idx, Qim_info, + get_attribute_lisp_object(*aa), + result); + } + + return result; +} + +DEFUN ("w32-ime-get-candidate-list", + Fw32_ime_get_candidate_list, + Sw32_ime_get_candidate_list, 2, 2, 0, + doc: /* Get IME candidate list. */) + (context, index) + Lisp_Object context, index; +{ + HIMC himc; + DWORD counts; + LPCANDIDATELIST lpcd; + int size, i; + Lisp_Object style, result = Qnil; + + CHECK_IME_FACILITY; + check_immcontext(context); + CHECK_NUMBER(index); + himc = immcontext(context); + + size = (ImmGetCandidateListCountProc)(himc, &counts); + lpcd = (LPCANDIDATELIST) alloca(size); + + if (!lpcd) + error ("Can't allocate memory!"); + + if (!(ImmGetCandidateListProc)(himc, XFASTINT(index), lpcd, size)) + error ("Can't retrieve any candidate lists."); + + for (i = lpcd->dwCount - 1;i >= 0;i--) + { + result = + Fcons (Fdecode_coding_string (build_string (((unsigned char *) lpcd) + + lpcd->dwOffset[i]), + Vlocale_coding_system, Qt), + result); + } + + style = get_style_lisp_object (lpcd->dwStyle); + + result = Fcons(style, result); + + return result; +} + +DEFUN ("w32-ime-select-candidate", + Fw32_ime_select_candidate, + Sw32_ime_select_candidate, 3, 3, 0, + doc: /* Select a candidate. +CONTEXT must be a valid context handle. +CLAUSE must be a clause index where you want +to change the current candidate. +CANDIDATE must be a candidate index. */) + (context, clause, candidate) + Lisp_Object context, clause, candidate; +{ + HIMC himc; + + CHECK_IME_FACILITY; + check_immcontext(context); + CHECK_NUMBER(clause); + CHECK_NUMBER(candidate); + + himc = immcontext(context); + if (!(ImmNotifyIMEProc)(himc, NI_SELECTCANDIDATESTR, + XFASTINT(clause), XFASTINT(candidate))) + error ("Fail to select candidate!"); + + return Qnil; +} + +DEFUN ("w32-ime-change-candidate", + Fw32_ime_change_candidate, + Sw32_ime_change_candidate, 2, 2, 0, + doc: /* Change a candidate list. */) + (context, clause) + Lisp_Object context, clause; +{ + HIMC himc; + + CHECK_IME_FACILITY; + check_immcontext(context); + CHECK_NUMBER(clause); + + himc = immcontext(context); + + if (!(ImmNotifyIMEProc)(himc, NI_CHANGECANDIDATELIST, + XFASTINT(clause), 0)); + error ("Fail to change a candidate list!"); + + return Qnil; +} + +DEFUN ("w32-ime-open-candidate", + Fw32_ime_open_candidate, + Sw32_ime_open_candidate, 2, 2, 0, + doc: /* Open a candidate list. */) + (context, clause) + Lisp_Object context, clause; +{ + HIMC himc; + + CHECK_IME_FACILITY; + check_immcontext(context); + CHECK_NUMBER(clause); + + himc = immcontext(context); + + if (!(ImmNotifyIMEProc)(himc, NI_OPENCANDIDATE, + XFASTINT(clause), 0)); + error ("Fail to open a candidate list!"); + + return Qnil; +} + +DEFUN ("w32-ime-close-candidate", + Fw32_ime_close_candidate, + Sw32_ime_close_candidate, 2, 2, 0, + doc: /* Open a candidate list. */) + (context, clause) + Lisp_Object context, clause; +{ + HIMC himc; + + CHECK_IME_FACILITY; + check_immcontext(context); + CHECK_NUMBER(clause); + + himc = immcontext(context); + + if (!(ImmNotifyIMEProc)(himc, NI_CLOSECANDIDATE, + XFASTINT(clause), 0)); + error ("Fail to close a candidate list!"); + + return Qnil; +} + +DEFUN ("w32-ime-deal-with-context", + Fw32_ime_deal_with_context, + Sw32_ime_deal_with_context, 2, 2, 0, + doc: /* Notify IME to deal with a context. +You can command IME to change a context. +OPERATION must be one of the followings. + + 'cancel .... clear the composition strings. + 'complete .. make the composition strings result strings. + 'convert ... convert the composition strings. + 'revert .... revert the composition strings. */) + (context, operation) + Lisp_Object context, operation; +{ + HIMC himc; + DWORD op; + + CHECK_IME_FACILITY; + + check_immcontext(context); + + CHECK_SYMBOL(operation); + + himc = immcontext(context); + + if (EQ(operation, intern("cancel"))) + op = CPS_CANCEL; + else if (EQ(operation, intern("complete"))) + op = CPS_COMPLETE; + else if (EQ(operation, intern("convert"))) + op = CPS_CONVERT; + else if (EQ(operation, intern("revert"))) + op = CPS_REVERT; + else + error("Unknown operation:%s", SYMBOL_NAME(operation)); + + if (!(ImmNotifyIMEProc)(himc, NI_COMPOSITIONSTR, + op, 0)) + error ("Fail to deal with the context."); + + return Qnil; +} + +#endif /* IME_CONTROL */ + +syms_of_w32ime() +{ +#ifdef IME_CONTROL + + Qim_info = intern("im_info"); + staticpro(&Qim_info); + + DEFVAR_LISP ("ime-control", &Vime_control, "IME control flag"); + + defsubr (&Sfep_force_on); + defsubr (&Sfep_force_off); + defsubr (&Sfep_get_mode); + defsubr (&Sw32_ime_undetermined_string_length); + + defsubr (&Sw32_set_ime_mode); + + defsubr (&Sw32_ime_register_word_dialog); + +#ifdef ENABLE_IMM_CONTEXT + defsubr (&Sw32_ime_create_context); + defsubr (&Sw32_ime_destroy_context); + defsubr (&Sw32_ime_associate_context); +#endif + + defsubr (&Sw32_ime_create_conversion_agent); + defsubr (&Sw32_ime_destroy_conversion_agent); + defsubr (&Sw32_ime_set_composition_string); + defsubr (&Sw32_ime_get_composition_string); + defsubr (&Sw32_ime_get_candidate_list); + defsubr (&Sw32_ime_select_candidate); + defsubr (&Sw32_ime_change_candidate); + defsubr (&Sw32_ime_open_candidate); + defsubr (&Sw32_ime_close_candidate); + defsubr (&Sw32_ime_deal_with_context); + /* defsubr (&Sw32_ime_get_conversion_list); */ + +#endif /* IME_CONTROL */ +} Index: src/frame.c =================================================================== --- src/frame.c (.../trunk) (revision 10) +++ src/frame.c (.../branches/ime) (revision 10) @@ -2503,6 +2503,10 @@ has an `x-frame-parameter' property which is an integer in Lisp that is an index in this table. */ +#ifdef IME_CONTROL +extern void x_set_ime_font (struct frame *, Lisp_Object, Lisp_Object); +#endif /* IME_CONTROL */ + struct frame_parm_table { char *name; Lisp_Object *variable; @@ -2518,6 +2522,9 @@ {"cursor-color", &Qcursor_color}, {"cursor-type", &Qcursor_type}, {"font", 0}, +#ifdef IME_CONTROL + {"ime-font", &Qime_font}, +#endif /* IME_CONTROL */ {"foreground-color", 0}, {"icon-name", &Qicon_name}, {"icon-type", &Qicon_type}, Index: src/frame.h =================================================================== --- src/frame.h (.../trunk) (revision 10) +++ src/frame.h (.../branches/ime) (revision 10) @@ -982,6 +982,9 @@ extern Lisp_Object Qbuffer_predicate, Qbuffer_list; extern Lisp_Object Qcursor_color, Qcursor_type; extern Lisp_Object Qfont; +#ifdef IME_CONTROL +extern Lisp_Object Qime_font; +#endif extern Lisp_Object Qbackground_color, Qforeground_color; extern Lisp_Object Qicon, Qicon_name, Qicon_type, Qicon_left, Qicon_top; extern Lisp_Object Qinternal_border_width; Index: src/callproc.c =================================================================== --- src/callproc.c (.../trunk) (revision 10) +++ src/callproc.c (.../branches/ime) (revision 10) @@ -384,7 +384,16 @@ struct gcpro gcpro1; GCPRO1 (current_dir); +#ifndef MEADOW openp (Vexec_path, args[0], Vexec_suffixes, &path, make_number (X_OK)); +#else + /* for script execution on MSWindows, not apply exec_only for openp */ + /* openp without exec_only returns fd not used, free it immediately */ + { + int fd = openp (Vexec_path, args[0], Vexec_suffixes, &path, Qnil); + if (fd > 0) close(fd); + } +#endif UNGCPRO; } if (NILP (path)) @@ -1502,7 +1511,11 @@ PATH_EXEC path from epaths.h. */ Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC); Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path)); +#ifdef MEADOW + Vexec_path = nconc2 (Vexec_path, decode_env_path ("PATH", "")); +#else Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path); +#endif } /* This is run after init_cmdargs, when Vinstallation_directory is valid. */ Index: src/window.c =================================================================== --- src/window.c (.../trunk) (revision 10) +++ src/window.c (.../branches/ime) (revision 10) @@ -214,6 +214,13 @@ static int inhibit_frame_unsplittable; #endif /* 0 */ +#ifdef MEADOW +Lisp_Object Vset_selected_window_buffer_functions; +Lisp_Object Qset_selected_window_buffer_functions; +Lisp_Object Vselect_window_functions; +Lisp_Object Qselect_window_functions; +#endif + extern EMACS_INT scroll_margin; extern Lisp_Object Qwindow_scroll_functions, Vwindow_scroll_functions; @@ -3066,6 +3073,17 @@ } set_window_buffer (window, buffer, 1, !NILP (keep_margins)); +#ifdef MEADOW + if (! NILP (Vset_selected_window_buffer_functions)) + { + Lisp_Object temp[4]; + temp[0] = Qset_selected_window_buffer_functions; + temp[1] = tem; + temp[2] = window; + temp[3] = buffer; + Frun_hook_with_args (4, temp); + } +#endif return Qnil; } @@ -3087,6 +3105,9 @@ register struct window *w; register struct window *ow; struct frame *sf; +#ifdef MEADOW + Lisp_Object oldwin = selected_window; +#endif CHECK_LIVE_WINDOW (window); @@ -3142,6 +3163,10 @@ } windows_or_buffers_changed++; +#ifdef MEADOW + if (!NILP (Vselect_window_functions)) + run_hook_with_args_2 (Qselect_window_functions, oldwin, window); +#endif return window; } @@ -6428,6 +6453,16 @@ Qwindow_configuration_change_hook = intern ("window-configuration-change-hook"); +#ifdef MEADOW + staticpro (&Qset_selected_window_buffer_functions); + Qset_selected_window_buffer_functions + = intern ("set-selected-window-buffer-functions"); + + staticpro (&Qselect_window_functions); + Qselect_window_functions + = intern ("select-window-functions"); +#endif + Qwindowp = intern ("windowp"); staticpro (&Qwindowp); @@ -6629,6 +6664,21 @@ Fmake_variable_buffer_local (Qwindow_size_fixed); window_size_fixed = 0; +#ifdef MEADOW + DEFVAR_LISP ("select-window-functions", &Vselect_window_functions, + "This is a hook when select-window is called.\n\ +The hook is called with two arguments OLD-WINDOW and NEW-WINDOW."); + Vselect_window_functions = Qnil; + + DEFVAR_LISP ("set-selected-window-buffer-functions", + &Vset_selected_window_buffer_functions, + "This is a hook when set-selected-window-buffer is called.\n\ +This is called with three arguments\n\ +OLD-BUFFER, NEW-WINDOW and NEW-BUFFER.\n\ +If NEW-WINDOW is first being set up, OLD-BUFFER is t."); + Vset_selected_window_buffer_functions = Qnil; +#endif + defsubr (&Sselected_window); defsubr (&Sminibuffer_window); defsubr (&Swindow_minibuffer_p); Index: info/dir =================================================================== --- info/dir (.../trunk) (revision 10) +++ info/dir (.../branches/ime) (revision 10) @@ -19,50 +19,53 @@ * Menu: Each line that starts with a * is a topic you can select with "m". Every third topic has a red *. -* Info: (info). How to use the documentation browsing system. Emacs +* Ada mode: (ada-mode). Emacs mode for editing Ada code. +* Autotype: (autotype). Convenient features for text that you enter frequently + in Emacs. +* CC Mode: (ccmode). Emacs mode for editing C, C++, Objective-C, + Java, Pike, AWK, and CORBA IDL code. +* CL: (cl). Partial Common Lisp support for Emacs Lisp. +* Calc: (calc). Advanced desk calculator and mathematical tool. +* Dired-X: (dired-x). Dired Extra Features. +* EUDC: (eudc). An Emacs client for directory servers (LDAP, PH). +* Ebrowse: (ebrowse). A C++ class browser for Emacs. +* Ediff: (ediff). A visual interface for comparing and merging programs. +* Elisp: (elisp). The Emacs Lisp Reference Manual. * Emacs: (emacs). The extensible self-documenting text editor. * Emacs FAQ: (efaq). Frequently Asked Questions about Emacs. -* Emacs Lisp Introduction: (eintr). +* Emacs Lisp Intro: (eintr). A simple introduction to Emacs Lisp programming. -* Elisp: (elisp). The Emacs Lisp Reference Manual. -* CL: (cl). Partial Common Lisp support for Emacs Lisp. -* Dired-X: (dired-x). Dired Extra Features. -* Ediff: (ediff). A visual interface for comparing and merging programs. -* PCL-CVS: (pcl-cvs). Emacs front-end to CVS. -* Speedbar: (speedbar). File/Tag summarizing utility. - -* Ada mode: (ada-mode). Emacs mode for editing Ada code. -* CC mode: (ccmode). Emacs mode for editing C, C++, Objective-C, - Java, Pike, and IDL code. -* Ebrowse: (ebrowse). A C++ class browser for Emacs. -* IDLWAVE: (idlwave). Major mode and shell for IDL and WAVE/CL files. - -* Gnus: (gnus). The news reader Gnus. -* Message: (message). Mail and news composition mode that goes with Gnus. +* Eshell: (eshell). A command shell implemented in Emacs Lisp. +* Forms: (forms). Emacs package for editing data bases + by filling in forms. +* Gnus: (gnus). The newsreader Gnus. +* IDLWAVE: (idlwave). Major mode and shell for IDL files. * MH-E: (mh-e). Emacs interface to the MH mail system. * MIME: (emacs-mime). Emacs MIME de/composition library. -* SC: (sc). Supercite lets you cite parts of messages you're +* Message: (message). Mail and news composition mode that goes with Gnus. +* PCL-CVS: (pcl-cvs). Emacs front-end to CVS. +* RefTeX: (reftex). Emacs support for LaTeX cross-references and citations. +* SC: (sc). Supercite lets you cite parts of messages you're replying to, in flexible ways. -* Autotype: (autotype). Convenient features for text that you enter frequently - in Emacs. -* Calc: (calc). Advanced desk calculator and mathematical tool. -* Eshell: (eshell). A command shell implemented in Emacs Lisp. -* EUDC: (eudc). An Emacs client for directory servers (LDAP, PH). -* Forms: (forms). Emacs package for editing data bases - by filling in forms. -* RefTeX: (reftex). Emacs support for LaTeX cross-references and citations. -* Tramp: (tramp). Transparent Remote (file) Access, Multiple Protocol. - Edit remote files via a remote shell (rsh, - ssh, telnet). -* Widget: (widget). The "widget" package used by the Emacs Customization - facility. -* WoMan: (woman). Browse UN*X Manual Pages "Wo (without) Man". + +* SES: (ses). Simple Emacs Spreadsheet +* SMTP: (smtpmail). Emacs library for sending mail via SMTP. +* Speedbar: (speedbar). File/Tag summarizing utility. +* TRAMP: (tramp). Transparent Remote Access, Multiple Protocol + Emacs remote file access via rsh and rcp. +* VIP: (vip). An older VI-emulation for Emacs. * VIPER: (viper). The newest Emacs VI-emulation mode. (also, A VI Plan for Emacs Rescue or the VI PERil.) -* VIP: (vip). An older VI-emulation for Emacs. +* Widget: (widget). The "widget" package used by the Emacs Customization + facility. +* WoMan: (woman). Browse UN*X Manual Pages "W.O. (without) Man". + + +Texinfo documentation system +* Info: (info). How to use the documentation browsing system. Index: lisp/international/meadow-ntemacs.el =================================================================== --- lisp/international/meadow-ntemacs.el (revision 0) +++ lisp/international/meadow-ntemacs.el (revision 10) @@ -0,0 +1,419 @@ +;;;;; meadow-ntemacs.el ---- Meadow features for NTEmacs. +;; +;; Author H.Miyashita +;; +;;;;; + +(defgroup Meadow-ntemacs nil + "Meadow-ntemacs" + :group 'emacs) + +(defvar mw32-last-selection nil + "It is stored the last data from Emacs.") + +;---------- + +(defvar mw32-ime-on-hook nil + "Functions to eval when IME is turned on at least.\n\ +Even if IME state is not changed, these functiona are maybe called.") +(defvar mw32-ime-off-hook nil + "Functions to eval when IME is turned off at least.\n\ +Even if IME state is not changed, these functiona are maybe called.") +(defvar mw32-ime-buffer-switch-p t + "If this variable is nil, IME control when buffer is switched is disabled.") +(defvar mw32-ime-state nil + "This shows IME state of the buffer.(buffer local variable)") +(make-variable-buffer-local 'mw32-ime-state) +(defvar mw32-ime-show-mode-line t + "When t, mode line indicates IME state.") +(defvar mw32-ime-mode-line-state-indicator "[O]" + "This is shown at the mode line. It is regarded as state of ime.") +(make-variable-buffer-local 'mw32-ime-mode-line-state-indicator) +(defvar mw32-ime-mode-line-state-indicator-list '("-" "[|]" "[O]") + "List of IME state indicator string.") +(defvar mw32-ime-mode-line-format-original nil + "Original mode line format.") + +(setq search-highlight t) + +;; isearch ime keymap + +(setq isearch-ime-keymap (copy-keymap minibuffer-local-map)) +(nconc isearch-ime-keymap (list (make-vector 26 'isearch-exit-win32ime))) +(define-key isearch-ime-keymap [compend] 'exit-minibuffer) +(define-key isearch-ime-keymap [kanji] 'isearch-exit-win32ime) +(define-key isearch-ime-keymap "\C-s" 'isearch-command-win32ime) +(define-key isearch-ime-keymap "\C-r" 'isearch-command-win32ime) +(define-key isearch-ime-keymap "\177" 'isearch-command-win32ime) +(define-key isearch-ime-keymap "\C-g" 'isearch-command-win32ime) +(define-key isearch-ime-keymap "\C-q" 'isearch-command-win32ime) + +(define-key isearch-ime-keymap "\r" 'isearch-command-win32ime) +(define-key isearch-ime-keymap "\C-j" 'isearch-command-win32ime) +(define-key isearch-ime-keymap "\t" 'isearch-command-win32ime) +(define-key isearch-ime-keymap " " 'isearch-command-win32ime) + +(define-key isearch-ime-keymap "\C-w" 'isearch-command-win32ime) +(define-key isearch-ime-keymap "\C-y" 'isearch-command-win32ime) + +(let ((meta-map (make-sparse-keymap))) + (define-key isearch-ime-keymap (char-to-string meta-prefix-char) meta-map) + (define-key isearch-ime-keymap [escape] meta-map)) +(define-key isearch-ime-keymap + (vector meta-prefix-char t) 'isearch-exit-win32ime) +(define-key isearch-ime-keymap "\M-n" 'isearch-command-win32ime) +(define-key isearch-ime-keymap "\M-p" 'isearch-command-win32ime) +(define-key isearch-ime-keymap "\M-y" 'isearch-command-win32ime) +(define-key isearch-ime-keymap "\M-\t" 'isearch-command-win32ime) + +;;; +;;; Emulation functions. +;;; + +;; +;; Section: General definitions +;; + +(defvar w32-fiber-program-name "fiber.exe") +(defvar w32-fiber-process-name "*fiber*") + +(defun wildcard-to-regexp (pattern) + (let ((i 0) + (len (length pattern)) + (quotestr "") + (result "") + char + result) + (while (< i len) + (setq char (aref pattern i) + i (1+ i)) + (cond ((= char ?*) + (setq result (concat result (regexp-quote quotestr) ".*") + quotestr "")) + ((= char ??) + (setq result (concat result (regexp-quote quotestr) ".") + quotestr "")) + (t + (setq quotestr (concat quotestr (char-to-string char)))))) + (concat "\\`" result (regexp-quote quotestr) "\\'"))) + +;; +;; Section: X color +;; + +; (defun x-color-values (name &optional frame) +; (let ((value (w32-color-values name))) +; (mapcar (lambda (x) (ash x 8)) +; value))) + +;; +;; Section: X selection +;; + +; (defalias 'x-selection-exists-p 'w32-clipboard-data-exist-p) + +;; +;; Section: Font +;; + +; (defun w32-list-fonts (pattern &optional face frame max) +; (setq pattern (wildcard-to-regexp pattern)) +; (if (null max) (setq max 2000)) +; (let ((curfl global-fontset-alist) +; curfs +; result) +; (while (and (> max 0) +; (setq curfs (car (car curfl)))) +; (if (string-match pattern curfs) +; (setq result (cons curfs result) +; max (1- max))) +; (setq curfl (cdr curfl))) +; (setq curfl (w32-font-list)) +; (while (and (> max 0) +; (setq curfs (car curfl))) +; (if (string-match pattern curfs) +; (setq result (cons curfs result) +; max (1- max))) +; (setq curfl (cdr curfl))) +; result)) + +; (defalias 'x-list-fonts 'w32-list-fonts) + +;; +;; Section: X geometry (-g option) +;; + +(defun x-parse-geometry (str) + (let* ((size-regexp "\\([+\\-]?[0-9]+\\)[xX]\\([+\\-]?[0-9]+\\)") + (location-regexp "\\([+\\-][+\\-]?[0-9]+\\)") + (func (lambda (x) + (cond ((= (aref x 0) ?+) + (cons '+ (string-to-number + (substring x 1)))) + ((= (aref x 0) ?-) + (cons '- (string-to-number + (substring x 1)))) + (t nil)))) + location-x location-y size-x size-y result) + (if (string-match "^=?" str) + (setq str (substring str (match-end 0)))) + (if (string-match + (concat "^" size-regexp) + str) + (setq size-x (string-to-number (match-string 1 str)) + size-y (string-to-number (match-string 2 str)) + str (substring str (match-end 0)))) + (if (string-match + (concat "^" location-regexp location-regexp) + str) + (setq location-x (match-string 1 str) + location-y (match-string 2 str) + location-x (funcall func location-x) + location-y (funcall func location-y))) + (if size-x + (setq result (cons (cons 'width size-x) result))) + (if size-y + (setq result (cons (cons 'height size-y) result))) + (cond ((eq (car location-x) '+) + (setq result + (cons (cons 'left (cdr location-x)) + result))) + ((eq (car location-x) '-) + (setq result + (cons (cons 'right (cdr location-x)) + result)))) + (cond ((eq (car location-y) '+) + (setq result + (cons (cons 'top (cdr location-y)) + result))) + ((eq (car location-y) '-) + (setq result + (cons (cons 'bottom (cdr location-y)) + result)))) + result)) + +;; +;; Section: Shell execute +;; + +;; Comment out because NTemacs don't have fiber.exe. +;; (defun w32-shell-execute (operation document &optional parameters show-flag) +;; (if (and show-flag +;; (not (numberp show-flag))) +;; (error "show-flag must be number or nil:%S" show-flag)) +;; (let ((coding-system-for-write w32-system-coding-system) +;; (args (append +;; (list document) +;; (list "-b" operation) +;; (list "-d" default-directory) +;; (if parameters +;; (list "-p" parameters)) +;; (if show-flag +;; (list "-n" (number-to-string show-flag)))))) +;; (apply 'call-process w32-fiber-program-name nil 0 nil +;; args))) + +;; +;; Section: IME +;; + +;; This is temporal solution. In the future, we will prepare +;; dynamic configuration. +(defvar mw32-ime-coding-system-language-environment-alist + '(("Japanese" . japanese-shift-jis) + ("Chinese-GB" . chinese-iso-8bit) + ("Chinese-BIG5" . chinese-big5) + ("Korean" . korean-iso-8bit))) + +;; +;; IME state indicator +;; +(global-set-key [kanji] 'ignore) +(global-set-key [compend] 'ignore) + +(defun wrap-function-to-control-ime + (function interactive-p interactive-arg &optional suffix) + "Wrap FUNCTION, and IME control is enabled when FUNCTION is called. \n\ +An original function is saved to FUNCTION-SUFFIX when suffix is string. \n\ +If SUFFIX is nil, \"-original\" is added. " + (let ((original-function + (intern (concat (symbol-name function) + (if suffix suffix "-original"))))) + (cond ((not (fboundp original-function)) + (fset original-function + (symbol-function function)) + (fset function + (list + 'lambda '(&rest arguments) + (if interactive-p + (list 'interactive interactive-arg)) + (` (cond ((fep-get-mode) + (fep-force-off) + (unwind-protect + (apply '(, original-function) arguments) + (if mw32-ime-state + (fep-force-on)))) + (t + (apply '(, original-function) + arguments)))))))))) + +(defvar mw32-ime-toroku-region-yomigana nil + "* if this variable is string, toroku-region regard this value as yomigana.") + +(defun mw32-ime-toroku-region (begin end) + (interactive "r") + (let ((string (buffer-substring begin end)) + (mw32-ime-buffer-switch-p nil) + (reading mw32-ime-toroku-region-yomigana)) + (save-excursion + (set-buffer (window-buffer (minibuffer-window))) + (fep-force-on nil) + (mw32-ime-toggle) + (w32-set-ime-mode 'hiragana) + (if (not (stringp reading)) + (setq reading (read-from-minibuffer + (format "Input reading of \"%s\":" string)))) + (w32-ime-register-word-dialog reading string)) + (if (not mw32-ime-state) (fep-force-off nil)))) + +;; for IME management system. + +(defun mw32-ime-set-selected-window-buffer-hook (oldbuf newwin newbuf) + (save-excursion + (set-buffer newbuf) + (if mw32-ime-buffer-switch-p + (if (not (eq (fep-get-mode) mw32-ime-state)) + (cond + (mw32-ime-state + (fep-force-on nil) + (run-hooks 'mw32-ime-on-hook)) + (t + (if (= (w32-ime-undetermined-string-length) 0) + (progn + (fep-force-off nil) + (run-hooks 'mw32-ime-off-hook))))))))) + +(defun mw32-ime-select-window-hook (old new) + (save-excursion + (set-buffer (window-buffer new)) + (if mw32-ime-buffer-switch-p + (if (not (eq (fep-get-mode) mw32-ime-state)) + (cond + (mw32-ime-state + (fep-force-on nil) + (run-hooks 'mw32-ime-on-hook)) + (t + (if (= (w32-ime-undetermined-string-length) 0) + (progn + (fep-force-off nil) + (run-hooks 'mw32-ime-off-hook))))))) + (if (and (eq old (minibuffer-window)) + (not (eq new (minibuffer-window)))) + (progn + (set-buffer (window-buffer (minibuffer-window))) +; (fep-force-off) + (setq mw32-ime-state + nil +; mode-line-win32ime-mode-in-minibuffer +; transparent-mode-indicator +; minibuffer-preprompt +; nil + )))) +; (if (eq new (minibuffer-window)) +; (setq minibuffer-window-selected t) +; (setq minibuffer-window-selected nil)) + ) + +(defun mw32-ime-mode-line-update () + (cond (mw32-ime-show-mode-line + (if (window-minibuffer-p (selected-window)) +;;; for minibuffer ... + nil + (setq mw32-ime-mode-line-state-indicator + (if mw32-ime-state + (nth 1 mw32-ime-mode-line-state-indicator-list) + (nth 2 mw32-ime-mode-line-state-indicator-list))))) + (t + (setq mw32-ime-mode-line-state-indicator + (nth 0 mw32-ime-mode-line-state-indicator-list)))) + (force-mode-line-update)) + +(defun mw32-ime-init-mode-line-display () + (if (not (member 'mw32-ime-mode-line-state-indicator + mode-line-format)) + (progn + (setq mw32-ime-mode-line-format-original + (default-value 'mode-line-format)) + (if (and (stringp (car mode-line-format)) + (string= (car mode-line-format) "-")) + (setq-default mode-line-format + (cons "" + (cons 'mw32-ime-mode-line-state-indicator + (cdr mode-line-format)))) + (setq-default mode-line-format + (cons "" + (cons 'mw32-ime-mode-line-state-indicator + mode-line-format)))) + (force-mode-line-update t)))) + +(defun mw32-ime-toggle () + (interactive) + (let ((ime-state (fep-get-mode))) + (if ime-state + (run-hooks 'mw32-ime-on-hook) + (run-hooks 'mw32-ime-off-hook)) + (if (not (eq ime-state mw32-ime-state)) + (progn + (setq mw32-ime-state ime-state) + (mw32-ime-mode-line-update))))) + +(defun mw32-ime-initialize () + (cond ((and (eq system-type 'windows-nt) + (eq window-system 'w32) + (featurep 'meadow-ntemacs)) + (let ((coding-system + (assoc current-language-environment + mw32-ime-coding-system-language-environment-alist))) + (mw32-ime-init-mode-line-display) + (mw32-ime-mode-line-update) + (add-hook 'select-window-functions + 'mw32-ime-select-window-hook) + (add-hook 'set-selected-window-buffer-functions + 'mw32-ime-set-selected-window-buffer-hook) + (define-key global-map [kanji] 'mw32-ime-toggle) + (define-key global-map [C-kanji] 'mw32-ime-toggle) ; remove me! + (define-key global-map [M-kanji] 'mw32-ime-toggle) ; remove me! + (if coding-system + (set-keyboard-coding-system (cdr coding-system))))))) + +(defun mw32-ime-uninitialize () + (cond ((and (eq system-type 'windows-nt) + (eq window-system 'w32) + (featurep 'meadow-ntemacs)) + (setq-default mode-line-format + mw32-ime-mode-line-format-original) + (force-mode-line-update t) + (remove-hook 'select-window-functions + 'mw32-ime-select-window-hook) + (remove-hook 'set-selected-window-buffer-functions + 'mw32-ime-set-selected-window-buffer-hook) + (define-key global-map [kanji] 'ignore)))) + +(defun mw32-ime-state-switch (&optional arg) + (if arg + (progn + (setq inactivate-current-input-method-function + 'mw32-ime-state-switch) + (run-hooks 'input-method-activate-hook) + (setq describe-current-input-method-function nil) + (fep-force-on t)) + (setq current-input-method nil) + (run-hooks 'input-method-inactivate-hook) + (setq describe-current-input-method-function nil) + (fep-force-off t) + )) + +(register-input-method "MW32-IME" "Japanese" 'mw32-ime-state-switch "" + "MW32 System IME") + +(provide 'meadow-ntemacs) Index: lisp/international/mw32script.el =================================================================== --- lisp/international/mw32script.el (revision 0) +++ lisp/international/mw32script.el (revision 10) @@ -0,0 +1,194 @@ +;;; mw32script.el +;;; Author: yamagus@kw.netlaputa.ne.jp (YAMAGUCHI, Shuhei) +;;; Modified by H.Miyashita. +;;; Version 1.2 (Feb 2, 1998) +;;; +;;; [USAGE] +;;; Add the following in your .emacs: +;;; (require 'mw32script) +;;; (mw32script-init) + +(defconst mw32script-version "W32 Script version 1.2") +;; begin --- options +(defvar mw32script-argument-editing-alist + '(("/sh$" . "sh.exe") + ("/bash$" . "bash.exe") + ("/perl$" . "perl.exe") + ("/t?csh$" . "tcsh.exe") + ("/ruby$" . "ruby.exe") + ("/rubyw$" . "rubyw.exe")) + "Association list of script interpreter.") + +(defvar mw32script-pathext '(".com" ".exe" ".bat" ".cmd") + "Extention list of executables.") + +(defvar mw32script-resolve-script t + "If non-nil, mw32script-argument-editing-function +resolve the script association.") + +(defvar mw32script-resolve-extention (or + (fboundp 'Meadow-version) + (featurep 'meadow-ntemacs)) + "If non-nil, mw32script-argument-editing-function +resolve the filename association. +This only works with Meadow version Alpha-3.00 or later.") + +(defvar mw32script-recursive nil) +(defvar mw32script-original-file-executable-p nil) +;; end --- options +(defvar mw32script-bufsiz 256) +(defvar mw32script-buffer-tmp " *mw32script*") +(defvar mw32script-pathext-regexp nil) + +(defun mw32script-make-pathext-regexp () + (setq mw32script-pathext-regexp + (concat "\\(" + (mapconcat + (lambda (x) (regexp-quote x)) + mw32script-pathext "\\|") + "\\)$"))) + +(defun mw32script-openp (command-name) + "Locate the full path name of external-command COMMAND-NAME." + (interactive "sExternal-command: ") + (catch 'tag + (let (path) + (if (file-name-absolute-p command-name) + (if (and (file-executable-p command-name) + (null (file-directory-p command-name))) + (throw 'tag command-name) + (mapcar + (lambda (suf) + (setq path (expand-file-name (concat command-name suf))) + (and (file-executable-p path) + (null (file-directory-p path)) + (throw 'tag path))) + (if (null mw32script-pathext) + '("") + mw32script-pathext))) + (mapcar + (lambda (dir) + (mapcar + (lambda (suf) + (setq path (expand-file-name (concat command-name suf) dir)) + (and (file-executable-p path) + (null (file-directory-p path)) + (throw 'tag path))) + (if (null mw32script-pathext) + '("") + (append (list "") mw32script-pathext)))) + exec-path))) nil)) + + +(defun mw32script-resolve-script (path &optional directory) + "Find executable path that interprets the script specified PATH. +Return value is a list of arguments, and car of the list is argv[0]. +The optional argument DIRECTORY specify the default directory. +If the object executable is not found, return nil." + (interactive "fScript: ") + (setq path + (expand-file-name + (if directory + (concat (file-name-as-directory directory) path) + path))) + (let ((buf (generate-new-buffer mw32script-buffer-tmp)) + limit args) + (unwind-protect + (save-excursion + (set-buffer buf) + (condition-case nil + (progn + (let ((coding-system-for-read 'raw-text)) + (insert-file-contents path nil 0 mw32script-bufsiz)) + (goto-line 2) + (setq limit (point)) + (goto-char 1) + (if (re-search-forward + "\\`#![ \t]*\\([^ \t\n]+\\)[ \t]*" limit t) + (while + (progn + (setq args + (nconc args + (list + (buffer-substring (match-beginning 1) + (match-end 1))))) + (re-search-forward "\\([^ \t\n]+\\)[ \t]*" + limit t)))) + args) + (file-error nil))) + (kill-buffer buf)))) + + +(defun mw32script-resolve-extention (path &optional directory) + "Find executable path that associated with filename specified PATH. +Return value is a list of arguments, and car of the list is argv[0]. +The optional argument DIRECTORY specify the default directory. +If the object executable is not found, return 'notfound." + (interactive "fFile: ") + (setq path + (expand-file-name + (if directory + (concat (file-name-as-directory directory) path) + path))) + (let (executable) + (condition-case nil + (progn + (setq executable (w32-find-executable path)) + (if (eq executable 'notfound) + executable + (list executable))) + (error nil)))) + + +(defun mw32script-argument-editing-function (argument) + "Resolv the script/filename association, +and do the argument editiong." + (let ((argv0 (car argument)) sargs func ret) + (if (string-match mw32script-pathext-regexp argv0) + (funcall default-process-argument-editing-function argument) + (and mw32script-resolve-extention + (setq sargs (mw32script-resolve-extention argv0))) + (and mw32script-resolve-script + (or (not sargs) (eq sargs 'notfound)) + (setq sargs (mw32script-resolve-script argv0))) + (if (and sargs (not (eq sargs 'notfound))) + (progn + (setq argv0 (car sargs)) + (catch 'tag + (mapcar + (lambda (pat) + (and (string-match (car pat) argv0) + (setq argv0 (mw32script-openp (cdr pat))) + (throw 'tag t))) + mw32script-argument-editing-alist)) + (and (eq (setq func (find-process-argument-editing-function argv0)) + (function mw32script-argument-editing-function)) + (not mw32script-recursive) + (setq func default-process-argument-editing-function)) + (if (consp (setq ret (funcall + func + (append (list argv0) (cdr sargs) argument)))) + ret + (cons argv0 ret))) + (funcall default-process-argument-editing-function argument))))) + +(defun mw32script-file-executable-p (filename) + (or (funcall mw32script-original-file-executable-p filename) + (and (mw32script-resolve-script filename) + t))) + +(defun mw32script-init () + (interactive) + (mw32script-make-pathext-regexp) + (define-process-argument-editing + ".*" + (function mw32script-argument-editing-function) 'last) + (add-to-list 'exec-suffix-list "") + (if (not mw32script-original-file-executable-p) + (progn + (setq mw32script-original-file-executable-p + (symbol-function 'file-executable-p)) + (fset 'file-executable-p + (symbol-function 'mw32script-file-executable-p))))) + +(provide 'mw32script) Index: lisp/international/mw32misc.el =================================================================== --- lisp/international/mw32misc.el (revision 0) +++ lisp/international/mw32misc.el (revision 10) @@ -0,0 +1,836 @@ +;;;;; mw32misc.el ---- For Multilingul Windows. +;; +;; Author H.Miyashita +;; +;;;;; + +(eval-when-compile + (require 'regexp-opt)) + +(defvar install-lisp-directory-specific-to-emacs-version "" + "Directory to store Emacs Lisp libraries specific to Emacs Version.") + +(defvar install-lisp-directory-independent-of-emacs-version "" + "Directory to store Emacs Lisp libraries independent of Emacs Version.") + +;; Use the other function defined in international/mule.el. +;; (defun set-clipboard-coding-system (coding-system) +;; "Set windows clipboard coding sytem. This coding system is used when +;; emacs read or write windows clipboard." +;; (interactive "zClipboard-coding-system:") +;; (check-coding-system coding-system) +;; (setq w32-clipboard-coding-system coding-system)) + +(defun set-w32-system-coding-system (coding-system) + "Set coding sytem used by windows. " + (interactive "zWindows-system-coding-system:") + (check-coding-system coding-system) + (setq w32-system-coding-system coding-system)) + +(fmakunbound 'font-menu-add-default) + +(defun w32-generate-font-fontset-menu () + (let ((font-list + (sort (w32-font-list) + (function string<))) + key keyreg elem menu-groups font-group + menu-fontset) + (if (setq elem (car font-list)) + (progn + (if (string-match "^[^-]+" elem) + (setq key (match-string 0 elem)) + (setq key elem)) + (setq keyreg (concat "^" key)))) + (while (setq elem (car font-list)) + (if (string-match keyreg elem) + (setq font-group + (cons (list elem 'menu-item elem t) + font-group)) + (setq menu-groups + (cons + (list nil 'menu-item (concat key "-*") + (cons 'keymap font-group)) + menu-groups) + font-group + (list (list elem 'menu-item elem t))) + (if (string-match "^[^-]+" elem) + (setq key (match-string 0 elem)) + (setq key elem)) + (setq keyreg (concat "^" key))) + + (setq font-list (cdr font-list))) + (setq menu-groups + (cons + (list nil 'menu-item (concat key "-*") + (cons 'keymap font-group)) + menu-groups)) + (setq menu-fontset + (mapcar + (lambda (x) + (list x 'menu-item x t)) + (fontset-list))) + (list 'keymap + (list nil 'menu-item "Font" + (cons 'keymap menu-groups)) + (list nil 'menu-item "Fontset" + (cons 'keymap menu-fontset))))) + +(defun set-cursor-type (type) + "Set the text cursor type of the selected frame to TYPE. +When called interactively, prompt for the name of the cursor type to use. +The cursor type supports which `caret', `checkered-caret', `hairline-caret' +, `box' and `bar'. +To get the frame's current cursor type, use `frame-parameters'." + (interactive "sCursor-Type: ") + (when (stringp type) + (setq type (intern type))) + (modify-frame-parameters (selected-frame) + (list (cons 'cursor-type type)))) + +(defun set-cursor-height (height) + "Set the caret cursor height of the selected frame to HEIGHT. +When called interactively, prompt for the height of the cursor to use. +The cursor height support `0 - 4' integer. +To get the frame's current cursor height, use `frame-parameters'." + (interactive "nCursor-Height: ") + (modify-frame-parameters (selected-frame) + (list (cons 'cursor-height height)))) + +(defun mouse-set-font (&rest fonts) + "Select an emacs font from a list of known good fonts and fontsets." + (interactive + (x-popup-menu last-nonmenu-event + (w32-generate-font-fontset-menu))) + (if fonts + (let (font) + (while fonts + (condition-case nil + (progn + (set-default-font (car fonts)) + (setq font (car fonts)) + (setq fonts nil)) + (error + (setq fonts (cdr fonts))))) + (if (null font) + (error "Font not found"))))) + +(defun w32-mouse-operation-init () + (if (= (w32-get-system-metrics 43) 3) + (progn + (setq w32-lbutton-to-emacs-button 0) + (setq w32-mbutton-to-emacs-button 1) + (setq w32-rbutton-to-emacs-button 2) + ))) + +(add-hook 'after-init-hook + (lambda () + (if (featurep 'meadow) + (progn + (setq keyboard-type (w32-keyboard-type)) + (setq install-lisp-directory-specific-to-emacs-version + (expand-file-name "../site-lisp" exec-directory) + install-lisp-directory-independent-of-emacs-version + (expand-file-name "../../site-lisp" exec-directory)) + )))) + +(defun w32-change-logfont-name (logfont name) + "change name of logfont." + (w32-check-logfont logfont) + (let ((logfontc (copy-sequence logfont))) + (setcar (nthcdr 1 logfontc) name) + logfontc)) + +(defun w32-change-logfont-width (logfont width) + "change width of logfont." + (w32-check-logfont logfont) + (let ((logfontc (copy-sequence logfont))) + (setcar (nthcdr 2 logfontc) width) + logfontc)) + +(defun w32-change-logfont-height (logfont height) + "change height of logfont." + (w32-check-logfont logfont) + (let ((logfontc (copy-sequence logfont))) + (setcar (nthcdr 3 logfontc) height) + logfontc)) + +(defun w32-change-logfont-weight (logfont add) + "change weight of logfont. Add ADD to weight." + (w32-check-logfont logfont) + (let ((weight (nth 4 logfont)) + (logfontc (copy-sequence logfont))) + (setcar (nthcdr 4 logfontc) (+ weight add)) + logfontc)) + +(defun w32-change-logfont-italic-p (logfont italic-p) + "change italic-p of logfont." + (w32-check-logfont logfont) + (if (null (or (eq italic-p nil) (eq italic-p t))) + (error "italic-p must be nil or t.")) + (let ((logfontc (copy-sequence logfont))) + (setcar (nthcdr 6 logfontc) italic-p) + logfontc)) + +(defun w32-logfont-fixed-p (logfont) + (/= (logand (nth 12 logfont) 1) 0)) + +(defun w32-change-logfont-charset (logfont charset) + "change charset of logfont." + (w32-check-logfont logfont) + (let ((logfontc (copy-sequence logfont))) + (setcar (nthcdr 9 logfontc) charset) + logfontc)) + +(defun w32-logfont-name (logfont) + "Return name of logfont." + (w32-check-logfont logfont) + (nth 1 logfont)) + +(defun w32-logfont-width (logfont) + "Return width of logfont." + (w32-check-logfont logfont) + (nth 2 logfont)) + +(defun w32-logfont-height (logfont) + "Return height of logfont." + (w32-check-logfont logfont) + (nth 3 logfont)) + +(defun w32-logfont-weight (logfont) + "Return weight of logfont." + (w32-check-logfont logfont) + (nth 4 logfont)) + +(defun w32-logfont-italic-p (logfont) + "Return italic-p of logfont." + (w32-check-logfont logfont) + (nth 6 logfont)) + +(defun w32-logfont-charset (logfont) + "change charset of logfont." + (w32-check-logfont logfont) + (nth 9 logfont)) + +(setq x-fixed-font-alist nil) + +(defun w32-regist-font-encoder (name real-encoder) + (cond ((get real-encoder 'ccl-program-idx) + (put name 'ccl-program real-encoder)) + (t + (error "Not yet supported encoder! %S" real-encoder)))) + +(w32-regist-font-encoder + 'encode-koi8-font 'ccl-encode-koi8-font) +(w32-regist-font-encoder + 'encode-alternativnyj-font 'ccl-encode-alternativnyj-font) +(w32-regist-font-encoder + 'encode-big5-font 'ccl-encode-big5-font) +(w32-regist-font-encoder + 'encode-viscii-font 'ccl-encode-viscii-font) +(w32-regist-font-encoder + 'encode-ethio-font 'ccl-encode-ethio-font) + +(defvar w32-charset-encoding-alist + '((ascii 0 0) ; ANSI_CHARSET + (latin-iso8859-1 0 1) ; ANSI_CHARSET + (ascii-right-to-left 0 0) ; ANSI_CHARSET + (latin-iso8859-2 238 1) ; EASTEUROPE_CHARSET + (latin-iso8859-3 1 1) ; DEFAULT_CHARSET + (latin-iso8859-4 1 1) ; DEFAULT_CHARSET + (cyrillic-iso8859-5 + 204 1) ; RUSSIAN_CHARSET(1251!=8859) + (arabic-iso8859-6 178 1) ; ARABIC_CHARSET + (greek-iso8859-7 161 1) ; GREEK_CHARSET + (hebrew-iso8859-8 177 1) ; HEBREW_CHARSET + (latin-iso8859-9 162 1) ; TURKISH_CHARSET + (latin-jisx0201 128 0) ; SHIFTJIS_CHARSET + (katakana-jisx0201 128 4) ; SHIFTJIS_CHARSET + (japanese-jisx0208 128 4) ; SHIFTJIS_CHARSET + (japanese-jisx0212 1 0) ; DEFAULT_CHARSET + (chinese-big5-1 + 136 encode-big5-font) ; CHINESEBIG5_CHARSET + (chinese-big5-2 + 136 encode-big5-font) ; CHINESEBIG5_CHARSET + (chinese-gb2312 134 1) ; GB2312_CHARSET + (korean-ksc5601 129 1) ; HANGEUL_CHARSET + (thai-tis620 + 222 1 ((relative-compose . -1))) ; THAI_CHARSET + (vietnamese-viscii-lower + 163 encode-viscii-font) ; VIETNAMESE_CHARSET + (vietnamese-viscii-upper + 163 encode-viscii-font) ; VIETNAMESE_CHARSET +; (chinese-cns11643-1 1 0) ; DEFAULT_CHARSET +; (chinese-cns11643-2 1 0) ; DEFAULT_CHARSET +; (chinese-cns11643-3 1 0) ; DEFAULT_CHARSET +; (chinese-cns11643-4 1 0) ; DEFAULT_CHARSET +; (chinese-cns11643-5 1 0) ; DEFAULT_CHARSET +; (chinese-cns11643-6 1 0) ; DEFAULT_CHARSET +; (chinese-cns11643-7 1 0) ; DEFAULT_CHARSET +; (arabic-digit 1 0) ; DEFAULT_CHARSET +; (arabic-1-column 1 0) ; DEFAULT_CHARSET +; (arabic-2-column 1 0) ; DEFAULT_CHARSET +; (lao 1 0) ; DEFAULT_CHARSET +; (ipa 1 0) ; DEFAULT_CHARSET +; (ethiopic 1 0) ; DEFAULT_CHARSET +; (indian-is13194 1 0) ; DEFAULT_CHARSET +; (indian-2-column 1 0) ; DEFAULT_CHARSET +; (indian-1-column 1 0) ; DEFAULT_CHARSET +)) + +; JOHAB_CHARSET + +(defvar w32-default-logfont '(w32-logfont "FixedSys" 0 0 400 0 nil nil nil 0 1 1 1) + "Default font is generated from this.") + +(defun w32-automatic-font-regist (name lflist &optional encoding-type) + (w32-add-font name '((width . 0) + (height . 0) + (base . 0) + (overhang . 0) + (encoding-type . 0))) + (let (lf metric num encoder + (i 0) + (width 0) + (height 0) + (base 0) + (overhang 0)) + (if (not (numberp encoding-type)) + (progn + (setq encoder encoding-type) + (setq encoding-type 0))) + (while (setq lf (car lflist)) + (setq metric (w32-get-logfont-info lf) + num (cdr (assq 'width metric))) + (if (> num width) (setq width num)) + (setq num (cdr (assq 'height metric))) + (if (> num height) (setq height num)) + (setq num (cdr (assq 'base metric))) + (if (> num base) (setq base num)) + (setq num (cdr (assq 'overhang metric))) + (if (> num overhang) (setq overhang num)) + (w32-change-font-logfont name i lf) + (setq lflist (cdr lflist)) + (setq i (1+ i))) + (w32-change-font-attribute + name + (list (cons 'width width) + (cons 'height height) + (cons 'base base) + (cons 'overhang overhang) + (cons 'encoding-type encoding-type) + (cons 'encoder encoder))))) + +(defun w32-generate-tribial-logfont-list (logfont) + (let* ((bold-font (w32-change-logfont-weight logfont 300)) + (italic-font (w32-change-logfont-italic-p logfont t)) + (italic-bold-font (w32-change-logfont-italic-p bold-font t))) + (list logfont bold-font italic-font italic-bold-font))) + +(defun w32-regist-initial-font () + (w32-automatic-font-regist + "initial" + (w32-generate-tribial-logfont-list w32-default-logfont) 0)) + +(defun w32-automatic-fontset-regist (name orgfont) + (let ((encoding-alist w32-charset-encoding-alist) + x ret) + (while encoding-alist + (setq x (car encoding-alist)) + (setq encoding-alist (cdr encoding-alist)) + (let* ((charset (car x)) + (ms-charset (car (cdr x))) + (encoding-type (car (cdr (cdr x)))) + (font-name (format "%s-%s" orgfont (symbol-name charset))) + orglf newlf metric) + (setq orglf + (w32-change-logfont-charset + (cond + ((w32-get-font-logfont orgfont 0)) + (t + w32-default-logfont)) ms-charset)) + (setq metric (w32-get-logfont-info orglf)) + (if (or (= ms-charset (cdr (assq 'charset-num metric))) + ;;; This is very dirty hack. + ;; Some Windows(TM) localized editions + ;; (at least Windows98 Thai edition) have + ;; a bogus font mapper, which may maps a logfont + ;; to a font of wrong charset number + ;; if any other keys of the logfont are not match. + ;; This must be a bug of Windows. Nevertheless, + ;; we should make ASCII font to display, thus, + ;; we force to set the logfont (that is + ;; seemed to be to invalid) to ASCII font of + ;; the fontset that will be created. + (eq charset 'ascii)) + (progn + (w32-automatic-font-regist + font-name + (mapcar + (lambda (x) + (setq metric (w32-get-logfont-info orglf) + newlf (w32-change-logfont-width + orglf + (cdr (assq 'width metric))) + newlf (w32-change-logfont-height + newlf + (cdr (assq 'height metric)))) + newlf) + '(0 1 2 3)) + encoding-type) + (setq ret (cons (cons charset font-name) ret)))))) + (new-fontset name ret))) + +;(new-fontset "default-fontset" '((ascii . "default") +; (japanese-jisx0208 . "default") +; (katakana-jisx0201 . "default"))) +; +;(set-default-font "default-fontset") + +;;;;; +;;;;; +;;;;; High level font selection API +;;;;; +;;;;; + +(defun w32-auto-regist-bdf-font (fontname bdffile &optional encoding) + (if (null encoding) (setq encoding 0)) + (let ((bdfatt (w32-get-logfont-info (list 'bdf-font bdffile)))) + (if bdfatt + (progn + (cond ((symbolp encoding) + (setq bdfatt (append (list + (cons 'encoder encoding) + (cons 'encoding-type 0)) + bdfatt))) + ((numberp encoding) + (setq bdfatt (cons (cons 'encoding-type encoding) + bdfatt)))) + (w32-add-font fontname bdfatt) + (w32-change-font-logfont fontname 0 + (list 'bdf-font bdffile)))))) + +(defun create-font-from-logfont-list + (name logfont-list &optional encoding-type alist) +; (w32-check-logfont logfont) + (if (null encoding-type) (setq encoding-type 0)) + (let ((prop (append (list (cons 'encoding-type encoding-type)) + alist + (w32-get-logfont-info (car logfont-list)))) + (i 0) + logfont) + (w32-add-font name prop) + (while (setq logfont (car logfont-list)) + (w32-change-font-logfont name i logfont) + (setq i (1+ i)) + (setq logfont-list (cdr logfont-list))))) + +(defun set-font-from-logfont + (name logfont charset pnum &optional encoding-type alist) + (w32-check-logfont logfont) + (let (w32-alist w32-logfont-info prop) + (if (eq (car logfont) 'w32-logfont) + (progn + (setq w32-logfont-info + (assq charset w32-charset-encoding-alist)) + (setq w32-alist + (setq alist (nth 3 w32-logfont-info))) + (if (null encoding-type) + (setq encoding-type (nth 2 w32-logfont-info))))) + (setq prop (append + (if (numberp encoding-type) + (list (cons 'encoding-type encoding-type)) + (list + (cons 'encoding-type 0) + (cons 'encoder encoding-type))) + alist + w32-alist + (w32-get-logfont-info logfont))) + (condition-case nil + (w32-add-font name prop) + (error)) + (w32-change-font-logfont name pnum logfont))) + +; request type +; family, width, height, italic, weight, fixed +; ?? base ?? + +(defvar logfont-from-request-functions nil + "* Functions that return logical font from your request. +These functions are called passing CHARSET-SYMBOL, REQUIRED-ALIST, +RECOMMENDED-ALIST. +These functions must return a logical font or nil +when no logical fonts are found.") + +(defvar w32-font-list-cache-all nil) +(defvar w32-font-list-cache-charset nil) + +(defun w32-clear-logfont-list-cache () + (setq w32-font-list-cache-all nil + w32-font-list-cache-charset nil)) + +(defun w32-enum-logfont-from-charset (charset) + (let ((font-list-slot (assq charset w32-font-list-cache-charset)) + ms-charset + curlist + curelem + lfname + cand1 + result) + (if font-list-slot + (cdr font-list-slot) + (if (null w32-font-list-cache-all) + (setq w32-font-list-cache-all + (w32-enum-logfont))) + (setq ms-charset + (nth 1 + (assq charset w32-charset-encoding-alist))) + (if (null ms-charset) + nil + (setq curlist w32-font-list-cache-all) + (while (setq curelem (car curlist)) + (setq lfname (nth 1 (nth 3 curelem)) + cand1 + (nconc cand1 + (and + (> (length lfname) 0) + (/= (aref lfname 0) ?@) + (w32-logfont-valid-charset-p + (nth 3 curelem) ms-charset) + (w32-enum-logfont lfname))) + curlist (cdr curlist))) + (setq w32-font-list-cache-charset + (cons (cons charset cand1) + w32-font-list-cache-charset)) + cand1)))) + +(defsubst logfont-list-from-request (required recommended &optional fontset) + (let* ((charset-list + (if (null fontset) + (charset-list) + (let* ((chlist (aref (fontset-info fontset) 2)) + (curlist chlist)) + (while (setq curlist (cdr curlist)) + (setcar curlist + (car (car curlist)))) + chlist))) + (curchl charset-list) + curch logfont result) + (while (setq curch (car curchl)) + (if (setq logfont (run-hook-with-args-until-success + 'logfont-from-request-functions + curch required recommended fontset)) + (setq result (cons (cons curch logfont) result))) + (setq curchl (cdr curchl))) + result)) + +(defsubst w32-candidate-scalable-p (cand) + (eq (nth 2 cand) 'scalable)) + +(defun w32-candidate-satisfy-request-p (cand request) + (let* ((item (car request)) + (cont (cdr request)) + (logfont (nth 3 cand)) + (info (w32-get-logfont-info logfont))) + (cond ((eq item 'width) + (or (w32-candidate-scalable-p cand) + (= (cdr (assq 'width info)) cont))) + ((eq item 'height) + (or (w32-candidate-scalable-p cand) + (= (cdr (assq 'height info)) cont))) + ((eq item 'weight) + t) +; (or (w32-candidate-scalable-p cand) +; (= (cdr (assq 'weight info)) cont))) + ((eq item 'italic) + (if cont + (w32-logfont-italic-p logfont) + (not (w32-logfont-italic-p logfont)))) + ((eq item 'fixed) + (if cont + (w32-logfont-fixed-p logfont) + (not (w32-logfont-fixed-p logfont)))) + ((eq item 'family) + (string= (car cand) cont)) + (t + t)))) + +(defun w32-select-logfont-from-required (candidate required) + (let ((scorelist (w32-score-logfont-candidates required candidate)) + (len (length required)) + result) + (while scorelist + (if (>= (car scorelist) len) + (setq result (cons (car candidate) result))) + (setq candidate (cdr candidate) + scorelist (cdr scorelist))) + result)) + +(defun w32-select-logfont-from-recommended (candidate recommended) + (let* ((scorelist (w32-score-logfont-candidates recommended candidate)) + (max (car scorelist)) + (bestcand (car candidate))) + (setq candidate (cdr candidate) + scorelist (cdr scorelist)) + (while scorelist + (if (> (car scorelist) max) + (progn + (setq max (car scorelist) + bestcand (car candidate)))) + (setq candidate (cdr candidate) + scorelist (cdr scorelist))) + bestcand)) + +(defsubst w32-logfont-valid-charset-p (logfont charset) + (= +; (cdr +; (assq 'charset-num +; (w32-get-logfont-info +; (w32-change-logfont-charset +; logfont charset)))) + (w32-logfont-charset logfont) + charset)) + +(defun w32-modify-logfont-from-request (logfont required recommended) + (let ((width (or (cdr (assq 'width required)) + (cdr (assq 'width recommended)) + (w32-logfont-width logfont))) + (height (or (assq 'height required) + (assq 'height recommended))) + (weight (or (assq 'weight required) + (assq 'weight recommended))) + result) + + (setq result (w32-change-logfont-width + logfont width)) + + ;; In the case of propotional font, we must resize + ;; font width to ensure the width of this font is less + ;; than requested `width'. + (if (not (w32-logfont-fixed-p logfont)) + (let* ((info (w32-get-logfont-info logfont)) + (max-width (cdr (assq 'max-width info))) + (test-width (- (+ width width) max-width))) + (if (> max-width width) + (if (> test-width 0) + (setq result + (w32-change-logfont-width + logfont test-width)) + ;; give up resizing correctly, this is heuristic mainly for thai ;_; + (setq result + (w32-change-logfont-width + logfont (floor (* width 0.7)))))))) + + ;;; for speed, I don't use w32-change-logfont-* + (if height + (setcar (nthcdr 3 result) + (cdr height))) + (if weight + (setcar (nthcdr 4 result) + (cdr weight))) + result)) + +(defun w32-logfont-list-from-request (charset required recommended fontset) + ;; fontset is used as a trivial temporal variable:-P. + (setq fontset + (nth 3 (w32-select-logfont-from-recommended + (w32-select-logfont-from-required + (w32-enum-logfont-from-charset charset) + required) + recommended))) + (and fontset + (w32-modify-logfont-from-request fontset required recommended))) + +(add-hook 'logfont-from-request-functions + (function w32-logfont-list-from-request)) + +(defun create-fontset-from-request + (name required recommended) + "Create fontset from your request." + (let* ((logfont-list (logfont-list-from-request + required recommended)) + (curll logfont-list) + curle + logfont fontname charset) + (while (setq curle (car curll)) + (setq logfont (cdr curle) + charset (car curle) + fontname (concat name "-" (symbol-name charset))) + (set-font-from-logfont fontname logfont charset 0) + (setcdr curle fontname) + (setq curll (cdr curll))) + (new-fontset name logfont-list))) + +(defun change-fontset-from-request + (name required recommended &optional property) + "Change fontset from your request." + (if (null property) (setq property 0)) + (let* ((fontset-font-data (aref (fontset-info name) 2)) + (logfont-list (logfont-list-from-request + required recommended name)) + (curll logfont-list) + curle logfont fontname) + (while (setq curle (car curll)) + (setq logfont (cdr (car curll)) + fontname (nth 1 (assq (car (car curll)) fontset-font-data))) + (w32-change-font-logfont fontname property logfont) + (setq curll (cdr curll))))) + + + +;;;;; +;;;;; For Argument Editing. +;;;;; +;;;;; + +(defvar process-argument-editing-alist nil) + +(defvar default-process-argument-editing-function + (lambda (x) (general-process-argument-editing-function + x 'msvc t)) + "Default argument editing function. +When any argument editing functions are NOT found, +this function is used for argument editing.") + +(defun remove-process-argument-editing (process) + "Remove argument editing configuration of PROCESS, if exists." + (let ((curelem process-argument-editing-alist)) + (if (string= (car (car curelem)) process) + (setq process-argument-editing-alist + (cdr process-argument-editing-alist)) + (while (progn + (if (not (string= (car (car (cdr curelem))) process)) + (setq curelem (cdr curelem)) + (setcdr curelem (cdr (cdr curelem))) + nil)))))) + +(defun define-process-argument-editing + (process function &optional method) + "Define argument editing configuration of PROCESS to FUNCTION" + (indirect-function function) + (let ((elem (cons process function)) + (oelem (assoc process process-argument-editing-alist))) + (cond ((eq method 'last) + (remove-process-argument-editing process) + (nconc process-argument-editing-alist (list elem))) + ((eq method 'first) + (remove-process-argument-editing process) + (setq process-argument-editing-alist + (cons elem process-argument-editing-alist))) + ((eq method 'append) + (if oelem + nil + (setq process-argument-editing-alist + (cons elem process-argument-editing-alist)))) + ((eq method 'replace) + (if oelem + (setcdr oelem function))) + (t + (if oelem + (setcdr oelem function) + (setq process-argument-editing-alist + (cons elem process-argument-editing-alist))))))) + +(defun find-process-argument-editing-function (process) + "Find a function of argument editing to invoke PROCESS." + (let ((alist process-argument-editing-alist) + (elem nil)) + (while (and (null elem) (setq elem (car alist))) + (if (string-match (car elem) process) + (setq elem (cdr elem)) + (setq alist (cdr alist)) + (setq elem nil))) + (if elem + elem + default-process-argument-editing-function))) + +(defun msvc-process-argument-quoting (arg) + (mapcar (lambda (x) + (let ((start 0) (result "\"") pos end) + (while (string-match "\\\\*\"" x start) + (setq pos (match-beginning 0) + end (match-end 0) + result (concat result + (substring x start pos) + (make-string (* (- end pos 1) 2) ?\\ ) + "\\\"") + start end)) + (concat result + (if (string-match "\\\\*\\'" x start) + (concat (substring x start (match-beginning 0)) + (make-string (* (- (match-end 0) + (match-beginning 0)) + 2) ?\\)) + (substring x start)) + "\""))) + arg)) + +(defun cygnus-process-argument-quoting (arguments) + (mapcar (lambda (arg) + (let ((result "\"") (start 0) pos) + (while (string-match "\"" arg start) + (setq pos (match-end 0) + result (concat result + (substring arg start pos) "\"") + start pos)) + (concat result (substring arg start) "\""))) + arguments)) + +(defun general-process-argument-editing-function + (argument quoting argv0isp &optional ep h2sp qp s2isp) + (setq argument (cond ((eq quoting 'msvc) + (msvc-process-argument-quoting argument)) + ((eq quoting 'cygnus) + (cygnus-process-argument-quoting argument)) + (t + argument))) + (if (null argv0isp) + (unix-to-dos-argument (mapconcat (function concat) argument " ") + ep h2sp qp s2isp) + (concat + (unix-to-dos-filename (car argument)) " " + (unix-to-dos-argument (mapconcat (function concat) (cdr argument) " ") + ep h2sp qp s2isp)))) + +(defmacro define-argument-editing-from-program-list + (program-list function &optional method) + "Define argument editing configuration from PROGRAM-LIST. +PROGRAM-LIST consists of program names, and FUNCTION is used +for argument editing of these programs." + (list 'define-process-argument-editing + (concat + "/" + (regexp-opt (eval program-list) t) + "\\'") + function method)) + +(define-argument-editing-from-program-list + '("fiber.exe" "movemail.exe" "ctags.exe" "etags.exe" + "ftp.exe" "telnet.exe" "tcsh.exe" + "hexl.exe" "m2ps.exe" "emacsserver.exe" + "wakeup.exe" "tcp.exe" "fakemail.exe" + ;; This is for the wordseg program called swath, the abbreviation + ;; of Smart Word Analysis for THai, and for marking word boundaries + ;; for continuous Thai-script sequences. + "swath.exe") + (lambda (x) (general-process-argument-editing-function x 'msvc t))) + +(define-process-argument-editing + "\\(/cmd\\.exe\\'\\|/command\\.com\\'\\)" + (lambda (x) (general-process-argument-editing-function x nil t t nil t t))) + +(define-process-argument-editing + "\\.bat\\'" + (lambda (x) (general-process-argument-editing-function x nil t t nil t t))) + +(define-process-argument-editing + "/tcsh\\.exe\\'" + (lambda (x) (general-process-argument-editing-function x 'msvc t))) + +(define-process-argument-editing + "/bash\\.exe\\'" + (lambda (x) (general-process-argument-editing-function x 'cygnus t))) + +;; This is for the typing excersize program called trr. +(define-process-argument-editing + "/trr.*\\.exe\\'" + (lambda (x) (general-process-argument-editing-function x 'msvc t))) Index: lisp/woman.el =================================================================== --- lisp/woman.el (.../trunk) (revision 10) +++ lisp/woman.el (.../branches/ime) (revision 10) @@ -832,10 +832,15 @@ :type 'boolean :group 'woman-formatting) -(defcustom woman-preserve-ascii nil - "*If non-nil then preserve ASCII characters in the WoMan buffer. -Otherwise, non-ASCII characters (that display as ASCII) may remain. -This is irrelevant unless the buffer is to be saved to a file." +(defcustom woman-preserve-ascii t + "*If non-nil, preserve ASCII characters in the WoMan buffer. +Otherwise, to save time, some backslashes and spaces may be +represented differently (as the values of the variables +`woman-escaped-escape-char' and `woman-unpadded-space-char' +respectively) so that the buffer content is strictly wrong even though +it should display correctly. This should be irrelevant unless the +buffer text is searched, copied or saved to a file." + ;; This option should probably be removed! :type 'boolean :group 'woman-formatting) Index: lisp/loadup.el =================================================================== --- lisp/loadup.el (.../trunk) (revision 10) +++ lisp/loadup.el (.../branches/ime) (revision 10) @@ -169,9 +169,11 @@ (progn (load "ls-lisp") (load "disp-table") ; needed to setup ibm-pc char set, see internal.el + (load "international/meadow-ntemacs") (load "dos-w32") (load "w32-vars") - (load "w32-fns"))) + (load "w32-fns") + (load "international/mw32misc"))) (if (eq system-type 'ms-dos) (progn (load "ls-lisp") Index: lisp/ChangeLog =================================================================== --- lisp/ChangeLog (.../trunk) (revision 10) +++ lisp/ChangeLog (.../branches/ime) (revision 10) @@ -1,3 +1,12 @@ +2004-03-12 Jesper Harder + + * info-look.el (info-lookup): Reuse an existing Info window. + +2004-03-12 Francis J. Wright + + * woman.el (woman-preserve-ascii): Default value changed to t and + doc string revised. + 2004-03-12 Richard M. Stallman * pcvs.el (cvs-mode-add-change-log-entry-other-window): Index: lisp/info-look.el =================================================================== --- lisp/info-look.el (.../trunk) (revision 10) +++ lisp/info-look.el (.../branches/ime) (revision 10) @@ -338,7 +338,8 @@ (info-frame (and window (window-frame window)))) (if (and info-frame (display-multi-frame-p) - (memq info-frame (frames-on-display-list))) + (memq info-frame (frames-on-display-list)) + (not (eq info-frame (selected-frame)))) (select-frame info-frame) (switch-to-buffer-other-window "*info*"))))) (while (and (not found) modes) Index: lisp/language/japan-util.el =================================================================== --- lisp/language/japan-util.el (.../trunk) (revision 10) +++ lisp/language/japan-util.el (.../branches/ime) (revision 10) @@ -29,6 +29,17 @@ ;;;###autoload (defun setup-japanese-environment-internal () + (cond ((eq system-type 'ms-dos) + (prefer-coding-system 'japanese-shift-jis)) + ((and + (featurep 'meadow-ntemacs) + (eq system-type 'windows-nt)) + (set-clipboard-coding-system 'japanese-shift-jis-dos) + (set-w32-system-coding-system 'japanese-shift-jis-dos) + (set-default-coding-systems 'japanese-shift-jis-dos) + (setq default-file-name-coding-system 'japanese-shift-jis)) + ((eq system-type 'usg-unix-v) + (prefer-coding-system 'japanese-iso-8bit))) ;; By default, we use 'japanese-iso-8bit for file names. But, the ;; following prefer-coding-system will override it. (if (memq system-type '(windows-nt ms-dos cygwin)) Index: nt/configure.bat =================================================================== --- nt/configure.bat (.../trunk) (revision 10) +++ nt/configure.bat (.../branches/ime) (revision 10) @@ -202,7 +202,7 @@ echo Checking for 'rm'... rm junk.bat if exist junk.bat goto needrm -goto checkcompiler +goto checkversion :needcp echo You need 'cp' (the Unix file copy program) to build Emacs. goto end @@ -212,6 +212,35 @@ goto end rem ---------------------------------------------------------------------- +rem Check for Windows Version. +rem _WIN32_WINDOWS and _WIN32_WINNT are automatically defined by WINVER. + +:checkversion +echo Checking for Windows Version ... + +%COMSPEC% /q /c ver > junk.txt + +%COMSPEC% /c findstr "XP" junk.txt > NUL +if %errorlevel%==0 goto WXP + +%COMSPEC% /c findstr "2000" junk.txt > NUL +if %errorlevel%==0 goto W2K + +if %errorlevel%==1 goto WNT + +:WXP +set usercflags=%usercflags%%sep1%-DWINVER=0x0501 +goto ver_end +:W2k +set usercflags=%usercflags%%sep1%-DWINVER=0x0500 +goto ver_end +:WNT +set usercflags=%usercflags%%sep1%-DWINVER=0x0400 +goto ver_end +:ver_end +rm -f junk.txt + +rem ---------------------------------------------------------------------- rem Auto-detect compiler if not specified, and validate GCC if chosen. :checkcompiler if (%COMPILER%)==(cl) goto compilercheckdone Index: nt/makefile.w32-in =================================================================== --- nt/makefile.w32-in (.../trunk) (revision 10) +++ nt/makefile.w32-in (.../branches/ime) (revision 10) @@ -217,11 +217,18 @@ # Note that man/makefile knows how to # put the info files in $(infodir), # so we can do ok running make in the build dir. -info: force-info +info: force-info info-$(MAKETYPE) + +info-nmake: (cd ..\man && $(MAKE) $(MFLAGS) info) (cd ..\lispref && $(MAKE) $(MFLAGS) info) (cd ..\lispintro && $(MAKE) $(MFLAGS) info) +info-gmake: + $(MAKE) $(MFLAGS) -C ../info info + $(MAKE) $(MFLAGS) -C ../lispref info + $(MAKE) $(MFLAGS) -C ../lispintro info + # # Maintenance # Index: nt/gmake.defs =================================================================== --- nt/gmake.defs (.../trunk) (revision 10) +++ nt/gmake.defs (.../branches/ime) (revision 10) @@ -74,6 +74,7 @@ USING_SH = 1 THE_SHELL = $(SHELL) SHELLTYPE=SH +CURDIR=$(subst \,/,$(shell cygpath -w $(shell pwd))) endif MAKETYPE=gmake @@ -184,8 +185,7 @@ else DEBUG_CFLAGS = endif -CFLAGS = -I. -DWIN32_LEAN_AND_MEAN -D_WIN32_WINNT=0x0400 $(ARCH_CFLAGS) -D$(ARCH) \ - -D_CRTAPI1=_cdecl \ +CFLAGS = -I. -DWIN32_LEAN_AND_MEAN $(ARCH_CFLAGS) -D$(ARCH) -D_CRTAPI1=_cdecl \ $(DEBUG_CFLAGS) $(USER_CFLAGS) $(LOCAL_FLAGS) EMACS_EXTRA_C_FLAGS = -DUSE_CRT_DLL=1 Index: lib-src/makefile.w32-in =================================================================== --- lib-src/makefile.w32-in (.../trunk) (revision 10) +++ lib-src/makefile.w32-in (.../branches/ime) (revision 10) @@ -126,7 +126,7 @@ # # From ..\src\makefile.nt. # -obj = abbrev.c alloc.c alloca.c buffer.c bytecode.c callint.c callproc.c casefiddle.c casetab.c category.c ccl.c charset.c cm.c cmds.c coding.c data.c dired.c dispnew.c doc.c doprnt.c editfns.c emacs.c eval.c fileio.c filelock.c filemode.c floatfns.c fns.c fontset.c frame.c fringe.c gmalloc.c indent.c insdel.c intervals.c keyboard.c keymap.c lastfile.c lread.c macros.c marker.c minibuf.c print.c process.c ralloc.c regex.c region-cache.c scroll.c search.c sound.c strftime.c syntax.c sysdep.c term.c termcap.c textprop.c tparam.c undo.c unexw32.c vm-limit.c w32.c w32console.c w32fns.c w32heap.c w32inevt.c w32menu.c w32proc.c w32reg.c w32select.c w32term.c w32xfns.c window.c xdisp.c xfaces.c xfaces.c +obj = abbrev.c alloc.c alloca.c buffer.c bytecode.c callint.c callproc.c casefiddle.c casetab.c category.c ccl.c charset.c cm.c cmds.c coding.c data.c dired.c dispnew.c doc.c doprnt.c editfns.c emacs.c eval.c fileio.c filelock.c filemode.c floatfns.c fns.c fontset.c frame.c fringe.c gmalloc.c indent.c insdel.c intervals.c keyboard.c keymap.c lastfile.c lread.c macros.c marker.c minibuf.c print.c process.c ralloc.c regex.c region-cache.c scroll.c search.c sound.c strftime.c syntax.c sysdep.c term.c termcap.c textprop.c tparam.c undo.c unexw32.c vm-limit.c w32.c w32console.c w32fns.c w32heap.c w32inevt.c w32menu.c w32proc.c w32reg.c w32select.c w32term.c w32xfns.c window.c xdisp.c xfaces.c xfaces.c w32ime.c # # These are the lisp files that are loaded up in loadup.el #