;;;
;;; zmusic-mode.el -- major mode for zmusic
;;;

;; Author: wabee
;; Created: 17 Dec 1997
;; Version: Revision: 0.3
;; Keywords: zmusic, MML, MIDI
;; Copyright (C) wabee

;; History
;;   v0.1 Jan 06, 1998 First release
;;   v0.2 Jun 06, 2006 wabee's TMIDI DDE support, Meadow-2.10 support
;;   v0.3 Jul 06, 2006 ".exclusive" support

;;; Code:

(require 'shell)
(require 'compile)
(require 'timer)

(defvar zmusic-mode-debug-flag nil)
(defvar zmusic-send-command-modified-tick 0)
(defvar zmusic-playmidi-command "eplaymidi"
  "*Command used to run SMF player (ex. playmidi).")
(defvar zmusic-xeplaymidi-command "xeplaymidi"
  "*Command used to run visual SMF player (ex. xeplaymidi).")
(defvar zmusic-xwrdplay-command "xwrdplay"
  "*Command used to run WRD player (ex. xwrdplay).")
(defvar zmusic-playmidi-option "-e"
  "*SMFプレーヤ起動時に付加されるオプション文字列. (例．[e]playmidi の -e)")
(defvar zmusic-playmidi-background-option "&"
  "*SMFプレーヤ起動時に付加されるオプション文字列. (例．[e]playmidi& の &)")
(defvar zmusic-shell-filename "/bin/bash"
  "*Command used as shell.")

(defvar zmusic-playmidi-device "/dev/sequencer"
  "*Device name that playmidi uses.")
(defvar zmusic-playmidi-term-command "fuser -k -TERM"
  "*Command used to terminate playmidi.")
(defvar zmusic-playmidi-kill-command "fuser -k -KILL"
  "*Command used to kill playmidi.")

(defvar zmusic-template-file nil
  "*zmsを新規に作成する時に挿入するテンプレートのファイル名．
テンプレートを使用しないときは nil．")

;;; 色
(defvar zmusic-color-comment 'firebrick
"コメント文の色" )
(defvar zmusic-color-dot-common-command 'DarkGreen
".で始まる共通コマンドの色" )
(defvar zmusic-color-common-command 'RoyalBlue
"(...)な形式の共通コマンドの色（トラック番号を除く）" )
(defvar zmusic-color-repeat 'RoyalBlue 
"リピート記号の色" )
(defvar zmusic-color-flow-control 'RoyalBlue 
"フロー制御コマンド（[d.s.][d.c.]など）の色" )
(defvar zmusic-color-debug 'DeepPink
 "デバッグコマンド（[!][@]）の色" )
(defvar zmusic-color-track-number 'red-underline
"トラック番号の色" )
(defvar zmusic-color-waon 'ForestGreen
"和音の色" )
(defvar zmusic-color-renpu 'ForestGreen
"連符の色" )
(defvar zmusic-color-portament 'ForestGreen
"ポルタメントの色" )
(defvar zmusic-color-tie 'grey40
"タイ（&）の色" )
(defvar zmusic-color-step-time 'Maroon
"ステップタイム関連（l）の色" )
(defvar zmusic-color-gate-time 'brown
"ゲートタイム関連（q）の色" )
(defvar zmusic-color-velocity 'tomato
"ベロシティ関連（@u,z）の色" )
(defvar zmusic-color-hold 'NavyBlue
"ホールドペダル（@d）の色" )
(defvar zmusic-color-general-command 'DarkGoldenrod
"一般のコマンドの色" )

(defvar zmusic-blink-matching-repeat-delay 1
"対応するリピート記号をハイライト表示する時間．単位は秒．"
)
(defvar zmusic-mode-hook nil
  "*Hook run when zmusic mode is started.")

(defvar zmusic-mode-syntax-table nil
  "Syntax table used while in zmusic mode.")

;;;
;;; Utilities from wabi.el
;;;

(defun list-to-string (l)
"
Convert list into string. In Perl: 
 join(\",\",@list);
"
(interactive)
(let ((x))
  (if (eq l nil) "Nil"
	(if (not (eq (cdr l) nil))
		(setq x (concat (car l) "," (list-to-string (cdr l))))
	  (setq x (car l))
	  )
	)))

(defun get-current-frame-config (key)
"
現フレームの設定値を (current-frame-configuration) 
よりゲットして返す．

例:  現在のカーソル色を取得するには
     (get-current-frame-config 'cursor-color) 
"
(interactive)
(cdr 
 (assq 
  key
  (car (cdr (car (cdr (current-frame-configuration))))) ; maybe incorrect:-)
  ))
)


;;;;;
;;;;; カーソル移動支援 function
;;;;;

(defun zmusic-jump-to-track (track)
  "
指定されたトラック行まで飛ぶ．

バッファ先頭からサーチして最初に見付かったところにカーソルを
移動するので，同一のトラックを複数のかたまりに分割して書く人
は他の function を使ってくださいな．

"
  (interactive "sJump to Track: ")
  (let* (
		 (oldpnt (point))
		 )
	(goto-char (point-min))
	(if (eq
		 (search-forward-regexp (concat "^\\((t[\t ]*" track "[\t ]*)\\)") (point-max) t)
		 nil)
		(progn
		  (goto-char oldpnt)
		  (error (concat "No such track: " track))
		  )
	  ))
)

(defun zmusic-jump-to-track-forward (track)
  "
現在位置より前方の，指定されたトラック行まで飛ぶ．
"
  (interactive "sJump Forward to Track: ")
  (let* (
		 (oldpnt (point))
		 )
	(if (eq
		 (search-forward-regexp (concat "^\\((t[\t ]*" track "[\t ]*)\\)") (point-max) t)
		 nil)
		(progn
		  (goto-char oldpnt)
		  (error (concat "No such track: " track))
		  )
	  ))
)
(defun zmusic-jump-to-track-backward (track)
  "
現在位置より後方の，指定されたトラック行まで飛ぶ．
"
  (interactive "sJump Backward to Track: ")
  (let* (
		 (oldpnt (point))
		 )
	(if (eq
		 (search-backward-regexp (concat "^\\((t[\t ]*" track "[\t ]*)\\)") (point-min) t)
		 nil)
		(progn
		  (goto-char oldpnt)
		  (error (concat "No such track: " track))
		  )
	  ))
)



;;;
;;; リピート関連
;;;

(defvar zmusic-localvar-timer1 nil
"DO NOT USE! (because of internal use)"
)

(defun zmusic-blink-matching-repeat (open close)
)

(defun zmusic-blink-matching-repeat-original (open close)
"
直前に記述されているリピート終了記号と対応する
リピート開始記号を1秒間ハイライト表示する．

もしリピート開始記号が表示範囲外にあるならば
その行をミニバッファに表示する．
"
(interactive)
(save-excursion
(let ((zface 'zmusic-matching-repeat) p l x bol eol)
  (setq p (zmusic-match-repeat open close))
  (setq l (length open))
  (if (>= p 0)
      (progn
		;; process all remaining requests
		;; for avoiding the racing
	(while (not (eq zmusic-localvar-timer1 nil))
	  (setq x (car (reverse zmusic-localvar-timer1)))
	  (cancel-timer (car x))
	  (setq zmusic-localvar-timer1
		(reverse (cdr (reverse zmusic-localvar-timer1))))
	  (add-text-properties (car (cdr x)) (+ (car (cdr x)) (car (cdr (cdr x))))  '(face default))
	  )

	(add-text-properties p (+ p l)  '(face zmusic-matching-repeat))
	(if (<= p (window-start)) ; when p is out of sight
		(progn
		;;; prepare message to be printed in minibuffer.
		  (goto-char p)
		  (beginning-of-line)
		  (setq bol (point))
		  (end-of-line)
		  (setq eol (point))
		  (message (concat "Matches " (buffer-substring bol eol)))
		  ))
	(setq zmusic-localvar-timer1 
	      (cons
	       (list
			(run-at-time (concat
						  zmusic-blink-matching-repeat-delay
						  " sec")
						 nil 'zmusic-blink-matching-repeat-2)
			p l)
	       zmusic-localvar-timer1
	       )
	      )
	)
    )
  )
))


(defun zmusic-blink-matching-repeat-2 ()
"
タイマ解除および face 解除のサブルーチン．
（zmusic-blink-matching-repeat用）

"
;; zmusic-localvar-timer1 の最後尾から 1こ取って使う．
(let* ((x ))
  (if (not (eq zmusic-localvar-timer1 nil))
      (progn
	(setq x (car (reverse zmusic-localvar-timer1)))
	
	(setq zmusic-localvar-timer1
	      (reverse (cdr (reverse zmusic-localvar-timer1))))
	(cancel-timer (car x))
	(add-text-properties (car (cdr x))
						 (+ (car (cdr x)) (car (cdr (cdr x))))  '(face default))
	))
))



(defun zmusic-match-repeat (open close)
  "
マッチするリピート開始記号のポイントを返す．

★前提 = \":|\" を入力した直後に呼ばれる．
なお，くっつけて |::||:|::|:| みたいに
書いてる場合の動作は保証しない．
保証して欲しい人はメールください:-)"
  (interactive)
; ●|: あるいは :| を後方検索．
; ●:| とマッチしたならばカウント+1
; ●|: とマッチしたならばカウント-1．
;   その結果0ならば相手発見．>0 ならば探索続行．
(save-excursion
  (let* ((orig (point))
	 (cnt 0)
	 (cont 1)
	 (str "")
	 (limit (zmusic-beginning-of-this-track))
	 )
  (while
	  (and 
	   (eq cont 1)
	   (re-search-backward (concat "\\(" open "\\)\\|\\(" close "\\)") limit t)
	   )
	(cond
	 ((looking-at close)
	  (setq cnt (+ cnt 1))
	  (setq str (concat str "[CLOSE " cnt "]"))
;	  (setq cont 0)
;	  (add-text-properties (point) (+ (point) 1)  '(face highlight))
	  )
	 ((looking-at open)
	  (progn
		(setq cnt (- cnt 1))
		(setq str (concat str "[OPEN " cnt "]"))
		(if (eq cnt 0)
			(setq cont 0)
		  (backward-char 1)
		  )
		))
		
	 (t 
	  (setq str (concat str "failed?"))
	  )
	 )
	)
  (if (or
	   (not (eq cnt 0))  ; 途中でマッチしなくなった
	   (eq cont 1)  ; 最初からマッチせず
	   )
	  (progn
		(goto-char orig)  ; return to original point
;		(message (concat "No matching repeat found. " str))
;		(point)
		-1 ; error code
		)
    (point)  ; return value of this function
    )
)))

(defun zmusic-bar-self-insert-wrapper ()
"
\"|\"文字の入力時に呼ばれる．

直前の文字が\":\"ならば
リピート終了記号\":|\"が入力されたと判断し
対応するリピート開始記号の点滅ルーチンを呼ぶ．

判断アルゴリズムが嫌な人はメールください:-)
（でもちゃんとパースできないからある程度は妥協せざるを得ない……）
"
(interactive)
(let ((rep 0))
   (if (string= (char-to-string (preceding-char)) ":")
	   (setq rep 1)
	 )
   (insert "|")
   (if (eq rep 1)
	   (zmusic-blink-matching-repeat "|:" ":|")
	 (if zmusic-mode-debug-flag
		 (message "not repeat")
	   )
	 )
   );let
)

(defun zmusic-close-paren-self-insert-wrapper ()
"
\"}\"文字の入力時に呼ばれる．

直前の文字が\"}\"ならば
tick 数先行指定 MML \"{{...}}\"が入力されたと判断し
対応する \"{{\"の点滅ルーチンを呼ぶ．

そうでなければ，連符MML \"{...}\"が入力されたと判断し
対応する \"{\"の点滅ルーチンを呼ぶ．

判断アルゴリズムが嫌な人はメールください:-)
（でも真面目にパースするのは恐らく無理だから
ある程度は妥協せざるを得ない……）
"
(interactive)
(let ((rep 0))
   (if (string= (char-to-string (preceding-char)) "}")
	   (setq rep 1)
	 )
   (insert "}")
   (if (eq rep 1)
	   (zmusic-blink-matching-repeat "{{" "}}")
	 (zmusic-blink-matching-repeat "{" "}")
	 )
   );let
)


;;;
;;; 現在のトラック番号関係 for リピート関連
;;;

(defun zmusic-is-in-track (trk)
"
現在の行が与えられたトラック番号に属しているか否かを
 T or Nil で返す．
"
(interactive "NTrack : ")
(let* ((eot)(res nil)(x))
  (save-excursion
	(re-search-backward "\\((t\\)" nil t)
	(goto-char (match-end 0))
	(save-excursion ; get end-of-term position to limit search
	  (re-search-forward "\\()\\)" nil t)
	  (setq eot (point))
	)
	(while
		(re-search-forward "\\([0-9]+\\)" eot t)
	  (goto-char (match-end 0))
	  (if (string= trk (buffer-substring (match-beginning 0) (match-end 0)))
		  (setq res t)
		  )
	  )
	res
	)
  )
)

(defun zmusic-this-track-number ()
"
現在行のトラック番号を返す．

というか，(t...)の中で指定されているトラック番号全部を
取り出して \",\" で join した文字列を返す．

(t1) --> \"1\"
(t3,4) --> \"3,4\"
(t 3, 4 ) --> \"3,4\"
"
(interactive)
(let* ((eot)(res nil)(x))
  (save-excursion
    (end-of-line)
    (re-search-backward "\\((t\\)" nil t)
    (goto-char (match-end 0))
    (save-excursion ; get end-of-term position to limit search
      (re-search-forward "\\()\\)" nil t)
      (setq eot (point))
      )
    (while
	(re-search-forward "\\([0-9]+\\)" eot t)
      (goto-char (match-end 0))
      (setq res
	    (cons (buffer-substring (match-beginning 0) (match-end 0))
		  res
		  )
	    )
      )
    )
;  (message (concat "track=" (list-to-string res))) ; return value
  (list-to-string (reverse res)) ; return value
  )
)


(defun zmusic-beginning-of-this-track ()
"
現在のトラック指定がどっから始まっているかの位置を返す．

(t1)
(t1)
は 最初の行．

(t3,4)
(t 3, 4)
も 最初の行．でも

(t1)
(t1,3)
は 別々の行．なぜならこれを含めて判断するのは
実現がちょぴっと:-)面倒なため．これが嫌な人はメール下さいませ．
"
(interactive)
  (save-excursion
(let ((trk))
  (end-of-line)
  (setq trk (zmusic-this-track-number)) ; get this line's track number
    (beginning-of-line)
    (while
	(string= trk (zmusic-this-track-number))
      (forward-line -1)
      )
    )
    (forward-line 1)
;    (message (concat "Track = " trk))
    (point)
))

(defun zmusic-goto-beginning-of-this-track ()
"
現在のトラック指定が始まっている位置へカーソルを移動．
"
(interactive)
(goto-char (zmusic-beginning-of-this-track))
)


;;;;
;;;; リピート閉じ忘れ検出関連
;;;;

(defun zmusic-close-unclosed-paren ()
"
閉じていない開き括弧類があれば
閉じ括弧を挿入する．（★未実装）
"
(interactive)
(save-excursion
  (re-search-backward (concat "\\(|:\\)\\|\\(:|\\)") limit t)
  (if (> (zmusic-unclosed-repeat "|:" ":|") 0)
	  (progn
		(insert ":|")
		(zmusic-blink-matching-repeat "|:" ":|")
		)
	)
  )
)

(defun zmusic-goto-unclosed-repeat ()
"
閉じていないリピート開始記号\"|:\"があれば
そこへカーソルを移動．
"
(interactive)
(let* ((x (zmusic-unclosed-repeat "|:" ":|")))
  (if (> x 0)
	  (goto-char x))
  )
)


(defun zmusic-close-unclosed-repeat ()
"
閉じていないリピート開始記号\"|:\"があれば
リピート終了記号\":|\"を挿入する．
"
(interactive)
(if (> (zmusic-unclosed-repeat "|:" ":|") 0)
	(progn
	  (insert ":|")
	  (zmusic-blink-matching-repeat "|:" ":|")
	  )
  )
)

(defun zmusic-goto-unclosed-tick-reserve ()
"
閉じていない tick 予約記号\"{{\"があれば
そこへカーソルを移動．
"
(interactive)
(let* ((x (zmusic-unclosed-repeat "{{" "}}")))
  (if (> x 0)
	  (goto-char x))
  )
)


(defun zmusic-close-unclosed-tick-reserve ()
"
閉じていない tick 予約記号\"{{\"があれば
\"}}\" を挿入する．
"
(interactive)
(if (> (zmusic-unclosed-repeat "{{" "}}") 0)
	(progn
	  (insert "}}")
	  (zmusic-blink-matching-repeat "{{" "}}")
	  )
  )
)


(defun zmusic-unclosed-repeat (open close)
"
閉じていない開き括弧類（リピート開始記号など）
のポイントを返す
"
(interactive)
(save-excursion
  (let* ((orig (point))
		 (x 0)
		 (cont 1)
		 (str "")
		 (limit (zmusic-beginning-of-this-track))
		 (res (point))
		 )
	(if (< limit 0)
		(setq limit (point-min)))
;	(goto-char limit)))) ; debug

	(while (> cont 0)  ;; skip pairs of repeats
	  (re-search-backward (concat "\\(" open "\\)\\|\\(" close "\\)") limit t)
	  (if (looking-at close)
		  (progn
			(forward-char (length close))
			(goto-char (zmusic-match-repeat open close))
			(backward-char 1)
			)
		(if (looking-at open)
			(progn
			  (setq res (point)) ; FOUND
			  (setq cont 0)  ; break
			  )
		  (progn
			(setq res -1) ; ERROR
			(setq cont 0) ; break
			)
		  )
		)
	  )
	res
	)))



;;;;
;;;; 統合環境支援 function
;;;;

(defun zmusic-run-compile ()
(interactive)
(compile compile-command)
)

(defun zmusic-shell-running ()
"Return whether zmusic-shell is running or not."
  (interactive)
  (and (get-process "zmusic-shell")
       (eq (process-status (get-process "zmusic-shell")) 'run)))

(defun zmusic-kill-shell ()
  "Kill the currently running zmusic job."
  (interactive)

  (let ((zmusic-shell (get-buffer "*zmusic-shell*"))
	(old-buffer (current-buffer)))
    (if (null zmusic-shell)
	(message "No zmusic output buffer")
      (pop-to-buffer zmusic-shell)
      (bury-buffer zmusic-shell)
	  (comint-kill-subjob)
      (pop-to-buffer old-buffer))))


(defun zmusic-start-shell ()
  "*Start zmusic sub shell."
  (interactive)
  (make-comint
   "zmusic-shell"
   zmusic-shell-filename
   nil
   )
)


(defun zmusic-check-clock ()
	  (interactive)
	  (message "未実装です．")
)


(defun zmusic-append-suffix (file-name suffix)
  "Append to FILENAME the suffix SUFFIX, using same algorithm zmusic uses;
i.e. delete the zms suffix \".zms\" from FILENAME, and append SUFFIX to it.
"
	  (concat 
		  (substring file-name 0
			     (string-match "\\.zms$" file-name))
		  suffix))

(defun zmusic-term-playmidi ()
"
zmusic-playmidi による SMF 演奏を SIGTERM で停止する．

（プロセス間通信で制御できる SMF 演奏ツールを使うようになる
までの暫定機能）
"
	  (interactive)
	  (if (not (zmusic-shell-running))
		  (zmusic-start-shell))
		 (zmusic-send-command 
           (concat zmusic-playmidi-term-command
                   " "
                   zmusic-playmidi-device))
;         (zmusic-kill-shell)

)


(defun zmusic-kill-playmidi ()
"
zmusic-playmidi による SMF 演奏を SIGKILL で停止する．

（プロセス間通信で制御できる SMF 演奏ツールを使うようになる
までの暫定機能）
"
	  (interactive)
	  (if (not (zmusic-shell-running))
		  (zmusic-start-shell))
		 (zmusic-send-command 
           (concat zmusic-playmidi-kill-command
                   " "
                   zmusic-playmidi-device))
;		 (zmusic-recenter-output-buffer nil)
)

(defun zmusic-playmidi ()
"
編集中のバッファに対応する SMF を演奏する．

演奏中の場合，まず演奏を停止しようと思ったが，
デバイスが実際に解放されるまで若干のタイムラグが
生じるせいで，演奏停止はするが演奏が開始しないことがある．
というわけで，止めるためには C-c s してくださいな．
"
	  (interactive)
	  (if (not (zmusic-shell-running))
		  (zmusic-start-shell))
	;	 (display-buffer (process-buffer (get-process "zmusic-playmidi")))
		 (zmusic-send-command (concat
							  zmusic-playmidi-command
							  ;" -e "
                              " "
                              zmusic-playmidi-option
                              " "
							 (zmusic-append-suffix
							  (concat
							   (file-name-directory (buffer-file-name))
							   (file-name-nondirectory (buffer-file-name))
							   )
							  ".mid"
							  )
                              zmusic-playmidi-background-option
                             ))
;         (zmusic-kill-shell)
;		 (zmusic-recenter-output-buffer nil)
)


(defun zmusic-eplaymidi-clear-lockfile ()
"
前回起動した eplaymidi が残してしまったロックファイル
(/tmp/LCK..eplaymidi)を削除する．

本当は，演奏時にロックファイルが残っていればそれを検出
して消すかどうか聞くようにしたいですね．
もしくは，eplaymidi の倉持さん，頑張ってぇ〜:-)．
"
	  (interactive)
         (zmusic-kill-playmidi)
	  (if (not (zmusic-shell-running))
		  (zmusic-start-shell))
	  
		  (zmusic-send-command 
		   (concat
			"rm /tmp/LCK..eplaymidi"
			)
		   )
		 (zmusic-recenter-output-buffer nil)
)

(defun zmusic-run-xeplaymidi ()
	  (interactive)
	  (if (not (zmusic-shell-running))
		  (zmusic-start-shell))
	  
		  (zmusic-send-command 
		   (concat
			zmusic-xeplaymidi-command
			"&"
			)
		   )
		 (zmusic-recenter-output-buffer nil)
)

(defun zmusic-run-xwrdplay ()
	  (interactive)
	  (if (not (zmusic-shell-running))
		  (zmusic-start-shell))
	  
		  (zmusic-send-command 
		   (concat
			zmusic-xwrdplay-command
			" "
			(zmusic-append-suffix
			 (concat
			  (file-name-directory (buffer-file-name))
			  (file-name-nondirectory (buffer-file-name))
			  )
			 ".wrd"
			 )
			"&"
			)
		   )
		 (zmusic-recenter-output-buffer nil)
)


(defun zmusic-send-command (command &optional file background)
  "Send COMMAND to zmusic shell process, substituting optional FILE for *.
Do this in background if optional BACKGROUND is t.  If COMMAND has no *,
FILE will be appended, preceded by a blank, to COMMAND.  If FILE is nil, no
substitution will be made in COMMAND.  COMMAND can be any expression that
evaluates to a command string."
  (save-excursion
    (let* ((cmd (eval command))
	   (proc (get-process "zmusic-shell"))
	   (buf (process-buffer proc))
           (star (string-match "\\*" cmd))
	   (string
	    (concat
	     (if file
		 (if star (concat (substring cmd 0 star)
				  file (substring cmd (1+ star)))
		   (concat cmd " " file))
	       cmd)
	     (if background "&" ""))))
      ;; Switch to buffer before checking for subproc output in it.
      (set-buffer buf)
      ;; If text is unchanged since previous zmusic-send-command,
      ;; we haven't got any output.  So wait for output now.
      (if (= (buffer-modified-tick buf) zmusic-send-command-modified-tick)
	  (accept-process-output proc))
      (goto-char (process-mark proc))
      (insert string)
      (comint-send-input)
      (setq zmusic-send-command-modified-tick (buffer-modified-tick buf))
	  )
	)
  )

(defun zmusic-recenter-output-buffer (linenum)
  "Redisplay buffer of zmusic job output so that most recent output can be seen.
The last line of the buffer is displayed on
line LINE of the window, or centered if LINE is nil."
  (interactive "P")
  (let ((zmusic-shell (get-buffer "*zmusic-shell*"))
	(old-buffer (current-buffer)))
    (if (null zmusic-shell)
	(message "No zmusic output buffer")
      (pop-to-buffer zmusic-shell)
      (bury-buffer zmusic-shell)
      (goto-char (point-max))
      (recenter (if linenum
		    (prefix-numeric-value linenum)
		  (/ (window-height) 2)))
      (pop-to-buffer old-buffer))))


(defun zmusic-insert-template-file ()
"

テンプレートを挿入する．

"
(interactive)
(let* ((success 1))
  (condition-case nil
      (insert-file-contents zmusic-template-file)
    (file-error
     (setq success 0)
     )
    )
  (if (eq success 0)
      (with-output-to-temp-buffer "*zmusic-mode-error*"
	  (princ 
	   (concat
	    "テンプレート("
	    zmusic-template-file
	    ")をオープンできません．"
	    ))
	   (terpri)
	   (print-help-return-message))
)))

;;;;
;;;; zmusic-mode.el を提供するための設定
;;;;

(defun zmusic-define-common-keys (keymap)
  "Define the keys that we want defined both in zmusic mode and in the zmusic shell."
  (define-key keymap "|" 'zmusic-bar-self-insert-wrapper)
  (define-key keymap "}" 'zmusic-close-paren-self-insert-wrapper)
  (define-key keymap "\C-c\C-c" 'zmusic-run-compile)
;  (define-key keymap "\C-c\C-v" 'zmusic-check-clock)
  (define-key keymap "\C-cp" 'zmusic-playmidi)
  (define-key keymap "\C-cs" 'zmusic-term-playmidi)
  (define-key keymap "\C-cv" 'zmusic-run-xeplaymidi)
  (define-key keymap "\C-cw" 'zmusic-run-xwrdplay)
  (define-key keymap "\C-ck" 'zmusic-eplaymidi-clear-lockfile)
  (define-key keymap "\C-c\C-l" 'zmusic-recenter-output-buffer)
  (define-key keymap "\C-c\C-j" 'zmusic-jump-to-track)
  (define-key keymap "\C-c\C-f" 'zmusic-jump-to-track-forward)
  (define-key keymap "\C-c\C-b" 'zmusic-jump-to-track-backward)
  (define-key keymap "\C-c:" 'zmusic-insert-repeats)
  (define-key keymap "\C-c\C-e" 'zmusic-close-unclosed-repeat)
  (define-key keymap "\C-c\C-u" 'zmusic-goto-unclosed-repeat)
;  (define-key keymap "\C-ci" 'zmusic-view-include-file)
  (define-key keymap [S-return] 'zmusic-newline)

  (define-key keymap [menu-bar zmusic] (cons "Zmusic" (make-sparse-keymap "zmusic")))

  (define-key keymap [menu-bar zmusic zmusic-goto-unclosed-repeat] '("Jump to Last Unended Repeat" . zmusic-goto-unclosed-repeat))
  (define-key keymap [menu-bar zmusic zmusic-close-unclosed-repeat] '("Close Unended Repeat" . zmusic-close-unclosed-repeat))
  (define-key keymap [menu-bar zmusic zmusic-jump-to-track-backward] '("Jump Backward to Track" . zmusic-jump-to-track-backward))
  (define-key keymap [menu-bar zmusic zmusic-jump-to-track-forward] '("Jump Forward to Track" . zmusic-jump-to-track-forward))
  (define-key keymap [menu-bar zmusic zmusic-jump-to-track] '("Jump to Track" . zmusic-jump-to-track))
  (define-key keymap [menu-bar zmusic zmusic-recenter-output-buffer]
    '("Recenter Shell Buffer" . zmusic-recenter-output-buffer))
  (define-key keymap [menu-bar zmusic zmusic-run-xwrdplay] '("WRD Player" . zmusic-run-xwrdplay))
  (define-key keymap [menu-bar zmusic zmusic-run-xeplaymidi] '("Status Viewer" . zmusic-run-xeplaymidi))
  (define-key keymap [menu-bar zmusic zmusic-kill-playmidi] '("Stop" . zmusic-term-playmidi))
  (define-key keymap [menu-bar zmusic zmusic-playmidi] '("Play" . zmusic-playmidi))
;  (define-key keymap [menu-bar zmusic zmusic-check-clock] '("Check Total Clock by ZMC" . zmusic-check-clock))
  (define-key keymap [menu-bar zmusic next-error] '("Jump to Next Error" . next-error))
  (define-key keymap [menu-bar zmusic zmusic-run-compile] '("Compile" . zmusic-run-compile))
  )

(defvar zmusic-mode-map nil "Keymap for zmusic mode.")

(if zmusic-mode-map 
    nil
  (setq zmusic-mode-map (make-sparse-keymap))
  (zmusic-define-common-keys zmusic-mode-map)
  )

(defun zmusic-common-initialization ()
  (kill-all-local-variables)
  (use-local-map zmusic-mode-map)

  ;; コンパイル関連の設定
  (make-local-variable 'compile-command)
  (make-local-variable 'compilation-error-regexp-alist)
  (setq compile-command
		(concat "zms2mid "
				(zmusic-append-suffix 
                  (file-name-nondirectory (buffer-file-name))
                  "")))
;				buffer-file-name))
  (setq compilation-error-regexp-alist
		(list
		 (list "\\([^ \t\n]+\\)[ \t]*\\([0-9]+\\):" 1 2)
		 (list "\\([^ \t\n]+\\)[ \t]*\\([0-9]+\\):[ \t]*\\([0-9]+\\):" 1 2 3)
		 ))

  ;; Syntax Table 
  (if zmusic-mode-syntax-table
	  ()
	(setq zmusic-mode-syntax-table (make-syntax-table text-mode-syntax-table))
	(modify-syntax-entry ?<  ".  " zmusic-mode-syntax-table)
	(modify-syntax-entry ?>  ".  " zmusic-mode-syntax-table)
	(modify-syntax-entry ?@   "w   " zmusic-mode-syntax-table)
	(modify-syntax-entry ?{   "(}  " zmusic-mode-syntax-table)
	(modify-syntax-entry ?}   "){  " zmusic-mode-syntax-table)
	(modify-syntax-entry ?\"   "\"   " zmusic-mode-syntax-table)
;	(modify-syntax-entry ?'   ")'   " zmusic-mode-syntax-table) ; ダメ
;	(modify-syntax-entry ?'   "\"   " zmusic-mode-syntax-table) ; ダメ
;	(modify-syntax-entry ?'   "$   " zmusic-mode-syntax-table) ; いまいち
	(modify-syntax-entry ?'   "_   " zmusic-mode-syntax-table) ; 結局一番マシ
	(modify-syntax-entry ?/   "\\\;   " zmusic-mode-syntax-table)
)
  (set-syntax-table zmusic-mode-syntax-table)

;;; リピート点滅用 Face の準備 
  (make-face 'zmusic-matching-repeat) ; [Note] nothing done if already exists
  (copy-face 'highlight 'zmusic-matching-repeat)
  (set-face-foreground
   'zmusic-matching-repeat
   (get-current-frame-config 'cursor-color)
   )

)

(defun zmusic-mode ()
  "Major mode for zmusic.

	C-c C-c		ZMS をコンパイルする．
    M-x compile 同上
    C-x `       （次の）エラー発生位置へジャンプ
	C-c p		バッファに対応する SMF を演奏
	C-c s		演奏を停止
	C-c v		ステータスビュワー(default:xeplaymidi)を起動
	C-c w		WRDプレーヤー(default:xwrdplay)を起動
	C-c k		eplaymidiの Lock File を消す (rm /tmp/LCK..eplaymidi)
	C-c C-l		*zmusic-shell*バッファを再描画

	C-c C-j		トラック番号を指定してジャンプ（先頭から見た最初のトラック行）
	C-c C-f		トラック番号を指定してジャンプ（現在位置から前方へ探索）
	C-c C-b		トラック番号を指定してジャンプ（現在位置から後方へ探索）

	C-c :		リピート記号 `|:  :|' を挿入
	C-c C-e		閉じていないリピート記号があれば `:|' を挿入
	C-c C-u		閉じていないリピート記号までジャンプ

詳しくは附属の zmusic-mode.txt をお読み下さい．
"
  (interactive)
  (zmusic-common-initialization)
  (setq mode-name "zmusic")
  (setq major-mode 'zmusic-mode)

  (if (and (stringp zmusic-template-file)
		   (zerop (buffer-size)))
	  (zmusic-insert-template-file)
	)
  
;;
;; hilit19 関連
;; 

(if (fboundp 'hilit-set-mode-patterns)
	(progn
	  (hilit-lookup-face-create 'zmusic-comment)
	  (hilit-translate zmusic-comment zmusic-color-comment)
	  (hilit-lookup-face-create 'zmusic-dot-common-command)
	  (hilit-translate zmusic-dot-common-command zmusic-color-dot-common-command)
	  (hilit-lookup-face-create 'zmusic-common-command)
	  (hilit-translate zmusic-common-command zmusic-color-common-command)
	  (hilit-lookup-face-create 'zmusic-repeat)
	  (hilit-translate zmusic-repeat zmusic-color-repeat)
	  (hilit-lookup-face-create 'zmusic-flow-control)
	  (hilit-translate zmusic-flow-control zmusic-color-flow-control)
	  (hilit-lookup-face-create 'zmusic-debug)
	  (hilit-translate zmusic-debug zmusic-color-debug)
	  (hilit-lookup-face-create 'zmusic-track-number)
	  (hilit-translate zmusic-track-number zmusic-color-track-number)
	  (hilit-lookup-face-create 'zmusic-waon)
	  (hilit-translate zmusic-waon zmusic-color-waon)
	  (hilit-lookup-face-create 'zmusic-renpu)
	  (hilit-translate zmusic-renpu zmusic-color-renpu)
	  (hilit-lookup-face-create 'zmusic-portament)
	  (hilit-translate zmusic-portament zmusic-color-portament)
	  (hilit-lookup-face-create 'zmusic-tie)
	  (hilit-translate zmusic-tie zmusic-color-tie)
	  (hilit-lookup-face-create 'zmusic-step-time)
	  (hilit-translate zmusic-step-time zmusic-color-step-time)
	  (hilit-lookup-face-create 'zmusic-gate-time)
	  (hilit-translate zmusic-gate-time zmusic-color-gate-time)
	  (hilit-lookup-face-create 'zmusic-velocity)
	  (hilit-translate zmusic-velocity zmusic-color-velocity)
	  (hilit-lookup-face-create 'zmusic-hold)
	  (hilit-translate zmusic-hold zmusic-color-hold)
	  (hilit-lookup-face-create 'zmusic-general-command)
	  (hilit-translate zmusic-general-command zmusic-color-general-command)
	  (hilit-set-mode-patterns
	   'zmusic-mode
	   '(
		 ("^\\.comment" "$" zmusic-dot-common-command) ; .comment
		 ("^\\.define" "$" zmusic-dot-common-command) ; .comment
		 ("^\\.\\(sc55\\|mt32\\|u220\\|m1\\)_print[ \t\n]*[$a-f0-9]*[ \t\n]*\".*\"" nil zmusic-dot-common-command) ; .sc55_init
		 ("^\\.sc55_init" nil zmusic-dot-common-command) ; .sc55_init
		 ("^\\.sc55_\\(v_reserve\\|reverb\\|chorus\\|part_setup\\|drum_setup\\|display\\)" "}" zmusic-dot-common-command) ; .sc55_reverb
		 ("^\\.mt32_\\(p_reserve\\|reverb\\|part_setup\\|drum_setup\\|common\\|partial\\|patch\\)" "}" zmusic-dot-common-command) ; .mt32_reverb
		 ("^\\.u220_\\(setup\\|common\\|part_setup\\|drum_setup\\|timbre\\|drum_inst\\)" "}" zmusic-dot-common-command) ; .u220_setup
		 ("^\\.m1_\\(midi_ch\\|part_setup\\|effect_setup\\)" "}" zmusic-dot-common-command) ; .m1_part_setup
		 ("^\\.send_to_m1[ \t\n]*[$a-f0-9]*" nil zmusic-dot-common-command) ; .send_to_m1
		 ("^\\.roland" "}" zmusic-dot-common-command) ; .sc55_init
		 ("^\\.exclusive" "}" zmusic-dot-common-command) ; .sc55_init
		 ("/" "$" zmusic-comment)  ; コメント
		 ("(t[\t ]*[0-9]+\\([\t ]*,[\t ]*[0-9]+\\)*[\t ]*)" nil zmusic-track-number) ;  (t1)
		 ("(p)" nil zmusic-common-command) ;  (p1)
;	   ("(p[\t ]*[0-9]+\\([\t ]*,[\t ]*[0-9]+\\)*[\t ]*)" nil label) ;  (p1)
		 ("'[a-g<>][-+#a-g<>0-9\\.^]*'\\([0-9]+\\)?\\(,[-+0-9]+\\)?" nil zmusic-waon) ; 和音
		 ("{[a-g<>][-+#a-gr<>0-9\\.^]}" nil zmusic-renpu) ; 連符
; ↑連符の中の和音には対応していない．

		 ("(i)" nil zmusic-common-command) ; (i) （prefix=音階でないMML）
		 ("([bdoz][0-9]+)" nil zmusic-common-command)  ; (d0) （prefix=音階でもあるMML）
		 ("(amidi[0-9]+,[0-9]+)" nil zmusic-common-command) ; (aMIDI1,10) 
		 ("(m[0-9]+,[0-9]+)" nil zmusic-common-command) ; (m1,1000) 
		 ("\\[[!@]\\]" nil zmusic-debug) ; [!]
		 ("\\[" "\\]" zmusic-flow-control) ; [d.s.]
		 ("\\\\[-+0-9]+" nil zmusic-flow-control) ; \5
		 ("|:[0-9]*" nil zmusic-repeat) ; リピート
		 ("|[0-9]*" nil zmusic-repeat) ; リピート
		 (":|" nil zmusic-repeat) ; リピート

		 ("([<>]*[a-g][-#+]?\\([0-9^.]+\\)?\\(,\\)?[<>]*\\(o[0-9]\\)?[a-g][-#+]?[<>]*)\\([0-9^.]+\\)?\\(,[0-9]+\\)?" nil zmusic-portament) ; ポルタメント

;;;;;; 以下，Pentium133+RAM48Mで 50K の ZMS とかだと
;;;;;; 遅過ぎるのでやめた方がいいかも．
		 ("&" nil zmusic-tie) ; & 
		 ("@[0-9]+" nil zmusic-general-command) ; @11
		 ("z\\([-+0-9]*\\|$[0-9a-f]*\\)\\(,\\([-+0-9]*\\|$[0-9a-f]*\\)\\)*" nil zmusic-velocity) ; z90,100,120
		 ("@u\\([-+0-9]*\\|$[0-9a-f]*\\)" nil zmusic-velocity) ; @u90
		 ("q\\([-+0-9]*\\|$[0-9a-f]*\\)\\(,\\([-+0-9]*\\|$[0-9a-f]*\\)\\)*" nil zmusic-gate-time) ; q90,100,120
		 ("@d\\([-+0-9]*\\|$[0-9a-f]*\\)" nil zmusic-hold) ; @d100
		 ("l\\([-+0-9]*\\|$[0-9a-f]*\\)" nil zmusic-step-time) ; l32
		 ("[himsx_~`]\\([-+0-9]*\\|$[0-9a-f]*\\)\\(,\\([-+0-9]*\\|$[0-9a-f]*\\)\\)*" nil zmusic-general-command) ; z90,100,120
		 ("@[abceghijklmpqrsvxyz][-+\\$a-f0-9]*\\(,[-+\\$a-f0-9]*\\)*" nil zmusic-general-command) ; @z90,100,120
		 
		 ("[hjknoptuvwy][-+0-9]+" nil zmusic-general-command) ; j1
		 )
	   nil 'case-insensitive)
	  nil)
  )
(run-hooks 'zmusic-mode-hook))

(provide 'zmusic-mode)

;;; zmusic-mode.el ends here