-
Notifications
You must be signed in to change notification settings - Fork 0
/
pdic.l
180 lines (163 loc) · 6.05 KB
/
pdic.l
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
;; pdic.l
;;
;; 履歴
;; 03.05.18 メニューに関する不具合を修正
;; 03.05.17 初版
;; 使い方 .xyzzy に以下を追加
;;(load-library "pdic.l")
; PDICの場所
(defvar *pdic-path* "C:/Program Files/Personal Dictionary (Unicode)/PDICU.EXE")
; 単語帳バッファの名前
(defvar *pdic-wordbook* "*PDIC Wordbook*")
; ポップアップ表示をするか否か
(defvar *pdic-output-popup-p* t)
; 辞書を引く単語を取ってくる
(defun pdic-get-current-words-or-selection ()
(if (pre-selection-p)
(buffer-substring (selection-point) (selection-mark))
(save-excursion
(buffer-substring
(progn
(skip-chars-forward "A-Za-z")
(skip-chars-backward "A-Za-z")
(point))
(progn
(goto-eol)
(point))))))
(defun pdic-get-current-words ()
(save-excursion
(buffer-substring
(progn
(skip-chars-forward "A-Za-z")
(skip-chars-backward "A-Za-z")
(point))
(progn
(goto-eol)
(point)))))
; PDICとDDE通信でやりとり
(defun pdic-dde-comunicate (words)
(setq chan (dde-initiate "PDICU" "Dictionary"))
(when chan
(dde-poke chan "Open" "")
(dde-poke chan "PopupSearchConfig" "w2")
(dde-poke chan "PopupSearch" words)
(setq answer (dde-request chan "PopupSearch"))
(if (string-equal answer "")
(progn
(dde-poke chan "Close" "")
(dde-terminate chan)
(popup-string "見つかりません。" (point))
(return-from pdic-dde-comunicate nil)))
(dde-poke chan "Format" "$w@@$j@@$x")
(dde-poke chan "Config" "t3")
(dde-poke chan "Find" answer)
(setq answer (substitute-string (substitute-string (dde-request chan "Find") "
" "") "@@" "\n"))
(dde-poke chan "Close" "")
(dde-terminate chan)
(return-from pdic-dde-comunicate answer))
(message "DDEセッションの初期化に失敗しました。")
(return-from pdic-dde-comunicate nil))
; PDICで辞書を引く
(defun pdic-consult-dictionary ()
(interactive)
(continue-pre-selection)
(setq words (pdic-get-current-words-or-selection))
(setq answer (pdic-dde-comunicate words))
; エラーだったら何もせずにリターン
(unless answer (return-from pdic-consult-dictionary nil))
; 結果表示
(if *pdic-output-popup-p*
(popup-string answer (point))
(with-output-to-temp-buffer ("*PDIC output*")
(format t "~A" answer))))
; PDICで辞書を引いて、単語帳に追加する
(defun pdic-add-words ()
(interactive)
(continue-pre-selection)
(setq words (pdic-get-current-words-or-selection))
(setq answer (pdic-dde-comunicate words))
; エラーだったら何もせずにリターン
(unless answer (return-from pdic-add-words nil))
; 結果表示
(if *pdic-output-popup-p*
(popup-string answer (point))
(with-output-to-temp-buffer ("*PDIC output*")
(format t "~A" answer)))
; 単語帳に追加
(setq buffer (get-buffer-create *pdic-wordbook*))
(save-excursion
(set-buffer buffer)
(goto-char (point-max))
(insert answer)))
; 辞書引きモード（PDIC版）
(defvar-local pdic-mode nil)
(defvar *pdic-mode-map*
(let ((keymap (make-sparse-keymap)))
(define-key keymap #\MouseMove 'pdic-mouse-lookup)
(define-key keymap #\C-MouseMove 'pdic-mouse-lookup-conjugation)
keymap))
(defvar *pdic-last-range-begin* nil)
(defvar *pdic-last-range-end* nil)
(defun pdic-mode (&optional (arg nil sv))
(interactive "p")
(ed::toggle-mode 'pdic-mode arg sv)
(if pdic-mode
(set-minor-mode-map *pdic-mode-map*)
(unset-minor-mode-map *pdic-mode-map*))
(setq *pdic-last-range-begin* nil)
(update-mode-line t))
(defun pdic-mouse-lookup (&optional conjugation)
(interactive)
(continue-pre-selection)
(when pdic-mode
(with-selected-window
(set-window *last-mouse-window*)
(save-excursion
(goto-last-mouse-point)
(cond ((eolp)
(setq *pdic-last-range-begin* nil)
(return-from pdic-mouse-lookup nil))
((and *pdic-last-range-begin*
(<= *pdic-last-range-begin* (point))
(< (point) *pdic-last-range-end*))
(continue-popup)
(return-from pdic-mouse-lookup t))
(t
(save-excursion
(skip-chars-forward "A-Za-z") (setq *pdic-last-range-end* (point))
(skip-chars-backward "A-Za-z") (setq *pdic-last-range-begin* (point)))
(setq answer (pdic-dde-comunicate (pdic-get-current-words)))
(unless answer (return-from pdic-mouse-lookup nil))
(popup-string answer (point))))))))
(pushnew '(pdic-mode . "Pdic") *minor-mode-alist* :key #'car)
;================================
; メニュー や キーバインドの設定
;================================
; ツールバーやポップアップメニューの辞書を引くコマンドの差し替え
; 位置(=21とか8)については、自分で調整してください。
; デフォルトのままであれば、「21(あるいは8)」で OK のはず。
(add-hook '*post-startup-hook*
#'(lambda ()
(let ((tools (get-menu *app-menu* 'ed::tools)))
; もともとの辞書を引くコマンドを消して
(delete-menu tools 21 t)
(delete-menu *app-popup-menu* 8 t)
; かわりに、PDIC で辞書を引くコマンドの追加
(setq *dictionary-popup-menu*
(define-popup-menu
(:item nil "辞書引き(&E)"
'pdic-consult-dictionary)
(:item nil "辞書引き＋単語帳追加(&R)"
'pdic-add-words)
:sep
(:item nil "辞書引きモード(&J)"
'pdic-mode
#'(lambda () (if pdic-mode :check)))))
(insert-popup-menu tools 21 *dictionary-popup-menu* "辞書(&I)")
(insert-popup-menu *app-popup-menu* 8 *dictionary-popup-menu* " 辞書(&I)"))))
; キーバインドの設定
; 元の辞書引きコマンドを上書きします。
(define-key spec-map #\e 'pdic-consult-dictionary)
(define-key spec-map #\r 'pdic-add-words)
(define-key spec-map #\j 'pdic-mode)