Index: lib-src/makefile.w32-in =================================================================== RCS file: /cvsroot/emacs/emacs/lib-src/makefile.w32-in,v retrieving revision 2.31 diff -c -r2.31 makefile.w32-in *** lib-src/makefile.w32-in 11 Jun 2004 02:39:50 -0000 2.31 --- lib-src/makefile.w32-in 19 Jul 2004 14:19:50 -0000 *************** *** 126,132 **** # # 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 image.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 # # These are the lisp files that are loaded up in loadup.el # --- 126,132 ---- # # 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 image.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 # Index: lisp/loadup.el =================================================================== RCS file: /cvsroot/emacs/emacs/lisp/loadup.el,v retrieving revision 1.134 diff -c -r1.134 loadup.el *** lisp/loadup.el 12 Apr 2004 19:30:13 -0000 1.134 --- lisp/loadup.el 19 Jul 2004 14:19:50 -0000 *************** *** 169,177 **** (progn (load "ls-lisp") (load "disp-table") ; needed to setup ibm-pc char set, see internal.el (load "dos-w32") (load "w32-vars") ! (load "w32-fns"))) (if (eq system-type 'ms-dos) (progn (load "ls-lisp") --- 169,179 ---- (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 "international/mw32misc"))) (if (eq system-type 'ms-dos) (progn (load "ls-lisp") Index: man/makefile.w32-in =================================================================== RCS file: /cvsroot/emacs/emacs/man/makefile.w32-in,v retrieving revision 1.11 diff -c -r1.11 makefile.w32-in *** man/makefile.w32-in 1 Jul 2004 02:22:14 -0000 1.11 --- man/makefile.w32-in 19 Jul 2004 14:19:50 -0000 *************** *** 30,36 **** # The makeinfo program is part of the Texinfo distribution. MAKEINFO = makeinfo ! MULTI_INSTALL_INFO = $(srcdir)\..\nt\multi-install-info.bat INFO_TARGETS = $(infodir)/emacs $(infodir)/ccmode \ $(infodir)/cl $(infodir)/dired-x \ $(infodir)/ediff $(infodir)/forms \ --- 30,36 ---- # The makeinfo program is part of the Texinfo distribution. MAKEINFO = makeinfo ! MULTI_INSTALL_INFO = $(srcdir)/../nt/multi-install-info.bat INFO_TARGETS = $(infodir)/emacs $(infodir)/ccmode \ $(infodir)/cl $(infodir)/dired-x \ $(infodir)/ediff $(infodir)/forms \ Index: nt/configure.bat =================================================================== RCS file: /cvsroot/emacs/emacs/nt/configure.bat,v retrieving revision 1.27 diff -c -r1.27 configure.bat *** nt/configure.bat 6 May 2004 19:17:54 -0000 1.27 --- nt/configure.bat 19 Jul 2004 14:19:50 -0000 *************** *** 202,208 **** echo Checking for 'rm'... rm junk.bat if exist junk.bat goto needrm ! goto checkcompiler :needcp echo You need 'cp' (the Unix file copy program) to build Emacs. goto end --- 202,208 ---- echo Checking for 'rm'... rm junk.bat if exist junk.bat goto needrm ! goto checkversion :needcp echo You need 'cp' (the Unix file copy program) to build Emacs. goto end *************** *** 212,217 **** --- 212,246 ---- 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/gmake.defs =================================================================== RCS file: /cvsroot/emacs/emacs/nt/gmake.defs,v retrieving revision 1.21 diff -c -r1.21 gmake.defs *** nt/gmake.defs 22 Apr 2004 23:56:49 -0000 1.21 --- nt/gmake.defs 19 Jul 2004 14:19:50 -0000 *************** *** 183,190 **** else DEBUG_CFLAGS = endif ! CFLAGS = -I. -DWIN32_LEAN_AND_MEAN -D_WIN32_WINNT=0x0400 $(ARCH_CFLAGS) -D$(ARCH) \ ! -D_CRTAPI1=_cdecl \ $(DEBUG_CFLAGS) $(USER_CFLAGS) $(LOCAL_FLAGS) EMACS_EXTRA_C_FLAGS = -DUSE_CRT_DLL=1 --- 183,189 ---- else DEBUG_CFLAGS = endif ! 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: nt/makefile.w32-in =================================================================== RCS file: /cvsroot/emacs/emacs/nt/makefile.w32-in,v retrieving revision 1.24 diff -c -r1.24 makefile.w32-in *** nt/makefile.w32-in 11 Jun 2004 02:39:51 -0000 1.24 --- nt/makefile.w32-in 19 Jul 2004 14:19:50 -0000 *************** *** 126,132 **** exit -1; \ fi ! bootstrap: addsection bootstrap-$(MAKETYPE) all bootstrap-nmake: cd ..\lisp --- 126,132 ---- exit -1; \ fi ! bootstrap: addsection bootstrap-$(MAKETYPE) info all bootstrap-nmake: cd ..\lisp Index: src/emacs.c =================================================================== RCS file: /cvsroot/emacs/emacs/src/emacs.c,v retrieving revision 1.342 diff -c -r1.342 emacs.c *** src/emacs.c 24 Jun 2004 20:24:52 -0000 1.342 --- src/emacs.c 19 Jul 2004 14:19:51 -0000 *************** *** 1544,1549 **** --- 1544,1552 ---- 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/frame.c =================================================================== RCS file: /cvsroot/emacs/emacs/src/frame.c,v retrieving revision 1.307 diff -c -r1.307 frame.c *** src/frame.c 17 Jul 2004 14:45:01 -0000 1.307 --- src/frame.c 19 Jul 2004 14:19:51 -0000 *************** *** 2533,2538 **** --- 2533,2542 ---- 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; *************** *** 2548,2553 **** --- 2552,2560 ---- {"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 =================================================================== RCS file: /cvsroot/emacs/emacs/src/frame.h,v retrieving revision 1.107 diff -c -r1.107 frame.h *** src/frame.h 8 Feb 2004 23:19:37 -0000 1.107 --- src/frame.h 19 Jul 2004 14:19:51 -0000 *************** *** 982,987 **** --- 982,990 ---- 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/keyboard.c =================================================================== RCS file: /cvsroot/emacs/emacs/src/keyboard.c,v retrieving revision 1.786 diff -c -r1.786 keyboard.c *** src/keyboard.c 19 Jul 2004 04:42:43 -0000 1.786 --- src/keyboard.c 19 Jul 2004 14:19:51 -0000 *************** *** 4657,4667 **** --- 4657,4681 ---- "pause", /* VK_PAUSE 0x13 */ "capslock", /* VK_CAPITAL 0x14 */ + #ifdef IME_CONTROL /* 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 IME_CONTROL + "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 */ *************** *** 8485,8490 **** --- 8499,8511 ---- 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; *************** *** 8580,8585 **** --- 8601,8610 ---- struct gcpro gcpro1; + #ifdef IME_CONTROL + VIME_command_off_flag = Qnil; + #endif + GCPRO1 (fake_prefixed_keys); raw_keybuf_count = 0; *************** *** 8631,8636 **** --- 8656,8667 ---- 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; *************** *** 8749,8754 **** --- 8780,8795 ---- 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"); *************** *** 9438,9443 **** --- 9479,9490 ---- ? 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/makefile.w32-in =================================================================== RCS file: /cvsroot/emacs/emacs/src/makefile.w32-in,v retrieving revision 1.32 diff -c -r1.32 makefile.w32-in *** src/makefile.w32-in 11 Jun 2004 02:39:51 -0000 1.32 --- src/makefile.w32-in 19 Jul 2004 14:19:51 -0000 *************** *** 129,135 **** $(BLD)/w32select.$(O) \ $(BLD)/w32menu.$(O) \ $(BLD)/w32reg.$(O) \ ! $(BLD)/w32bdf.$(O) LIBS = $(TLIB0) \ $(TLIB1) \ --- 129,136 ---- $(BLD)/w32select.$(O) \ $(BLD)/w32menu.$(O) \ $(BLD)/w32reg.$(O) \ ! $(BLD)/w32bdf.$(O) \ ! $(BLD)/w32ime.$(O) LIBS = $(TLIB0) \ $(TLIB1) \ *************** *** 1471,1473 **** --- 1472,1487 ---- $(SRC)/w32bdf.h \ $(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)/buffer.h \ + $(SRC)/charset.h \ + $(SRC)/coding.h + + # arch-tag: 9fd7aba8-f826-4111-b3c0-497a8e7db9a0 Index: src/w32.c =================================================================== RCS file: /cvsroot/emacs/emacs/src/w32.c,v retrieving revision 1.88 diff -c -r1.88 w32.c *** src/w32.c 17 May 2004 21:33:16 -0000 1.88 --- src/w32.c 19 Jul 2004 14:19:52 -0000 *************** *** 713,719 **** --- 713,723 ---- int len = 0; /* must be valid filename, no wild cards or other invalid characters */ + #ifndef IME_CONTROL if (strpbrk (name, "*?|<>\"")) + #else + if (_mbspbrk (name, "*?|<>\"")) + #endif return 0; dir_handle = FindFirstFile (name, &find_data); *************** *** 788,794 **** --- 792,802 ---- if (!IS_DIRECTORY_SEP (ptr[0]) || !IS_DIRECTORY_SEP (ptr[1]) || !ptr[2]) return 0; + #ifndef IME_CONTROL if (strpbrk (ptr + 2, "*?|<>\"\\/")) + #else + if (_mbspbrk (ptr + 2, "*?|<>\"\\/")) + #endif return 0; return 1; *************** *** 2285,2291 **** --- 2293,2303 ---- name = (char *) map_w32_filename (path, &path); /* must be valid filename, no wild cards or other invalid characters */ + #ifndef IME_CONTROL if (strpbrk (name, "*?|<>\"")) + #else + if (_mbspbrk (name, "*?|<>\"")) + #endif { errno = ENOENT; return -1; Index: src/w32bdf.c =================================================================== RCS file: /cvsroot/emacs/emacs/src/w32bdf.c,v retrieving revision 1.20 diff -c -r1.20 w32bdf.c *** src/w32bdf.c 16 Nov 2003 16:17:08 -0000 1.20 --- src/w32bdf.c 19 Jul 2004 14:19:52 -0000 *************** *** 301,307 **** font_char *pch; cache_bitmap *pcb; ! UnmapViewOfFile(fontp->hfilemap); CloseHandle(fontp->hfilemap); CloseHandle(fontp->hfile); --- 301,307 ---- font_char *pch; cache_bitmap *pcb; ! UnmapViewOfFile(fontp->font); CloseHandle(fontp->hfilemap); CloseHandle(fontp->hfile); Index: src/w32fns.c =================================================================== RCS file: /cvsroot/emacs/emacs/src/w32fns.c,v retrieving revision 1.238 diff -c -r1.238 w32fns.c *** src/w32fns.c 19 Jul 2004 07:56:20 -0000 1.238 --- src/w32fns.c 19 Jul 2004 14:19:53 -0000 *************** *** 53,58 **** --- 53,62 ---- #include #include + #if IME_CONTROL + #include + #endif /* IME_CONTROL */ + #include #define FILE_NAME_TEXT_FIELD edt1 *************** *** 195,200 **** --- 199,210 ---- 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; *************** *** 413,419 **** 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)); ! --- 423,431 ---- 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)); ! #ifdef IME_CONTROL ! void x_set_ime_font (struct frame *, Lisp_Object, Lisp_Object); ! #endif *************** *** 430,436 **** --- 442,452 ---- 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; *************** *** 1592,1597 **** --- 1608,1633 ---- 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. */ *************** *** 2006,2019 **** 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) { ! /* Then try to load a shared predefined cursor. */ ! cursor = LoadImage (NULL, name, IMAGE_CURSOR, 0, 0, LR_DEFAULTCOLOR | LR_DEFAULTSIZE | LR_SHARED); } return cursor; --- 2042,2055 ---- Cursor w32_load_cursor (LPCTSTR name) { ! /* 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 cursor from application resource. */ ! cursor = LoadImage ((HINSTANCE) GetModuleHandle(NULL), ! name, IMAGE_CURSOR, 0, 0, LR_DEFAULTCOLOR | LR_DEFAULTSIZE | LR_SHARED); } return cursor; *************** *** 2069,2076 **** --- 2105,2117 ---- 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 */ *************** *** 2080,2085 **** --- 2121,2139 ---- } 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, *************** *** 2091,2096 **** --- 2145,2151 ---- NULL, hinst, NULL); + #endif /* CLIENTEDGE */ if (hwnd) { *************** *** 2763,2768 **** --- 2818,2826 ---- 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; *************** *** 3613,3621 **** leave_crit (); memset (&rect, 0, sizeof (rect)); AdjustWindowRect (&rect, GetWindowLong (hwnd, GWL_STYLE), GetMenu (hwnd) != NULL); ! /* Force width and height of client area to be exact multiples of the character cell dimensions. */ wdiff = (lppos->cx - (rect.right - rect.left) --- 3671,3683 ---- 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) *************** *** 3811,3818 **** --- 3873,3948 ---- return retval; } + #ifdef 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; + #ifdef RECONVERSION + case WM_IME_REQUEST: + if (wParam == IMR_RECONVERTSTRING) + { + if (lParam) + { + extern LRESULT w32_get_ime_reconversion_string (HWND hwnd, + WPARAM wParam, + RECONVERTSTRING* lParam); + return w32_get_ime_reconversion_string (hwnd, wParam, + (RECONVERTSTRING*) lParam); + } + else + { + extern LRESULT w32_get_ime_reconversion_length (); + return w32_get_ime_reconversion_length (); + } + } + goto dflt; + #endif + #endif /* IME_CONTROL */ default: + #ifdef IME_CONTROL + { + 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) { *************** *** 4203,4208 **** --- 4333,4344 ---- x_default_parameter (f, parameters, 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, parameters, Qime_font, font, + "ime-font", "IME-Font", RES_TYPE_STRING); + #endif + } x_default_parameter (f, parameters, Qborder_width, make_number (2), *************** *** 8376,8381 **** --- 8512,8520 ---- 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, *************** *** 8415,8420 **** --- 8554,8565 ---- staticpro (&Qsuppress_icon); Qundefined_color = intern ("undefined-color"); staticpro (&Qundefined_color); + #ifdef IME_CONTROL + Qime_font = intern ("ime-font"); + staticpro (&Qime_font); + #endif /* IME_CONTROL */ + Qcenter = intern ("center"); + staticpro (&Qcenter); Qcancel_timer = intern ("cancel-timer"); staticpro (&Qcancel_timer); Index: src/w32term.c =================================================================== RCS file: /cvsroot/emacs/emacs/src/w32term.c,v retrieving revision 1.212 diff -c -r1.212 w32term.c *** src/w32term.c 17 May 2004 21:43:22 -0000 1.212 --- src/w32term.c 19 Jul 2004 14:19:54 -0000 *************** *** 2753,2759 **** --- 2753,2766 ---- /* If the dirty region is not what we expected, redraw the entire frame. */ if (!EqualRgn (combined, expect_dirty)) SET_FRAME_GARBAGED (f); + #ifdef IME_CONTROL + DeleteObject (dirty); + DeleteObject (combined); + #endif } + #ifdef IME_CONTROL + DeleteObject (expect_dirty); + #endif UNBLOCK_INPUT; } *************** *** 4761,4766 **** --- 4768,4844 ---- 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; + EVENT_INIT (buf); + + #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) *************** *** 5132,5137 **** --- 5210,5219 ---- 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 *************** *** 5391,5398 **** --- 5473,5485 ---- 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); *************** *** 5522,5529 **** --- 5609,5621 ---- 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, *************** *** 6450,6455 **** --- 6542,6550 ---- 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 =================================================================== RCS file: /cvsroot/emacs/emacs/src/w32term.h,v retrieving revision 1.60 diff -c -r1.60 w32term.h *** src/w32term.h 18 May 2004 19:54:24 -0000 1.60 --- src/w32term.h 19 Jul 2004 14:19:54 -0000 *************** *** 594,599 **** --- 594,620 ---- #define WM_XBUTTONUP (WM_MOUSEWHEEL + 2) #endif /* WM_XBUTTONDOWN */ + #ifdef RECONVERSION + #ifndef WM_IME_REQUEST + #define WM_IME_REQUEST 0x288 + #endif + #ifndef IMR_COMPOSITIONWINDOW + #define IMR_COMPOSITIONWINDOW 0x0001 + #endif + #ifndef IMR_CANDIDATEWINDOW + #define IMR_CANDIDATEWINDOW 0x0002 + #endif + #ifdef IMR_COMPOSITIONFONT + #define IMR_COMPOSITIONFONT 0x0003 + #endif + #ifndef IMR_RECONVERTSTRING + #define IMR_RECONVERTSTRING 0x0004 + #endif + #ifndef IMR_CONFIRMRECONVERTSTRING + #define IMR_CONFIRMRECONVERTSTRING 0x0005 + #endif + #endif + #define WM_EMACS_START (WM_USER + 1) #define WM_EMACS_KILL (WM_EMACS_START + 0) #define WM_EMACS_CREATEWINDOW (WM_EMACS_START + 1) *************** *** 617,622 **** --- 638,688 ---- #define WM_EMACS_SETCURSOR (WM_EMACS_START + 19) #define WM_EMACS_END (WM_EMACS_START + 20) + #ifdef 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) + + /* 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) *************** *** 648,653 **** --- 714,740 ---- int completed; } deferred_msg; + #ifdef RECONVERSION + #ifndef _IMM_ + typedef struct tagRECONVERTSTRING { + DWORD dwSize; + DWORD dwVersion; + DWORD dwStrLen; + DWORD dwStrOffset; + DWORD dwCompStrLen; + DWORD dwCompStrOffset; + DWORD dwTargetStrLen; + DWORD dwTargetStrOffset; + } RECONVERTSTRING, *PRECONVERTSTRING; + #endif + #ifndef SCS_SETRECONVERTSTRING + #define SCS_SETRECONVERTSTRING 0x00010000 + #endif + #ifndef SCS_QUERYRECONVERTSTRING + #define SCS_QUERYRECONVERTSTRING 0x00020000 + #endif + #endif + extern CRITICAL_SECTION critsect; extern void init_crit (); *************** *** 728,733 **** --- 815,912 ---- EXFUN (Fx_display_color_p, 1); EXFUN (Fx_display_grayscale_p, 1); + #ifdef 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/window.c =================================================================== RCS file: /cvsroot/emacs/emacs/src/window.c,v retrieving revision 1.470 diff -c -r1.470 window.c *** src/window.c 17 Jul 2004 14:59:02 -0000 1.470 --- src/window.c 19 Jul 2004 14:19:55 -0000 *************** *** 214,219 **** --- 214,226 ---- static int inhibit_frame_unsplittable; #endif /* 0 */ + #ifdef IME_CONTROL + 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; *************** *** 3070,3075 **** --- 3077,3095 ---- } set_window_buffer (window, buffer, 1, !NILP (keep_margins)); + + #ifdef IME_CONTROL + 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; } *************** *** 3091,3096 **** --- 3111,3119 ---- register struct window *w; register struct window *ow; struct frame *sf; + #ifdef IME_CONTROL + Lisp_Object oldwin = selected_window; + #endif CHECK_LIVE_WINDOW (window); *************** *** 3146,3151 **** --- 3169,3180 ---- } windows_or_buffers_changed++; + + #ifdef IME_CONTROL + if (!NILP (Vselect_window_functions)) + run_hook_with_args_2 (Qselect_window_functions, oldwin, window); + #endif + return window; } *************** *** 6448,6453 **** --- 6477,6492 ---- Qwindow_configuration_change_hook = intern ("window-configuration-change-hook"); + #ifdef IME_CONTROL + 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); *************** *** 6653,6658 **** --- 6692,6712 ---- Fmake_variable_buffer_local (Qwindow_size_fixed); window_size_fixed = 0; + #ifdef IME_CONTROL + DEFVAR_LISP ("select-window-functions", &Vselect_window_functions, + doc: /* "This is a hook when select-window is called. + 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, + doc: /* "This is a hook when set-selected-window-buffer is called. + This is called with three arguments + OLD-BUFFER, NEW-WINDOW and NEW-BUFFER. + 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); --- /dev/null 2004-07-19 23:21:14.944000000 +0900 +++ lisp/international/meadow-ntemacs.el 2004-06-12 00:56:20.000000000 +0900 @@ -0,0 +1,394 @@ +;;;;; 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 +;; + +(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: 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) --- /dev/null 2004-07-19 23:21:14.974000000 +0900 +++ lisp/international/mw32misc.el 2004-05-27 22:28:32.000000000 +0900 @@ -0,0 +1,651 @@ +;;;;; mw32misc.el ---- For Multilingul Windows. +;; +;; Author H.Miyashita +;; +;;;;; + +(eval-when-compile + (require 'regexp-opt)) + +(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) + ))) + +(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))))) --- /dev/null 2004-07-19 23:21:15.014000000 +0900 +++ src/w32ime.c 2004-07-18 09:30:42.000000000 +0900 @@ -0,0 +1,1636 @@ +/* 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 +#ifdef RECONVERSION +#include "buffer.h" +#endif +#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 (f) + 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)); + } +} + +void +w32_set_ime_status (hwnd, openp) + HWND hwnd; + int openp; +{ + HIMC himc; + + himc = (ImmGetContextProc) (hwnd); + (ImmSetOpenStatusProc) (himc, openp); + (ImmReleaseContextProc) (hwnd, himc); +} + +int +w32_get_ime_status (hwnd) + HWND hwnd; +{ + HIMC himc; + int ret; + + himc = (ImmGetContextProc) (hwnd); + ret = (ImmGetOpenStatusProc) (himc); + (ImmReleaseContextProc) (hwnd, himc); + + return ret; +} + +int +w32_set_ime_mode (hwnd, mode, mask) + 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 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 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); + { + 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; +} + +#ifdef RECONVERSION +LRESULT +w32_get_ime_reconversion_length () +{ + Lisp_Object str, start, end; + LRESULT lResult = 0; + int len, pt, pt_byte; + MEADOW_ENCODE_ALLOC_PREDEFINE; + + pt = PT; + pt_byte = PT_BYTE; + + if (!NILP (current_buffer->read_only)) + return 0; + + if (!NILP (current_buffer->mark_active)) + { + start = marker_position (current_buffer->mark) < PT + ? Fmarker_position (current_buffer->mark) + : Fpoint_marker (); + end = marker_position (current_buffer->mark) < PT + ? Fpoint_marker () + : Fmarker_position (current_buffer->mark); + } + else + { + if (NILP (Feobp ())) + Fforward_char (make_number (1)); + Fforward_word (make_number (-1)); + start = Fpoint_marker (); + end = Fmake_marker (); + Fforward_word (make_number (1)); + end = Fpoint_marker (); + } + + str = Fbuffer_substring_no_properties (start, end); + + MEADOW_ENCODE_ALLOC (LISPY_STRING_BYTES (str)); + MEADOW_ENCODE (XSTRING (str)->data, LISPY_STRING_BYTES (str)); + len = MEADOW_ENCODE_PRODUCED; + SET_PT_BOTH (pt, pt_byte); + + /* Return need size on reconverted string */ + lResult = sizeof (RECONVERTSTRING) + len + 1; + return lResult; +} + + +BOOL +w32_get_ime_reconversion_string (hwnd, wParam, reconv) + HWND hwnd; + WPARAM wParam; + RECONVERTSTRING *reconv; +{ + HIMC hIMC; + int len, result; + Lisp_Object str, start, end; + struct w32_display_info *dpyinfo = &one_w32_display_info; + struct frame *f = x_window_to_frame (dpyinfo, hwnd); + MEADOW_ENCODE_ALLOC_PREDEFINE; + + if (!NILP (current_buffer->mark_active)) + { + start = marker_position (current_buffer->mark) < PT + ? Fmarker_position (current_buffer->mark) + : Fpoint_marker (); + end = marker_position (current_buffer->mark) < PT + ? Fpoint_marker () + : Fmarker_position (current_buffer->mark); + } + else + { + if (NILP (Feobp ())) + Fforward_char (make_number (1)); + Fforward_word (make_number (-1)); + start = Fpoint_marker (); + end = Fmake_marker (); + Fforward_word (make_number (1)); + end = Fpoint_marker (); + } + + str = Fbuffer_substring_no_properties (start, end); + + MEADOW_ENCODE_ALLOC (LISPY_STRING_BYTES (str)); + MEADOW_ENCODE (XSTRING (str)->data, LISPY_STRING_BYTES (str)); + len = MEADOW_ENCODE_PRODUCED; + MEADOW_ENCODE_BUF[len] = '\0'; + + Fgoto_char (start); + + hIMC = (ImmGetContextProc) (hwnd); + if (!hIMC) + return FALSE; + + /* Memories are reserved in advance. */ + strcpy ((LPSTR) reconv + sizeof (RECONVERTSTRING), MEADOW_ENCODE_BUF); + reconv->dwStrLen = len; + reconv->dwStrOffset = sizeof (RECONVERTSTRING); + reconv->dwTargetStrLen = len; + reconv->dwTargetStrOffset = 0; + + /* Reconverted area is all of selected string. */ + reconv->dwCompStrOffset = 0; + reconv->dwCompStrLen = len; + reconv->dwTargetStrOffset = 0; + +#if 0 /* Why not need for automatic adjustment? */ + /* Automatically adjust RECONVERTSTRING if not selected. */ + if (NILP (current_buffer->mark_active)) + (ImmSetCompositionStringProc) (hIMC, + SCS_QUERYRECONVERTSTRING, + (LPCVOID) reconv, + reconv->dwSize, + NULL, 0 ); +#endif + + if ((ImmSetCompositionStringProc) (hIMC, + SCS_SETRECONVERTSTRING, + (LPCVOID) reconv, + reconv->dwSize, + NULL, 0)) + { + /* Set the position of candidate list dialog. */ + w32_set_ime_conv_window (f); + /* Delete the selected area. */ + Fdelete_region (start, end); + result = TRUE; + } + else + result = FALSE; + + (ImmReleaseContextProc) (hwnd, hIMC); + return result; +} +#endif /* RECONVERSION */ + +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, psetlf) + 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 (context) + 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 (context) + 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) +/* 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 hwnd; +{ + HKL imehkl; + UINT modifier; + UINT vkey; + (ImmGetHotKeyProc) (IME_JHOTKEY_CLOSE_OPEN, + &modifier, &vkey, &imehkl); +} +#endif + +Lisp_Object +get_style_lisp_object (dwStyle) + 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 (attr) + 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 (attr) + 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); + 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 = concat2 (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 */ +}