Last active
December 28, 2023 19:10
-
-
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)
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;;; -*- 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