;;
;;  TOPPERS Software
;;      Toyohashi Open Platform for Embedded Real-Time Systems
;; 
;;  Copyright (C) 2010 by TAKUYA
;;              Embedded and Real-Time Systems Laboratory
;;              Graduate School of Information Science, Nagoya Univ., JAPAN
;; 
;;  上記著作権者は，以下の(1)〜(4)の条件を満たす場合に限り，本ソフトウェ
;;  ア（本ソフトウェアを改変したものを含む．以下同じ）を使用・複製・改
;;  変・再配布（以下，利用と呼ぶ）することを無償で許諾する．
;;  (1) 本ソフトウェアをソースコードの形で利用する場合には，上記の著作
;;      権表示，この利用条件および下記の無保証規定が，そのままの形でソー
;;      スコード中に含まれていること．
;;  (2) 本ソフトウェアを，ライブラリ形式など，他のソフトウェア開発に使
;;      用できる形で再配布する場合には，再配布に伴うドキュメント（利用
;;      者マニュアルなど）に，上記の著作権表示，この利用条件および下記
;;      の無保証規定を掲載すること．
;;  (3) 本ソフトウェアを，機器に組み込むなど，他のソフトウェア開発に使
;;      用できない形で再配布する場合には，次のいずれかの条件を満たすこ
;;      と．
;;    (a) 再配布に伴うドキュメント（利用者マニュアルなど）に，上記の著
;;        作権表示，この利用条件および下記の無保証規定を掲載すること．
;;    (b) 再配布の形態を，別に定める方法によって，TOPPERSプロジェクトに
;;        報告すること．
;;  (4) 本ソフトウェアの利用により直接的または間接的に生じるいかなる損
;;      害からも，上記著作権者およびTOPPERSプロジェクトを免責すること．
;;      また，本ソフトウェアのユーザまたはエンドユーザからのいかなる理
;;      由に基づく請求からも，上記著作権者およびTOPPERSプロジェクトを
;;      免責すること．
;; 
;;  本ソフトウェアは，無保証で提供されているものである．上記著作権者お
;;  よびTOPPERSプロジェクトは，本ソフトウェアに関して，特定の使用目的
;;  に対する適合性も含めて，いかなる保証も行わない．また，本ソフトウェ
;;  アの利用により直接的または間接的に生じたいかなる損害に関しても，そ
;;  の責任を負わない．
;; 
;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  tf-mode for emacs
;;
;; 
;;  ロード方法．
;;  下記を .emacs に追加する．
;;  
;;  (setq load-path (append '("ファイルの置き場所") load-path))
;;  (autoload 'tf-mode "tf-mode" nil t)
;;  (add-hook 'tf-mode-hook '(lambda () (font-lock-mode 1)))
;;  (setq auto-mode-alist (append '(
;;		("\\.tf$" . tf-mode)) auto-mode-alist))
;; 

;; 
;; 構文テーブル
;;

(defvar tf-mode-syntax-table nil
  "Syntax table in use in TF-mode buffers.")

(if tf-mode-syntax-table
    ()
  (setq tf-mode-syntax-table (make-syntax-table)))

;;
;; キーワードの強調表示
;; 

(defvar tf-font-lock-defaults 
  (list 'tf-font-lock-keywords
	t
	nil
	nil
	'beginning-of-line
	))

(defconst tf-font-lock-keywords
  (list
   ;; コメント
   '("^\$[ \t].*"
     . font-lock-comment-face)
   ;; 制御構造
   '("\\([\$]\\)\\(IF\\|FOREACH\\|JOINEACH\\)\\([ \t]\\)" 
     . (2 font-lock-keyword-face))
   '("\\([\$]\\)\\(END\\|ELSE\\)\\([\$]\\)"
     . (2 font-lock-keyword-face))
   '("\\([\$]\\)\\(FUNCTION\\|FILE\\|INCLUDE\\)\\([ \t]\\)"
     . (2 font-lock-builtin-face))
   '("\\([\$]\\)\\(ERROR\\|WORNING\\)\\([ \t\$]\\)"
     . (2 font-lock-warning-face))
   '("\\([\$]\\)\\(SPC\\|TAB\\|NL\\|ARGC\\|ARGV\\|RESULT\\)\\([\$]\\)"
     . (2 font-lock-string-face))
   '("\\([\"]\\)\\([^\"]\\)*\\([\"]\\)"
     . font-lock-string-face)
   '("\\([\']\\)\\([^\']\\)*\\([\']\\)"
     . font-lock-string-face)
   '("\\([ \t!@\$~\+\*^\(=,<>%|-]\\)\\(LENGTH\\|EQ\\|ALT\\|SORT\\|ENVIRON\\|VALUE\\|CONCAT\\|APPEND\\|AT\\|_\\|FORMAT\\|FIND\\|RANGE\\|SYMBOL\\|PEEK\\|DUMP\\|TRACE\\|NOOP\\|BCOPY\\|ESCSTR\\|UNESCSTR\\|CALL\\|LSORT\\)\\([\(]\\)"
     . (2 font-lock-function-name-face))
   ))

