最終更新日: 2016-09-18 日 22:07
ホーム | 文書トップ | 目次

NTEmacs IMEパッチの解析(2010年)

Table of Contents

lib-src/makefile.w32-in

追加

$(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

lisp/international/w32-ime.el

これは元々の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)

lisp/loadup.el

追加

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")))

nt/configure.bat

追加

usew32ime という設定が追加されている。

: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=     ★ココ★

2箇所追加

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

本来、checkcompiler の前に、checkversion というルーチンを追加している

変更前

goto checkcompiler

変更後

goto checkversion

追加

checkversion のルーチン

Windowsのバージョンに応じて、WINVER の定義を設定している。

WINVERの定義を参照しているところは無く、何のために追加しているか不明。

また、使用者ではなく、ビルドしている環境に応じた設定となるので、そのやり方自体、本来よくないと思うのだが。

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 "6.0.6000" junk.txt > NUL
if %errorlevel%==0 goto VISTA

%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

:VISTA
set usercflags=%usercflags%%sep1%-DWINVER=0x0600
goto ver_end
: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 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

追加

if (%usew32ime%) == (Y) echo USE_W32_IME=1 >>config.settings

削除

if (%profile%) == (Y) echo #define PROFILING 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

src/keyboard.c

変更点はそれなりに多い

src/w32.c

変更前



変更後 が追加されている


src/w32fns.c

変更前



変更後 が追加されている


src/w32term.c

変更前



変更後 が追加されている


src/w32term.h

変更前



変更後 が追加されている


src/window.c

変更前



変更後 が追加されている


ホーム | 文書トップ | 目次
Created by Emacs 25.2.1 (Org mode 8.2.10)