NTEmacs IMEパッチについて(23.4)

追加

$(lispsource)international/w32-ime.elc が追加されている

WINNT_SUPPORT = \
	$(lispsource)ls-lisp.elc \
	$(lispsource)disp-table.elc \
	$(lispsource)w32-fns.elc \
	$(lispsource)dos-w32.elc \
	$(lispsource)w32-vars.elc \
	$(lispsource)international/w32-ime.elc \     ★ココ★
	$(lispsource)term/common-win.elc \
	$(lispsource)term/w32-win.elc

これは元々のEmacsのソースには存在しないファイル

ちなみに、Meadow のソースだと、lisp/international/meadow.el に元らしきコードがある。

Meadowだと mw32-なんちゃらとなっていた部分が w32-なんちゃら に変更されている。mw32のままでもよかったと思うのだが。

;;;;; w32-ime.el ---- Meadow features for NTEmacs.
;;
;;   Author H.Miyashita
;;
;;;;;

(defgroup W32-IME nil
  "w32-ime"
  :group 'emacs)

(defvar w32-last-selection nil
  "It is stored the last data from Emacs.")

;----------

(defvar w32-ime-on-hook nil
  "Functions to eval when IME is turned on at least.
Even if IME state is not changed, these functiona are maybe called.")
(defvar w32-ime-off-hook nil
  "Functions to eval when IME is turned off at least.
Even if IME state is not changed, these functiona are maybe called.")
(defvar w32-ime-buffer-switch-p t
  "If this variable is nil, IME control when buffer is switched is disabled.")
(defvar w32-ime-show-mode-line t
  "When t, mode line indicates IME state.")
(defvar w32-ime-mode-line-state-indicator "[O]"
  "This is shown at the mode line. It is regarded as state of ime.")
(make-variable-buffer-local 'w32-ime-mode-line-state-indicator)
(put 'w32-ime-mode-line-state-indicator 'permanent-local t)
(defvar w32-ime-mode-line-state-indicator-list '("-" "[|]" "[O]")
  "List of IME state indicator string.")
(defvar w32-ime-mode-line-format-original nil
  "Original mode line format.")

;;
;; Section: IME
;;

;; ;; This is temporal solution.  In the future, we will prepare
;; ;; dynamic configuration.
;; (defvar w32-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.
An original function is saved to FUNCTION-SUFFIX when suffix is string.
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)
	     (when interactive-p
	       (list 'interactive interactive-arg))
	     `(cond
		((and (ime-get-mode)
		      (equal current-input-method "W32-IME"))
 		 (ime-force-off)
		 (unwind-protect
		     (apply ',original-function arguments)
		   (when (and (not (ime-get-mode))
			      (equal current-input-method "W32-IME"))
		     (ime-force-on))))
		(t
		 (apply ',original-function arguments)))))))))

(defvar w32-ime-toroku-region-yomigana nil
  "* if this variable is string, toroku-region regard this value as yomigana.")

(defun w32-ime-toroku-region (begin end)
  (interactive "r")
  (let ((string (buffer-substring begin end))
	(w32-ime-buffer-switch-p nil)
	(reading w32-ime-toroku-region-yomigana))
    (unless (stringp reading)
      (w32-set-ime-mode 'hiragana)
      (setq reading
	    (read-multilingual-string
            (format "Input reading of \"%s\": " string) nil "W32-IME")))
    (w32-ime-register-word-dialog reading string)))

;; for IME management system.

(defun w32-ime-sync-state (window)
  (when w32-ime-buffer-switch-p
    (with-current-buffer (window-buffer window)
      (let* ((frame (window-frame window))
	     (ime-state (ime-get-mode)))
	(cond
	 ((and (not ime-state)
	       (equal current-input-method "W32-IME"))
	  (ime-force-on nil)
	  (run-hooks 'w32-ime-on-hook))
	 ((and ime-state
	       (not (equal current-input-method "W32-IME")))
;;;	  (when (= (w32-ime-undetermined-string-length) 0)
	  (ime-force-off nil)
	  (run-hooks 'w32-ime-off-hook)))))))

(defun w32-ime-set-selected-window-buffer-hook (oldbuf newwin newbuf)
  (w32-ime-sync-state newwin))

(defun w32-ime-select-window-hook (old new)
  (w32-ime-sync-state new))

(defun w32-ime-mode-line-update ()
  (cond
   (w32-ime-show-mode-line
    (unless (window-minibuffer-p (selected-window))
      (setq w32-ime-mode-line-state-indicator
	    (nth (if (ime-get-mode) 1 2)
		 w32-ime-mode-line-state-indicator-list))))
   (t
    (setq w32-ime-mode-line-state-indicator
	  (nth 0 w32-ime-mode-line-state-indicator-list))))
  (force-mode-line-update))

(defun w32-ime-init-mode-line-display ()
  (unless (member 'w32-ime-mode-line-state-indicator mode-line-format)
    (setq w32-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 'w32-ime-mode-line-state-indicator
				  (cdr mode-line-format))))
      (setq-default mode-line-format
		    (cons ""
			  (cons 'w32-ime-mode-line-state-indicator
				mode-line-format))))
    (force-mode-line-update t)))

(defun w32-ime-initialize ()
   (when (and (eq system-type 'windows-nt)
	      (eq window-system 'w32)
	      (featurep 'w32-ime))
     (w32-ime-init-mode-line-display)
     (w32-ime-mode-line-update)
     (add-hook 'select-window-functions
	       'w32-ime-select-window-hook)
     (add-hook 'set-selected-window-buffer-functions
	       'w32-ime-set-selected-window-buffer-hook)
     (define-key global-map [kanji] 'toggle-input-method)))
;;     (set-keyboard-coding-system 'utf-8)))

(defun w32-ime-uninitialize ()
  (when (and (eq system-type 'windows-nt)
	     (eq window-system 'w32)
	     (featurep 'w32-ime))
    (setq-default mode-line-format
		  w32-ime-mode-line-format-original)
    (force-mode-line-update t)
    (remove-hook 'select-window-functions
		 'w32-ime-select-window-hook)
    (remove-hook 'set-selected-window-buffer-functions
		 'w32-ime-set-selected-window-buffer-hook)
    (define-key global-map [kanji] 'ignore)))

(defun w32-ime-exit-from-minibuffer ()
  (inactivate-input-method)
  (when (<= (minibuffer-depth) 1)
    (remove-hook 'minibuffer-exit-hook 'w32-ime-exit-from-minibuffer)))

(defun w32-ime-state-switch (&optional arg)
  (if arg
      (progn
	(setq inactivate-current-input-method-function
	      'w32-ime-state-switch)
	(run-hooks 'input-method-activate-hook)
	(run-hooks 'w32-ime-on-hook)
	(setq describe-current-input-method-function nil)
	(when (eq (selected-window) (minibuffer-window))
	  (add-hook 'minibuffer-exit-hook 'w32-ime-exit-from-minibuffer))
	(ime-force-on))
    (setq current-input-method nil)
    (run-hooks 'input-method-inactivate-hook)
    (run-hooks 'w32-ime-off-hook)
    (setq describe-current-input-method-function nil)
    (ime-force-off))
  (w32-ime-mode-line-update))

(register-input-method "W32-IME" "Japanese" 'w32-ime-state-switch ""
		       "W32 System IME")

(provide 'w32-ime)

international/w32-ime が追加されている

(if (eq system-type 'windows-nt)
    (progn
      (load "w32-vars")
      (load "term/common-win")
      (load "term/w32-win")
      (load "ls-lisp")
      (load "disp-table")
      (load "international/w32-ime")    ★ココ★
      (load "dos-w32")
      (load "w32-fns")))

1行追加されている。ここで設定しておく必要はあるのだろうか。(ユーザ設定ではダメなのだろうか)

(set-language-environment "japanese")    ★ココ★
(let ((pwd (getenv "PWD")))
  (and (stringp pwd)
   ;; Use FOO/., so that if FOO is a symlink, file-attributes
   ;; describes the directory linked to, not FOO itself.
   (or (equal (file-attributes
		   (concat (file-name-as-directory pwd) "."))
		  (file-attributes
		   (concat (file-name-as-directory default-directory)
			   ".")))
	   (setq process-environment
		 (delete (concat "PWD=" pwd)
			 process-environment)))))

• copyright に 2012 が追加されている。細かい。。
• usew32ime という設定が追加されている。

:start
:start
rem ----------------------------------------------------------------------
rem   Default settings.
set prefix=
set nodebug=N
set noopt=N
set profile=N
set nocygwin=N
set COMPILER=
set usercflags=
set docflags=
set userldflags=
set doldflags=
set sep1=
set sep2=
set usew32ime=     ★ココ★

• configure.bat で –enable-w32-ime が指定された場合、withime にジャンプする。
• 親切に configure.bat のオプション説明のメッセージにも追加されている

rem ----------------------------------------------------------------------
rem   Handle arguments.
:again
if "%1" == "-h" goto usage
if "%1" == "--help" goto usage
if "%1" == "--prefix" goto setprefix
if "%1" == "--with-gcc" goto withgcc
if "%1" == "--with-msvc" goto withmsvc
if "%1" == "--no-debug" goto nodebug
if "%1" == "--no-opt" goto noopt
if "%1" == "--profile" goto profile
if "%1" == "--no-cygwin" goto nocygwin
if "%1" == "--cflags" goto usercflags
if "%1" == "--ldflags" goto userldflags
if "%1" == "--without-png" goto withoutpng
if "%1" == "--without-jpeg" goto withoutjpeg
if "%1" == "--without-gif" goto withoutgif
if "%1" == "--without-tiff" goto withouttiff
if "%1" == "--without-xpm" goto withoutxpm
if "%1" == "--with-svg" goto withsvg
if "%1" == "--enable-w32-ime" goto withime         ★ココ★
if "%1" == "" goto checkutils
:usage
echo Usage: configure [options]
echo Options:
echo.   --prefix PREFIX         install Emacs in directory PREFIX
echo.   --with-gcc              use GCC to compile Emacs
echo.   --with-msvc             use MSVC to compile Emacs
echo.   --no-debug              exclude debug info from executables
echo.   --no-opt                disable optimization
echo.   --profile               enable profiling
echo.   --no-cygwin             use -mno-cygwin option with GCC
echo.   --cflags FLAG           pass FLAG to compiler
echo.   --ldflags FLAG          pass FLAG to compiler when linking
echo.   --without-png           do not use PNG library even if it is installed
echo.   --without-jpeg          do not use JPEG library even if it is installed
echo.   --without-gif           do not use GIF library even if it is installed
echo.   --without-tiff          do not use TIFF library even if it is installed
echo.   --without-xpm           do not use XPM library even if it is installed
echo.   --with-svg              use the RSVG library (experimental)
echo.   --enable-w32-ime        build with w32 input method editor        ★ココ★
goto end

• ここへ来ると usew32ime がY USE_W32_IMEがYとなる

rem ----------------------------------------------------------------------

:withime
set usew32ime=Y
set USE_W32_IME=Y
shift
goto again

• RECONVERTSTRING の処理

rem ----------------------------------------------------------------------
rem check for RECONVERTSTRING
rem

echo checking for RECONVERTSTRING...

echo #include "windows.h" >junk.c
echo #include "imm.h" >>junk.c
echo main(){RECONVERTSTRING x;} >>junk.c

%COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj  >>config.log 2>&1
if exist junk.obj goto haveReconvertstring

echo ...RECONVERTSTRING isn't defined.
echo The failed program was: >>config.log
type junk.c >>config.log
set HAVE_RECONVERTSTRING=
goto recoverstringDone

:haveReconvertstring
echo ...RECONVERTSTRING is defined.
set HAVE_RECONVERTSTRING=1

:recoverstringDone
rm -f junk.c junk.obj

• config.settings への追記
  • usew32ime=Y の時、USE_W32_IME=1
• config.tmp への追記
  • USE_W32_IME が空白でない時、#define USE_W32_IME 1
  • HAVE_RECONVERTSTRING が空白でない時、#define HAVE_RECONVERTSTRING 1
• config.tmp へ #define PROFILING 1 が追記されないようにしている。

rem ----------------------------------------------------------------------
:genmakefiles
echo Generating makefiles
if %COMPILER% == gcc set MAKECMD=gmake
if %COMPILER% == cl set MAKECMD=nmake

rem   Pass on chosen settings to makefiles.
rem   NB. Be very careful to not have a space before redirection symbols
rem   except when there is a preceding digit, when a space is required.
rem
echo # Start of settings from configure.bat >config.settings
echo COMPILER=%COMPILER%>>config.settings
if not "(%mf%)" == "()" echo MCPU_FLAG=%mf%>>config.settings
if not "(%dbginfo%)" == "()" echo DEBUG_INFO=%dbginfo%>>config.settings
if (%nodebug%) == (Y) echo NODEBUG=1 >>config.settings
if (%noopt%) == (Y) echo NOOPT=1 >>config.settings
if (%profile%) == (Y) echo PROFILE=1 >>config.settings
if (%nocygwin%) == (Y) echo NOCYGWIN=1 >>config.settings
if not "(%prefix%)" == "()" echo INSTALL_DIR=%prefix%>>config.settings
rem We go thru docflags because usercflags could be "-DFOO=bar" -something
rem and the if command cannot cope with this
for %%v in (%usercflags%) do if not (%%v)==() set docflags=Y
if (%docflags%)==(Y) echo USER_CFLAGS=%usercflags%>>config.settings
for %%v in (%userldflags%) do if not (%%v)==() set doldflags=Y
if (%doldflags%)==(Y) echo USER_LDFLAGS=%userldflags%>>config.settings
if (%usew32ime%) == (Y) echo USE_W32_IME=1 >>config.settings                   ★ココは追加
echo # End of settings from configure.bat>>config.settings
echo. >>config.settings

copy config.nt config.tmp
echo. >>config.tmp
echo /* Start of settings from configure.bat.  */ >>config.tmp
if (%docflags%) == (Y) echo #define USER_CFLAGS " %usercflags%">>config.tmp
if (%doldflags%) == (Y) echo #define USER_LDFLAGS " %userldflags%">>config.tmp
if (%profile%) == (Y) echo #define PROFILING 1 >>config.tmp                     ★ココは削除
if not "(%HAVE_PNG%)" == "()" echo #define HAVE_PNG 1 >>config.tmp
if not "(%HAVE_JPEG%)" == "()" echo #define HAVE_JPEG 1 >>config.tmp
if not "(%HAVE_GIF%)" == "()" echo #define HAVE_GIF 1 >>config.tmp
if not "(%HAVE_TIFF%)" == "()" echo #define HAVE_TIFF 1 >>config.tmp
if not "(%HAVE_XPM%)" == "()" echo #define HAVE_XPM 1 >>config.tmp
if "(%HAVE_RSVG%)" == "(1)" echo #define HAVE_RSVG 1 >>config.tmp
if not "(%USE_W32_IME%)" == "()" echo #define USE_W32_IME 1 >>config.tmp                      ★ココは追加
if not "(%HAVE_RECONVERTSTRING%)" == "()" echo #define HAVE_RECONVERTSTRING 1 >>config.tmp    ★ココは追加

echo /* End of settings from configure.bat.  */ >>config.tmp

• マクロの追加

/* patch20101016 */
#ifdef WINDOWSNT
#include <mbstring.h>
#define LAST_CHAR(buf,len) ((len) < 1 ? '\0' : *_mbsdec((buf), (buf) + (len)))
#define STRINC(p) _mbsinc(p)
#define STRDEC(start, p) _mbsdec(start, p)
#+BEGIN_HTML
<a name="else" id="else">
#+END_HTML

#define LAST_CHAR(buf,len) ((len) < 1 ? '\0' : *((buf) + (len) - 1))
#define STRINC(p) p + 1
#define STRDEC(start, p) p - 1
#+BEGIN_HTML
<a name="endif" id="endif">
#+END_HTML

• 最後の文字列の判断が、マルチバイトだと問題になっている部分を修正しているようだ

/* patch20101016
  if (!(IS_DIRECTORY_SEP (pwd[len - 1])))
*/
  if (!(IS_DIRECTORY_SEP (LAST_CHAR(pwd, len))))

static struct frame_parm_table frame_parms[] =
{
  {"auto-raise",		&Qauto_raise},
  {"auto-lower",		&Qauto_lower},
  {"background-color",		0},
  {"border-color",		&Qborder_color},
  {"border-width",		&Qborder_width},
  {"cursor-color",		&Qcursor_color},
  {"cursor-type",		&Qcursor_type},
  {"font",			0},
  {"foreground-color",		0},
  {"icon-name",			&Qicon_name},
  {"icon-type",			&Qicon_type},
  {"internal-border-width",	&Qinternal_border_width},
  {"menu-bar-lines",		&Qmenu_bar_lines},
  {"mouse-color",		&Qmouse_color},
  {"name",			&Qname},
  {"scroll-bar-width",		&Qscroll_bar_width},
  {"title",			&Qtitle},
  {"unsplittable",		&Qunsplittable},
  {"vertical-scroll-bars",	&Qvertical_scroll_bars},
  {"visibility",		&Qvisibility},
  {"tool-bar-lines",		&Qtool_bar_lines},
  {"scroll-bar-foreground",	&Qscroll_bar_foreground},
  {"scroll-bar-background",	&Qscroll_bar_background},
  {"screen-gamma",		&Qscreen_gamma},
  {"line-spacing",		&Qline_spacing},
  {"left-fringe",		&Qleft_fringe},
  {"right-fringe",		&Qright_fringe},
  {"wait-for-wm",		&Qwait_for_wm},
  {"fullscreen",                &Qfullscreen},
  {"font-backend",		&Qfont_backend},
  {"alpha",			&Qalpha},
#ifdef USE_W32_IME                     ★ココ追加
  {"ime-font", 			&Qime_font},   ★ココ追加
#endif /* USE_W32_IME */               ★ココ追加
  {"sticky",			&Qsticky},
};

extern Lisp_Object Qauto_raise, Qauto_lower;
extern Lisp_Object Qborder_color, Qborder_width;
extern Lisp_Object Qbuffer_predicate, Qbuffer_list, Qburied_buffer_list;
extern Lisp_Object Qcursor_color, Qcursor_type;
#ifdef USE_W32_IME            ★ココ追加
extern Lisp_Object Qime_font; ★ココ追加
#endif /* USE_W32_IME */      ★ココ追加
extern Lisp_Object Qfont;
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;
extern Lisp_Object Qmenu_bar_lines, Qtool_bar_lines;
extern Lisp_Object Qmouse_color;
extern Lisp_Object Qname, Qtitle;
extern Lisp_Object Qparent_id;
extern Lisp_Object Qunsplittable, Qvisibility;
extern Lisp_Object Qscroll_bar_width, Qvertical_scroll_bars;
extern Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background;
extern Lisp_Object Qscreen_gamma;
extern Lisp_Object Qline_spacing;
extern Lisp_Object Qwait_for_wm;
extern Lisp_Object Qfullscreen;
extern Lisp_Object Qfullwidth, Qfullheight, Qfullboth, Qmaximized;
extern Lisp_Object Qsticky;
extern Lisp_Object Qfont_backend;
extern Lisp_Object Qalpha;