;;
;; tfモード特有のキーバインド
;;

(defvar tf-mode-map
  (let ((tf-keymap (make-keymap)))
    ;; タブを押すとtestが呼ばれる。
    (define-key tf-keymap "\t"  'tf-indent-line)
    tf-keymap))


;;------------------------
;;
;;  インデントに関する定義
;;
;;------------------------

(defvar *tf-tab-always-indent* t)

(defvar *tf-block-beg-re*
  "[\$]\\(\\(IF\\|FOREACH\\|JOINEACH\\|FUNCTION\\|ERROR\\|WORNING\\)[ ]\\|\\(ERROR\\|WORNING\\)[\$]\\)")
(defvar *tf-block-mid-re*
  "\$ELSE[\$]")
(defvar *tf-block-end-re* "\$END[\$]")

(defvar *tf-indent-column* 4)

(defun tf-space-line ()
  "空行かどうか"
  (save-excursion
    (beginning-of-line) ; (goto-bol)
    (looking-at "\\([ \t]*$\\|^\$[ \t]\\)")))

(defun tf-previous-line ()
  "空行じゃない行まで戻る"
  (catch 'tf-previous-line-loop
    (while (= (forward-line -1) 0)
      (unless (tf-space-line)
	(throw 'tf-previous-line-loop t)))))

(defun calc-tf-indent ()
  "インデントする数を数える"
  (let ((column 0) (curp (point)))
    (save-excursion
      ;前の行を調べる
      (when (tf-previous-line)
	(beginning-of-line) ;(goto-bol)
	(skip-chars-forward " \t")
	; インデント数
	(setq column (current-column))
	;(message-box (format nil "column1: ~D" column))
	(save-restriction
	  (narrow-to-region (progn (end-of-line) (point)) ;(goto-eol) (point))
			    (progn (beginning-of-line) (point))) ;(goto-bol) (point)))
	  (beginning-of-line)
	  (skip-chars-forward " \t")
	  ; 開きものがあればインデント数を増やす
	  (cond
	   ((looking-at *tf-block-beg-re*)
	    (setq column (+ column *tf-indent-column*)))
	   ((looking-at *tf-block-mid-re*)
	    (setq column (+ column *tf-indent-column*)))
	  )
	)))
    ;(message-box (format nil "column2: ~D" column))
    ; 現在の行を調べる
    (save-excursion
      (save-restriction
	(narrow-to-region (progn (end-of-line) (point)) ;(goto-eol) (point))
			  (progn (beginning-of-line) (point))) ;(goto-bol) (point)))
	(beginning-of-line) ; (goto-bol)
	(skip-chars-forward " \t")
	; 閉じものがあればインデント数を減らす
	(cond
	 ((looking-at *tf-block-end-re*)
	  (setq column (- column *tf-indent-column*)))
	 ((looking-at *tf-block-mid-re*)
	  (setq column (- column *tf-indent-column*)))
	)))
    column
  ))

(defun tf-not-comment-line ()
  (save-excursion
    (progn
      (beginning-of-line)
      (if (looking-at "^\$[ \t]")
	  nil
	  t
	  )
      )
    ))

(defun tf-indent-line ()
  (interactive "*")
  (if (or (not (interactive-p))
	  *tf-tab-always-indent*
	  (save-excursion
	    (skip-chars-backward " \t")
	    (bolp)))
    (if (tf-not-comment-line) ;; コメント行でなければ実行する
      ; ここを変えただけ
      (let ((column (calc-tf-indent)))
	(when (integerp column)
	  (save-excursion
	    (beginning-of-line) ;(goto-bol)
	    (delete-region (point)
			   (progn
			     (skip-chars-forward " \t")
			     (point)))
	    (indent-to column)))
	(if (and (bolp) column)
	    (skip-chars-forward " \t")))
	 )
    (insert "\t"))
  t)

;;
;; tfモードメイン関数
;;

