;
; xyzzy fcsh
;

; [Description]
; xyzzy という Winodws 用の emacs ライクなエディタで
; fcsh を便利に使う lisp スクリプトです

; [Usage]
; http://www.libspark.org/wiki/hidachinoiro/xyzzyfcsh

; [Changes]
; 2009/04/29 関数の仕様を変更し新版として公開
;            新版は MIT ライセンス

; [Licence]
; MIT ライセンスです
;
; Copyright (c) 2009 Hidachinoiro
;
; Permission is hereby granted, free of charge, to any person obtaining a copy
; of this software and associated documentation files (the "Software"), to deal
; in the Software without restriction, including without limitation the rights
; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
; copies of the Software, and to permit persons to whom the Software is
; furnished to do so, subject to the following conditions:
;
; The above copyright notice and this permission notice shall be included in
; all copies or substantial portions of the Software.
;
; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
; THE SOFTWARE.

; [Author]
; ひだちのいろ
; Blog : http://d.hatena.ne.jp/mugaki/
; Mail : hidachinoiro@gmail.com

; デフォルトで利用する fcsh コマンドの位置
(defvar *fcsh-command* "fcsh")
; デフォルトで利用する swf プレイヤーの位置
(defvar *fcsh-player* "SAFlashPlayer.exe")
; デフォルトで利用するトレースログファイルの位置
(defvar *fcsh-log*
  (merge-pathnames "Macromedia\\Flash Player\\Logs\\flashlog.txt"
                   (si:getenv "APPDATA")))

;
; private variables
;

(defvar *fcsh-last-swf* "")
(defvar *fcsh-last-commnad* "")
(defvar-local fcsh-buffer-p nil)


