source: tf-mode/trunk/tf-mode.el@ 26

Last change on this file since 26 was 9, checked in by ertl-ishikawa, 14 years ago

WORNINGとERRORのEND対応がとれていないバグを修正．
File size: 10.5 KB
Line 
1;;
2;; TOPPERS Software
3;; Toyohashi Open Platform for Embedded Real-Time Systems
4;;
5;; Copyright (C) 2010 by TAKUYA
6;; Embedded and Real-Time Systems Laboratory
7;; Graduate School of Information Science, Nagoya Univ., JAPAN
8;;
9;; 上記著作権者は，以下の(1)〜(4)の条件を満たす場合に限り，本ソフトウェ
10;; ア（本ソフトウェアを改変したものを含む．以下同じ）を使用・複製・改
11;; 変・再配布（以下，利用と呼ぶ）することを無償で許諾する．
12;; (1) 本ソフトウェアをソースコードの形で利用する場合には，上記の著作
13;; 権表示，この利用条件および下記の無保証規定が，そのままの形でソー
14;; スコード中に含まれていること．
15;; (2) 本ソフトウェアを，ライブラリ形式など，他のソフトウェア開発に使
16;; 用できる形で再配布する場合には，再配布に伴うドキュメント（利用
17;; 者マニュアルなど）に，上記の著作権表示，この利用条件および下記
18;; の無保証規定を掲載すること．
19;; (3) 本ソフトウェアを，機器に組み込むなど，他のソフトウェア開発に使
20;; 用できない形で再配布する場合には，次のいずれかの条件を満たすこ
21;; と．
22;; (a) 再配布に伴うドキュメント（利用者マニュアルなど）に，上記の著
23;; 作権表示，この利用条件および下記の無保証規定を掲載すること．
24;; (b) 再配布の形態を，別に定める方法によって，TOPPERSプロジェクトに
25;; 報告すること．
26;; (4) 本ソフトウェアの利用により直接的または間接的に生じるいかなる損
27;; 害からも，上記著作権者およびTOPPERSプロジェクトを免責すること．
28;; また，本ソフトウェアのユーザまたはエンドユーザからのいかなる理
29;; 由に基づく請求からも，上記著作権者およびTOPPERSプロジェクトを
30;; 免責すること．
31;;
32;; 本ソフトウェアは，無保証で提供されているものである．上記著作権者お
33;; よびTOPPERSプロジェクトは，本ソフトウェアに関して，特定の使用目的
34;; に対する適合性も含めて，いかなる保証も行わない．また，本ソフトウェ
35;; アの利用により直接的または間接的に生じたいかなる損害に関しても，そ
36;; の責任を負わない．
37;;
38;;
39;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
40;;
41;; tf-mode for emacs
42;;
43;;
44;; ロード方法．
45;; 下記を .emacs に追加する．
46;;
47;; (setq load-path (append '("ファイルの置き場所") load-path))
48;; (autoload 'tf-mode "tf-mode" nil t)
49;; (add-hook 'tf-mode-hook '(lambda () (font-lock-mode 1)))
50;; (setq auto-mode-alist (append '(
51;; ("\\.tf$" . tf-mode)) auto-mode-alist))
52;;
53
54;;
55;; 構文テーブル
56;;
57
58(defvar tf-mode-syntax-table nil
59 "Syntax table in use in TF-mode buffers.")
60
61(if tf-mode-syntax-table
62 ()
63 (setq tf-mode-syntax-table (make-syntax-table)))
64
65;;
66;; キーワードの強調表示
67;;
68
69(defvar tf-font-lock-defaults
70 (list 'tf-font-lock-keywords
71 t
72 nil
73 nil
74 'beginning-of-line
75 ))
76
77(defconst tf-font-lock-keywords
78 (list
79 ;; コメント
80 '("^\$[ \t].*"
81 . font-lock-comment-face)
82 ;; 制御構造
83 '("\\([\$]\\)\\(IF\\|FOREACH\\|JOINEACH\\)\\([ \t]\\)"
84 . (2 font-lock-keyword-face))
85 '("\\([\$]\\)\\(END\\|ELSE\\)\\([\$]\\)"
86 . (2 font-lock-keyword-face))
87 '("\\([\$]\\)\\(FUNCTION\\|FILE\\|INCLUDE\\)\\([ \t]\\)"
88 . (2 font-lock-builtin-face))
89 '("\\([\$]\\)\\(ERROR\\|WORNING\\)\\([ \t\$]\\)"
90 . (2 font-lock-warning-face))
91 '("\\([\$]\\)\\(SPC\\|TAB\\|NL\\|ARGC\\|ARGV\\|RESULT\\)\\([\$]\\)"
92 . (2 font-lock-string-face))
93 '("\\([\"]\\)\\([^\"]\\)*\\([\"]\\)"
94 . font-lock-string-face)
95 '("\\([\']\\)\\([^\']\\)*\\([\']\\)"
96 . font-lock-string-face)
97 '("\\([ \t!@\$~\+\*^\(=,<>%|-]\\)\\(LENGTH\\|EQ\\|ALT\\|SORT\\|ENVIRON\\|VALUE\\|CONCAT\\|APPEND\\|AT\\|_\\|FORMAT\\|FIND\\|RANGE\\|SYMBOL\\|PEEK\\|DUMP\\|TRACE\\|NOOP\\|BCOPY\\|ESCSTR\\|UNESCSTR\\|CALL\\|LSORT\\)\\([\(]\\)"
98 . (2 font-lock-function-name-face))
99 ))
100
101;;
102;; tfモード特有のキーバインド
103;;
104
105(defvar tf-mode-map
106 (let ((tf-keymap (make-keymap)))
107 ;; タブを押すとtestが呼ばれる。
108 (define-key tf-keymap "\t" 'tf-indent-line)
109 tf-keymap))
110
111
112;;------------------------
113;;
114;; インデントに関する定義
115;;
116;;------------------------
117
118(defvar *tf-tab-always-indent* t)
119
120(defvar *tf-block-beg-re*
121 "[\$]\\(\\(IF\\|FOREACH\\|JOINEACH\\|FUNCTION\\|ERROR\\|WORNING\\)[ ]\\|\\(ERROR\\|WORNING\\)[\$]\\)")
122(defvar *tf-block-mid-re*
123 "\$ELSE[\$]")
124(defvar *tf-block-end-re* "\$END[\$]")
125
126(defvar *tf-indent-column* 4)
127
128(defun tf-space-line ()
129 "空行かどうか"
130 (save-excursion
131 (beginning-of-line) ; (goto-bol)
132 (looking-at "\\([ \t]*$\\|^\$[ \t]\\)")))
133
134(defun tf-previous-line ()
135 "空行じゃない行まで戻る"
136 (catch 'tf-previous-line-loop
137 (while (= (forward-line -1) 0)
138 (unless (tf-space-line)
139 (throw 'tf-previous-line-loop t)))))
140
141(defun calc-tf-indent ()
142 "インデントする数を数える"
143 (let ((column 0) (curp (point)))
144 (save-excursion
145 ;前の行を調べる
146 (when (tf-previous-line)
147 (beginning-of-line) ;(goto-bol)
148 (skip-chars-forward " \t")
149 ; インデント数
150 (setq column (current-column))
151 ;(message-box (format nil "column1: ~D" column))
152 (save-restriction
153 (narrow-to-region (progn (end-of-line) (point)) ;(goto-eol) (point))
154 (progn (beginning-of-line) (point))) ;(goto-bol) (point)))
155 (beginning-of-line)
156 (skip-chars-forward " \t")
157 ; 開きものがあればインデント数を増やす
158 (cond
159 ((looking-at *tf-block-beg-re*)
160 (setq column (+ column *tf-indent-column*)))
161 ((looking-at *tf-block-mid-re*)
162 (setq column (+ column *tf-indent-column*)))
163 )
164 )))
165 ;(message-box (format nil "column2: ~D" column))
166 ; 現在の行を調べる
167 (save-excursion
168 (save-restriction
169 (narrow-to-region (progn (end-of-line) (point)) ;(goto-eol) (point))
170 (progn (beginning-of-line) (point))) ;(goto-bol) (point)))
171 (beginning-of-line) ; (goto-bol)
172 (skip-chars-forward " \t")
173 ; 閉じものがあればインデント数を減らす
174 (cond
175 ((looking-at *tf-block-end-re*)
176 (setq column (- column *tf-indent-column*)))
177 ((looking-at *tf-block-mid-re*)
178 (setq column (- column *tf-indent-column*)))
179 )))
180 column
181 ))
182
183(defun tf-not-comment-line ()
184 (save-excursion
185 (progn
186 (beginning-of-line)
187 (if (looking-at "^\$[ \t]")
188 nil
189 t
190 )
191 )
192 ))
193
194(defun tf-indent-line ()
195 (interactive "*")
196 (if (or (not (interactive-p))
197 *tf-tab-always-indent*
198 (save-excursion
199 (skip-chars-backward " \t")
200 (bolp)))
201 (if (tf-not-comment-line) ;; コメント行でなければ実行する
202 ; ここを変えただけ
203 (let ((column (calc-tf-indent)))
204 (when (integerp column)
205 (save-excursion
206 (beginning-of-line) ;(goto-bol)
207 (delete-region (point)
208 (progn
209 (skip-chars-forward " \t")
210 (point)))
211 (indent-to column)))
212 (if (and (bolp) column)
213 (skip-chars-forward " \t")))
214 )
215 (insert "\t"))
216 t)
217
218;;
219;; tfモードメイン関数
220;;
221
222(defun tf-mode ()
223 ""
224 (interactive)
225 (kill-all-local-variables)
226 (set-syntax-table tf-mode-syntax-table)
227 (setq case-fold-search nil)
228 (use-local-map tf-mode-map)
229 (setq mode-name "tf")
230 (make-local-variable 'font-lock-defaults)
231 (setq font-lock-defaults tf-font-lock-defaults)
232 (set (make-local-variable 'indent-line-function) 'tf-indent-line)
233 (run-hooks 'tf-mode-hook))
234
235;; -------------------
236;;
237;; $END$の対応を探す
238;;
239;; -------------------
240
241;; 対応を探すための正規表現
242(defvar *tf-block-keyword* "[\$]\\(IF[ \t]\\|FOREACH[ \t]\\|JOINEACH[ \t]\\|FUNCTION[ \t]\\|END[\$]\\|ERROR[ \$]\\|WORNING[ \$]\\)")
243(defvar *tf-block-tag* 'tf-block)
244
245(defvar tf-block-highlight-face 'highlight)
246
247(defvar tf-block-highlight-overlay nil)
248
249(defun tf-block-get-line-start-pos ()
250 (save-excursion
251 (let ((xor '(lambda (a b) (and (or a b) (not (and a b)))))
252 (point (point))
253 (count 0))
254 (while (and (not (funcall xor (bobp) (eolp)))
255 (> point (point-min)))
256 (setq point (1- point))
257 (goto-char (1- (point))))
258 ;; delete linefeed of start point.
259 (when (and (eolp) (>= (point-max) (1+ point)))
260 (setq point (1+ point)))
261 point)))
262
263(defun tf-block-get-line-end-pos ()
264 (save-excursion
265 (let ((xor '(lambda (a b) (and (or a b) (not (and a b)))))
266 (point (point)))
267 (while (and (not (funcall xor (eobp) (eolp)))
268 (>= (point-max) point))
269 (setq point (1+ point))
270 (goto-char (1+ (point))))
271 point)))
272
273;; ハイライトを元に戻す
274(defun tf-block-highlight-done ()
275 (remove-hook 'pre-command-hook 'tf-block-highlight-done)
276 (if tf-block-highlight-overlay
277 (delete-overlay tf-block-highlight-overlay)))
278
279;; ハイライト（オーバレイ）
280(defun tf-block-do-highlight (start end)
281 (if tf-block-highlight-overlay
282 (move-overlay tf-block-highlight-overlay start end)
283 (setq tf-block-highlight-overlay (make-overlay start end)))
284 (overlay-put tf-block-highlight-overlay
285 'face tf-block-highlight-face)
286 (add-hook 'pre-command-hook 'tf-block-highlight-done))
287
288(defun tf-block-hook ()
289 (progn
290 (if (string-match "tf" mode-name) ;; tf-modeのときだけ
291 (let (now)
292 (save-excursion
293 (progn
294 (setq now (point))
295 (if (string-match "\$END\$" (buffer-substring (- now 5) (- now 1))) ;; $END$の後ろにカーソル
296 (progn
297 (goto-char now)
298 (do-tf-block) ;; 本体呼び出し
299 )
300 )
301 )
302 )
303 )
304 )
305 )
306 )
307
308(defun do-tf-block ()
309 (let (from to end_depth line_no line_string tmp_string now)
310 (save-excursion
311 (setq from (point))
312 (backward-char 1)
313 (if t ;(re-search-backward *tf-block-keyword*) ;(scan-buffer *tf-block-keyword* :reverse t :regexp t)
314 (progn
315 (setq end_depth 1) ;; $END$の深さ
316 (while (> end_depth 0) ;; $END$の対応が見つかるまで
317 (progn
318 (if (re-search-backward *tf-block-keyword* nil t);(scan-buffer *tf-block-keyword* :reverse t :regexp t :no-dup t)
319 (progn
320 (setq tmp_string (match-string 0))
321 (setq now (point))
322 (beginning-of-line)
323 (if (not (string-match "^$[ \t]" (buffer-substring (point) (+ (point) 2)))) ;; コメントアウト中かチェック
324 (progn
325 (goto-char now)
326 (if (string-match "[\$]END[\$]" tmp_string) ;; $END$が見つかった
327 (setq end_depth (+ end_depth 1)) ;; 深さ+1
328 (progn ;; $END$以外が見つかった
329 (setq end_depth (- end_depth 1)) ;; 深さ-1
330 ))
331 )
332 )
333 )
334 (setq end_depth -1) ;; $END$の対応がない
335 )))
336 (if (= end_depth 0) ;; $END$の対応があった
337 (progn
338 (let ((slinep 0) (elinep 0))
339 (save-excursion
340 (setq slinep (tf-block-get-line-start-pos)
341 elinep (tf-block-get-line-end-pos)))
342 ;; display line contents to minibuffer
343 (message "%d: %s" (1+ (count-lines (point-min) slinep))
344 (buffer-substring slinep elinep))
345 ;; do overlay.
346 (tf-block-do-highlight slinep elinep))
347 )
348 (message "ないかもだよ") ;; $END$の対応がなかった
349 )
350 )
351 )
352 )
353 )
354 )
355
356
357(add-hook 'post-command-hook 'tf-block-hook) ;; post-command-hookに追加
Note: See TracBrowser for help on using the repository browser.