(defun tf-mode ()
  ""
  (interactive)
  (kill-all-local-variables)
  (set-syntax-table tf-mode-syntax-table)
  (setq case-fold-search nil)
  (use-local-map tf-mode-map)
  (setq mode-name "tf")
  (make-local-variable 'font-lock-defaults)
  (setq font-lock-defaults tf-font-lock-defaults)
  (set (make-local-variable 'indent-line-function) 'tf-indent-line)
  (run-hooks 'tf-mode-hook))

;; -------------------
;;
;;  $END$の対応を探す
;;
;; -------------------

;; 対応を探すための正規表現
(defvar *tf-block-keyword* "[\$]\\(IF[ \t]\\|FOREACH[ \t]\\|JOINEACH[ \t]\\|FUNCTION[ \t]\\|END[\$]\\|ERROR[ \$]\\|WORNING[ \$]\\)")
(defvar *tf-block-tag* 'tf-block)

(defvar tf-block-highlight-face 'highlight)

(defvar tf-block-highlight-overlay nil)

(defun tf-block-get-line-start-pos ()
  (save-excursion
    (let ((xor '(lambda (a b) (and (or a b) (not (and a b)))))
          (point (point))
          (count 0))
      (while (and (not (funcall xor (bobp) (eolp)))
                  (> point (point-min)))
        (setq point (1- point))
        (goto-char (1- (point))))
      ;; delete linefeed of start point.
      (when (and (eolp) (>= (point-max) (1+ point)))
        (setq point (1+ point)))
      point)))

(defun tf-block-get-line-end-pos ()
  (save-excursion
    (let ((xor '(lambda (a b) (and (or a b) (not (and a b)))))
          (point (point)))
      (while (and (not (funcall xor (eobp) (eolp)))
                  (>= (point-max) point))
        (setq point (1+ point))
        (goto-char (1+ (point))))
      point)))

;; ハイライトを元に戻す
(defun tf-block-highlight-done ()
  (remove-hook 'pre-command-hook 'tf-block-highlight-done)
  (if tf-block-highlight-overlay
      (delete-overlay tf-block-highlight-overlay)))

;; ハイライト（オーバレイ）
(defun tf-block-do-highlight (start end)
  (if tf-block-highlight-overlay
      (move-overlay tf-block-highlight-overlay start end)
    (setq tf-block-highlight-overlay (make-overlay start end)))
  (overlay-put tf-block-highlight-overlay
	       'face tf-block-highlight-face)
  (add-hook 'pre-command-hook 'tf-block-highlight-done))

(defun tf-block-hook ()
  (progn
    (if (string-match "tf" mode-name) ;; tf-modeのときだけ
	(let (now)
	  (save-excursion
	    (progn
	      (setq now (point))
	      (if (string-match "\$END\$" (buffer-substring (- now 5) (- now 1))) ;; $END$の後ろにカーソル
		  (progn
		    (goto-char now)
		    (do-tf-block) ;; 本体呼び出し
		    )
		)
	      )
	    )
	  )
      )
    )
  )

(defun do-tf-block ()
  (let (from to end_depth line_no line_string tmp_string now)
    (save-excursion
      (setq from (point))
      (backward-char 1)
      (if t ;(re-search-backward *tf-block-keyword*) ;(scan-buffer *tf-block-keyword* :reverse t :regexp t)
	  (progn
	    (setq end_depth 1) ;; $END$の深さ
	    (while (> end_depth 0) ;; $END$の対応が見つかるまで
	      (progn
		(if (re-search-backward *tf-block-keyword* nil t);(scan-buffer *tf-block-keyword* :reverse t :regexp t :no-dup t)
		    (progn
		      (setq tmp_string (match-string 0))
		      (setq now (point))
		      (beginning-of-line)
		      (if (not (string-match "^$[ \t]" (buffer-substring (point) (+ (point) 2)))) ;; コメントアウト中かチェック
			  (progn
			    (goto-char now)
			    (if (string-match "[\$]END[\$]" tmp_string) ;; $END$が見つかった
				 (setq end_depth (+ end_depth 1)) ;; 深さ+1
			      (progn ;; $END$以外が見つかった
			  	 (setq end_depth (- end_depth 1)) ;; 深さ-1
				  ))
			    )
			)
		      )
		  (setq end_depth -1) ;; $END$の対応がない
		  )))
	    (if (= end_depth 0) ;; $END$の対応があった
		(progn
		  (let ((slinep 0) (elinep 0))
		    (save-excursion
		      (setq slinep (tf-block-get-line-start-pos)
			    elinep (tf-block-get-line-end-pos)))
		    ;; display line contents to minibuffer
		    (message "%d: %s" (1+ (count-lines (point-min) slinep))
			       (buffer-substring slinep elinep))
		    ;; do overlay.
		    (tf-block-do-highlight slinep elinep))
		  )
	      (message "ないかもだよ") ;; $END$の対応がなかった
	      )
	    )
	)
      )
    )
  )


(add-hook 'post-command-hook 'tf-block-hook) ;; post-command-hookに追加