;
; private macros
;
; バッファとともに何かする
(defmacro with-buffer (buffer &rest body)
  `(with-set-buffer
    (save-excursion
      (set-buffer ,buffer)
      ,@body)))

; バッファローカルな変数へのインバージョンを定義する
;(defmacro define-buffer-field (name default)
; `(progn
;   (defvar-local ,name ,default)
;   (defun ,name (buffer)
;     (setq buffer (or buffer (selected-buffer)))
;     (if (eq buffer :default)
;       (default-value ',name)
;       (buffer-local-value buffer ',name)))
;   (defsetf ,name (buffer) (value)
;     `(if (eq ,buffer :default)
;       (setq-default ,',name ,value)
;       (with-buffer ,buffer (setq ,',name ,value))))))

;
; public field
;
;(define-buffer-field fcsh-command "fcsh.exe")
;(define-buffer-field fcsh-player  "SAFlashPlayer.exe")
;(define-buffer-field fcsh-log     "flashlog.txt")

;
; private field
;
;(define-buffer-field fcsh-last-compile-command "")
;(define-buffer-field fcsh-last-output-swf      "")
;(define-buffer-field fcsh-buffer-p       nil)



;
; public interactive functions
;

; fcsh バッファの作成
; - directory コマンドを実行するディレクトリ
; - fcsh 使用する fcsh コマンド。省略時は *fcsh-command* の値を使用。
(defun fcsh-create-buffer (&optional directory fcsh)
  (interactive)
  (with-buffer (create-new-buffer "*fcsh*")
    (if directory (set-default-directory directory))
    (make-process (map-slash-to-backslash (or fcsh *fcsh-command*)))
    (command-output-mode)
    (set-buffer-colors #(#xffffff #x000000))
    (set-buffer-fold-type-window)
    (set-local-window-flags (selected-buffer) *window-flag-line-number* nil)
    (setq fcsh-buffer-p t)
    (selected-buffer)))

; fcsh バッファの削除
; - buffer 削除するバッファ。省略時は (fcsh-find-buffer) で検索
(defun fcsh-kill-buffer (&optional buffer)
  (interactive)
  (when (setq buffer (or buffer (fcsh-find-buffer)))
    (kill-process (buffer-process buffer))
    (sleep-for 1)
    (delete-buffer buffer)))
    
; 全 fcsh バッファの 削除
(defun fcsh-kill-all-buffers ()
  (interactive)
  (let ((list (remove-if-not 'fcsh-buffer-p (buffer-list))))
    (dolist (buffer list) (kill-process (buffer-process buffer)))
    (sleep-for 1)
    (dolist (buffer list) (delete-buffer buffer))))

; fcsh バッファかどうか判定する
(defun fcsh-buffer-p (buffer)
  (buffer-local-value buffer 'fcsh-buffer-p))

; fcsh バッファを検索。カレントディレクトリが fcsh バッファならばそれを返し
; そうでなければ他のバッファの中から fcsh バッファを探して返す
(defun fcsh-find-buffer ()
  (interactive)
  (if (fcsh-buffer-p (selected-buffer))
    (selected-buffer)
    (find-if #'fcsh-buffer-p (buffer-list))))

; fcsh-buffer にコマンドを送る
; - command おくるコマンド。省略時はミニバッファから入力。
; - buffer コマンドを送る fcsh バッファ。省略時は (fcsh-find-buffer) で検索
(defun fcsh-send-command
  (&optional (command (read-string "command: " :default *fcsh-last-commnad*))
             (buffer (fcsh-find-buffer)))
  (interactive)
  (if (numberp command)
      (setq command (format nil "~D" command)))
  (if (string-looking-at "[0-9]+" command)
      (setf command (concat "compile " command)))
  (process-send-string
    (buffer-process buffer)
    (concat command "\n"))
  (setq *fcsh-last-commnad* command))

; fcsh-buffer のエラーを検索してそこに飛ぶ
; - 検索する fcsh バッファ。省略時は (fcsh-find-buffer) で検索
(defun fcsh-jump-error (&optional (buffer (fcsh-find-buffer)))
  (interactive)
  (let ((cb (selected-buffer)) filename line b e)
    (set-buffer buffer)
    (if (scan-buffer "^\\(.+\\)(\\([0-9]+\\))" :no-dup t :tail t :regexp t)
        (progn
          (setq filename (match-string 1)
                line (parse-integer (match-string 2))
                b (match-beginning 0)
                e (match-end 0))
          (reverse-region b e)
          (goto-char b)
          (recenter 0)
          (find-file filename)
          (goto-line line))
        (progn
          (reverse-region 0 0)
          (set-buffer cb)
          (message "エラーが見つかりません")))))

; swf をスタンドアローンプレーヤーで再生
; - swf 起動する swf ファイル。省略時はミニバッファから入力
; - player 使用するプレイヤー。省略時は *fcsh-player* を使用
(defun fcsh-play-swf
  (&optional (swf (read-file-name "swf: " :default *fcsh-last-swf*))
             (player *fcsh-player*))
  (interactive)
  (call-process (concat (map-slash-to-backslash player) " " swf))
  (setq *fcsh-last-swf* swf))

; トレースログをオープンしてそのバッファを返す
; - log 表示するログ
(defun fcsh-log-buffer (&optional (log *fcsh-log*))
  (with-buffer (get-buffer-create log)
    (set-buffer-fileio-encoding *encoding-utf8*)
    (make-local-variable 'verify-visited-file-modtime)
    (setq verify-visited-file-modtime :auto)
    (set-buffer-fold-type-window)
    (set-local-window-flags (selected-buffer) *window-flag-line-number* nil)
    (selected-buffer)))

; 使用サンプルの関数。実行すると fcsh のためのフレームが生成されます。
; F5 でコンパイル F6 で実行 F9 でコンパイルエラーに飛びます。
; - directory fcsh を起動するディレクトリ
; - command コンパイルコマンド
; - 再生する swf
(defun fcsh-my-setup (directory command swf)
  (interactive "Ddir: \nscommand: \nfswf: ")
  ; フレーム関係のセットアップ
  (fcsh-kill-all-buffers)
  (setq *fcsh-buffer* (fcsh-create-buffer directory))
  (let ((b (selected-buffer)) (f (find-pseudo-frame "fcsh layout")) w)
    (if f (delete-pseudo-frame f))
    (new-pseudo-frame "fcsh layout" nil)
    (setq w (selected-window))
    (split-window -10)
    (set-buffer *fcsh-buffer*)
    (split-window -40 t)
    (set-buffer (fcsh-log-buffer))
    (set-window w)
    (set-buffer b))
  ; キー関係のセットアップ
  (set-function-bar-label #\F5 "fcsh コンパイル")
  (set-function-bar-label #\F6 "swf 実行")
  (set-function-bar-label #\F9 "fcsh 次エラー")
  (global-set-key #\F5 #'(lambda () (interactive)
    (save-all-buffers)
    (erase-buffer *fcsh-buffer*)
    (fcsh-send-command 1 *fcsh-buffer*)))
  (global-set-key #\F6 #'(lambda () (interactive) (fcsh-play-swf swf)))
  (global-set-key #\F9 'fcsh-jump-error)
  ; 実行
  (fcsh-send-command command *fcsh-buffer*))