Skip to content

Instantly share code, notes, and snippets.

@te223
Last active December 28, 2023 19:10
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save te223/9d5cd90b98877c62429405639927aafc to your computer and use it in GitHub Desktop.
Save te223/9d5cd90b98877c62429405639927aafc to your computer and use it in GitHub Desktop.
EMP版 MacOS emacs29 において、モードライン左端にIMEの状態を示す「あ」などの文字を表示するスクリプト (https://tezfm.blogspot.com/2023/12/emp-emacs291-elisp.html)
;;; -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright (c) 2023 Tetsu. All rights reserved.
;; Created: Fri Dec 8 2023
;; EMP版 emacs29.1 において、モードライン左端にIMEの状態を示す「あ」な
;; どの文字を表示するスクリプト
;;
;; emacs.el または .emacs.d/init.el への組み込み例
;; (when (fboundp 'mac-input-source)
;; ;; (mac-auto-ascii-mode 1) ;; C-xなどで自動で ASCII 入力
;; ;; (setq default-input-method nil) ;; disable leim or ns-xxx ???
;; (require 'myemp-aux)
;; ;; 必要なら `my-ime-title-alist' の設定
;; ;; (setq my-ime-title-alist '((インプットソースID名 . "あ")))
;; ;; isearch での状態表示を止める場合は次行をアンコメント
;; ;; (setq my-ime-isrch-title-displayp nil)
;; (my-ime-enable)
;; )
;;
;; my-ime-title-alist のデフォルト値は、Mojave + Kotoeri の環境に合わ
;; せてあり、多少の融通は利かせてあるが、もし、他の環境でうまく動作し
;; ない場合は、インプットソースID名を調べて、`my-ime-title-alist' を適
;; 切に設定する必要がある。
;;
;; インプットソースID名を調べる方法
;; M-x my--ime-toggle-checkId
;; ここで、キーボードから M-SPC などで、IME入力モードを適当に切り替えると、
;; その都度 *mylog* バッファーにID名が表示される。
;;
;; Note:
;; * カスタマイズ変数
;; + `my-ime-title-propaties'
;; + `my-ime-title-format'
;;
;; + `my-ime-minibuf-title-displayp'
;; + `my-ime-minibuf-title-format'
;; + `my-ime-minibuf-title-propaties'
;;
;; + `my-ime-isrch-title-displayp'
;;
;; * leim が有効な時は、モードラインに両方の ime のタイトルが出てや
;; やこしくなってしまう。
;;
(defvar myemp-version "0.8.1")
(defvar myemp-debugp nil "")
;; (setq myemp-debugp t) ;; for debugging
(defun myemp--log-function (fmt &rest args)
(with-current-buffer (get-buffer-create "*mylog*")
(let ((inhibit-read-only t)) ;; remove all read-only constraints
(goto-char (point-max))
(insert (if args (apply #'format `(,fmt ,@args)) fmt))
(insert "\n")
(goto-char (point-max))
(let ((win (get-buffer-window (current-buffer))))
(if win (set-window-point win (point)))) ;; For auto scroll
)
)
nil)
(defmacro myemp-log (fmt &rest args)
"Debugging macro to display messages in *mylog* if `myemp-debugp'
is true.
Arguments are in the same format as for `message' function"
(if myemp-debugp `(myemp--log-function ,fmt ,@args) nil))
(defun my--ime-toggle-checkId ()
"Test command to check input source ID of Mac"
(interactive)
(let* ((foo (lambda ()
(myemp--log-function "current id=%S" (mac-input-source))))
(stop (member foo mac-selected-keyboard-input-source-change-hook)) )
(funcall (if (member foo mac-selected-keyboard-input-source-change-hook)
#'remove-hook #'add-hook)
'mac-selected-keyboard-input-source-change-hook
foo)
(myemp--log-function "*** %s check input-source-id ***"
(if stop "Stop" "Start"))
(unless stop
(save-selected-window
(switch-to-buffer-other-window "*mylog*")))))
(defvar my-ime-title-alist nil
"input sourceとモードラインに表示する文字の対応を表す連想リスト。
モードラインへは、この値から、さらに `my-ime-title-format' や
`my-ime-title-propaties' を使って フォーマットしてから表示される。
初期値は macos-mojave + kotoeri 環境に合わせてある。但し、
( (`mac-input-source' t) を評価した値 . \"あ\")
も自動で加わるので、他の環境においても、このままである程度は使え
るかもしれない"
)
(setq my-ime-title-alist '(;; ("com.apple.inputmethod.Kotoeri.Japanese" . "あ")
("com.apple.inputmethod.Kotoeri.Japanese.FullWidthRoman" . "A")
("com.apple.inputmethod.Kotoeri.Japanese.Katakana" . "ア")
("com.apple.inputmethod.Kotoeri.Japanese.HalfWidthKana" . "ア")
))
(defvar my-ime-default-language-title "あ"
"When the input source name of (`mac-input-source' t) is not in
`my-ime-title-alist', specify the title of the input source.
Default values are for Japanese environment.
If nil, this operation itself is not performed.")
;; my-ime-title-alist へ (mac-input-source t) 評価値を追加
(when (and (fboundp 'mac-input-source) my-ime-default-language-title)
(let ((lang-source (mac-input-source t)))
(if (and lang-source
(not (assoc lang-source my-ime-title-alist)))
(progn
(myemp-log "Add %S to my-ime-title-alist" lang-source)
(add-to-list 'my-ime-title-alist
(cons lang-source my-ime-default-language-title))))))
(defvar-local my-ime-title nil "")
(put 'my-ime-title 'risky-local-variable t)
;; (myemp-log (propertize "あ " 'face '(:foreground "red" :slant italic)))
(defvar my-ime-title-propaties
'(face (:foreground "medium blue"))
"モードラインへ表示する input source タイトル文字列のプロパティーリスト。
カスタマイズ例:
(setq my-ime-title-propaties
\\='(face (:foreground \"misty rose\" :background \"RoyalBlue4\" :weight bold)))
")
(defvar my-ime-title-format "%s " "")
(defun my-ime-selected-function (&rest args)
(myemp-log "Selected ime in %S" (current-buffer)) ;; for-debug
(myemp-log " IME=%S ASCII=%S LANG=%S" ;; for-debug
(mac-input-source) (mac-input-source 'ascii-capable-keyboard)
(mac-input-source t))
(if (minibufferp (current-buffer))
;; in minibuffer
(progn
(myemp-log " minibuffer prompt=%S" (minibuffer-prompt))
(if my-ime-minibuf-title-displayp (my-ime-minibuf-settitle))
)
;; normal buffer with mode-line
(progn
;; check local variable `mode-line-mule-info' and `my-ime-title'
(unless (and (local-variable-p 'my-ime-title)
(local-variable-p 'mode-line-mule-info)
(memq 'my-ime-title mode-line-mule-info))
(make-local-variable 'mode-line-mule-info)
(make-local-variable 'my-ime-title)
(unless (memq 'my-ime-title mode-line-mule-info)
;; customize `mode-line-mule-info'
(myemp-log " Change mode-line-mule-info")
(setq-local mode-line-mule-info ;; -> setq better?
(append mode-line-mule-info '(my-ime-title)))
))
(let* ((ime-title (cdr (assoc (mac-input-source) my-ime-title-alist)))
(title (if ime-title (format my-ime-title-format ime-title) nil)) )
;; update mode-line
;; (if (minibufferp (current-buffer))
;; (myemp-log " minibuffer prompt=%S" (minibuffer-prompt)))
(if title (setq title (format my-ime-title-format title)))
(unless (equal title my-ime-title) ;; string's equal ignore properties
(myemp-log " Update mode-line from %S to %S" my-ime-title title)
(setq-local my-ime-title ;-> setq better?
(if title (apply #'propertize title my-ime-title-propaties)
nil))
(force-mode-line-update)
)
;; if isearch progressing, then display ime title to iserch minibuffer
(when (and my-ime-isrch-p (boundp 'isearch-message-prefix-add))
(my-ime-isrch-set-prefix ime-title t)
)
) ;; end of let
) ;; end of normal buffer
))
(defun my-ime-buffer-list-update-function ()
(myemp-log "top buffer=%S" (car (buffer-list)))
(my-ime-selected-function)
)
;; ***** minibuffer への IME title 表示 ***************
(defvar my-ime-minibuf-title-displayp t
"ミニバッファーにIMEタイトルを表示するかどうか")
(defvar my-ime-minibuf-ovly nil
"ミニバッファーにIMEタイトルを表示するためのオーバーレイ")
(defvar my-ime-minibuf-title-format "[%s] " "")
(defvar my-ime-minibuf-title-propaties nil
"minibuffer へ表示する input source タイトルのプロパティリスト
nil: may be applied `minibuffer-prompt-properties'
")
;; (setq my-ime-minibuf-title-propaties '(face (:foreground "red"))) ;; for-debug
;;Note: mbuf option is currently not used
(defun my-ime-minibuf-settitle ( &optional mbuf)
"必要ならば、minibuffer に ime title を表示させる"
;; check is mbuf nil or buffer
(if (or (null mbuf) (bufferp mbuf) (and (stringp mbuf) (get-buffer mbuf)))
(let ((title (cdr (assoc (mac-input-source) my-ime-title-alist))))
(myemp-log "my-ime-minibuf-settitle cbuf=%S title=%S" (current-buffer) title)
;; (myemp-log " overlay-list(before)=%S" (overlays-in (point-min) (point-max)))
;; (if mbuf (myemp-log " display isearch title - %S mb:%S cb:%S" ;; for debug
;; title mbuf (current-buffer)))
(if my-ime-minibuf-ovly
(progn ;; move overlay
(myemp-log " minibuf-ovly's ovbuffer(before move)=%S"
(overlay-buffer my-ime-minibuf-ovly))
(move-overlay my-ime-minibuf-ovly
;; (minibuffer-prompt-end) (minibuffer-prompt-end)
0 0 ;; 先頭に表示
;; buffer 設定について
;; nil だと再帰バッファーには適用されない
;; (current-buffer) だと再起バッファーに適用さ
;; れるが、再帰バッファーから帰ってきた時に、
;; 元のバッファーは overlay が見えなくなっている
mbuf
;; (or mbuf (current-buffer))
))
(progn ;; make overlay
(setq my-ime-minibuf-ovly
(make-overlay
;; (minibuffer-prompt-end) (minibuffer-prompt-end)
;; 0 0 ;; 先頭に表示
1 1 ;; 先頭に表示
mbuf nil nil))
(myemp-log " make new minibuf-ovly")
))
(myemp-log " minibuf-ovly's ovbuffer(after)=%S pos:%S"
(overlay-buffer my-ime-minibuf-ovly)
`(,(overlay-start my-ime-minibuf-ovly) ,(overlay-end my-ime-minibuf-ovly)))
(let ((ntitle (if title (format my-ime-minibuf-title-format title) nil))
(ctitle (overlay-get my-ime-minibuf-ovly 'before-string)))
(if (equal ctitle "") (setq ctitle nil))
(unless (equal ntitle ctitle)
(overlay-put my-ime-minibuf-ovly 'before-string
(if title
(apply #'propertize ntitle my-ime-minibuf-title-propaties)
nil))
(myemp-log " change ovl before-string %s->%s in %S (%s-%s)" ;; for-debug
ctitle ntitle (overlay-buffer my-ime-minibuf-ovly)
(overlay-start my-ime-minibuf-ovly)
(overlay-end my-ime-minibuf-ovly))
)
)
;; (myemp-log " overlay-list(after)=%S" (overlays-in (point-min) (point-max)))
)
;; when mbuf is not a buffer
(myemp-log "Warning: mbuf is not a buffer or null - %S" mbuf) ;; for debug
))
;; ***** isearch minibuffer への IME title 表示 ************
(defvar my-ime-isrch-title-displayp t
"isearch のエコーエリアにIMEタイトルを表示するかどうか")
(defvar my-ime-isrch-p nil "incremental search in progress?")
(defvar my-ime-isrch-title-prop '@myempd@ "")
(defun my-ime-isrch-newpfx (title &optional prefix)
"isearch-message-prefix-add に対して、古い ime title を TITLE
に置換した文字列を返す。
TITLE: 新しい ime タイトル
PREFIX: isearch-message-prefix-add の代わりに使う文字列(for-debugging)"
(let* ((prefix (or prefix isearch-message-prefix-add))
(title (if (and title (> (length title) 0))
(propertize title my-ime-isrch-title-prop t) nil)))
;; (myemp-log "title=%S" title)
(with-temp-buffer
(buffer-disable-undo)
(setq-local inhibit-read-only t) ;; no-need?
(goto-char (point-min)) ;; no need?
(if prefix (insert prefix))
(goto-char (point-min))
(cl-loop
for n from 0 below (length prefix)
do (if (get-text-property (point) my-ime-isrch-title-prop)
(delete-char 1)
(forward-char))
)
(myemp-log " pfx(before insert)=%s" (buffer-string))
(goto-char (point-min))
(if title (insert title))
(let ((s (buffer-string))) (if (> (length s) 0) s nil))
)
))
(defun my-ime-isrch-set-prefix (ime-title &optional show)
(when my-ime-isrch-title-displayp
(let ((title (if ime-title
(format my-ime-minibuf-title-format ime-title) nil)))
;; (if title (setq title (format "<%s>" title))) ;; for-debug
(myemp-log " new isrch prefix title is %S" title)
(setq isearch-message-prefix-add (my-ime-isrch-newpfx title))
(myemp-log " did set isearch prefix-add to %S" isearch-message-prefix-add)
(if show (isearch-update))
title
))
)
(defun my-ime-isrch-mode-function (when)
(myemp-log "%S isearch-mode-hook when" when)
(setq my-ime-isrch-p (eq when 'start))
(let ((title (if my-ime-isrch-p
(cdr (assoc (mac-input-source) my-ime-title-alist))
nil)))
(my-ime-isrch-set-prefix title nil)
))
;; (my-ime-minibuf-top)
(defun my-ime-minibuf-top (&optional buflst) ;; Not now in use.
(setq buflst (or buflst (buffer-list)))
(cond ((null buflst) nil)
((minibufferp (car buflst)) (car buflst))
(t (my-ime-minibuf-top (cdr buflst)))))
;; ******* enable and disable function *******************
(defun my-ime-enable ()
;; Disable feature
(my-ime-disable)
"Enable the feature to display the IME title in the mode line"
;; add hook `mac-selected-keyboard-input-source-change-hook'
(add-hook 'mac-selected-keyboard-input-source-change-hook
#'my-ime-selected-function)
;; add hook 'buffer-list-update-hook
(add-hook 'buffer-list-update-hook
#'my-ime-buffer-list-update-function)
;; add hook `isearch-mode-hook' for iserch
(when (boundp 'isearch-message-prefix-add)
(add-hook 'isearch-mode-hook
(lambda () (my-ime-isrch-mode-function 'start)))
(add-hook 'isearch-mode-end-hook
(lambda () (my-ime-isrch-mode-function 'end)))
)
(myemp-log "mac-selected-keyboard-input-source-change-hook=\n %S"
mac-selected-keyboard-input-source-change-hook)
(myemp-log "buffer-list-update-hook=%S" buffer-list-update-hook)
(myemp-log "isearch-mode-hook=%S" isearch-mode-hook)
(myemp-log "isearch-mode-end-hook=%S" isearch-mode-end-hook)
(myemp-log "my-ime was enabled")
)
(defun my-ime-disable ()
"Disable the feature to display the IME title in the mode line"
;; remove hook `mac-selected-keyboard-input-source-change-hook'
(remove-hook 'mac-selected-keyboard-input-source-change-hook
#'my-ime-selected-function)
;; remove hook 'buffer-list-update-hook
(remove-hook 'buffer-list-update-hook
#'my-ime-buffer-list-update-function)
;; remove hook `isearch-mode-hook' for iserch
(remove-hook 'isearch-mode-hook
(lambda () (my-ime-isrch-mode-function 'start)))
(remove-hook 'isearch-mode-end-hook
(lambda () (my-ime-isrch-mode-function 'end)))
(myemp-log "mac-selected-keyboard-input-source-change-hook=\n %S"
mac-selected-keyboard-input-source-change-hook)
(myemp-log "buffer-list-update-hook=%S" buffer-list-update-hook)
(myemp-log "isearch-mode-hook=%S" isearch-mode-hook)
(myemp-log "isearch-mode-end-hook=%S" isearch-mode-end-hook)
(myemp-log "my-ime was disabled")
)
;; Enable feature
;; (if (fboundp 'mac-input-source) (my-ime-enable))
(provide 'myemp-aux)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment