;;; -*- Emacs-Lisp -*-
;;; javaplus.el - A plus alpha for java-mode
;;; (c)1999 HIROSE Yuuji [yuuji@itc.keio.ac.jp]
;;; Last modified Wed Jul  5 17:10:54 2000 on firestorm
;;; Update Count: 104

;============================================================
;; 初期化用ライブラリ
;;;
(defun javaplus*search-file-in (file paths)
  (let (dir)
    (catch 'this
      (while paths
	(setq dir (car paths))
	(if (file-exists-p (expand-file-name file dir))
	    (throw 'this dir))
	(setq paths (cdr paths))))))

;============================================================
;; 設定変数
;;;
(defvar javaplus:search-path-list
  '("c:/usr/local/jdk1.1.7B/bin" "c:/jdk1.1.7B/bin"
    "/usr/local/bin/JDK" "/usr/local/Kaffe/bin")
  "自分の利用する環境全てのJDK実行ファイルディレクトリを突っ込んでおく")

(defvar javaplus:path-jdkdir
  (javaplus*search-file-in "." javaplus:search-path-list)
  "JDKのコンパイラ等の入っているディレクトリ")

(defvar javaplus:path-javac
  (expand-file-name "javac" javaplus:path-jdkdir)
  "javacコマンドのフルパス名")

(defvar javaplus:path-java
  (expand-file-name "java" javaplus:path-jdkdir)
  "javaコマンドのフルパス名")

(defvar javaplus:path-appletviewer
  (expand-file-name "appletviewer" javaplus:path-jdkdir)
  "appletviewerのフルパス名")

(defvar javaplus:path-shell shell-file-name
  "シェルのフルパス名")
(defvar javaplus:shell-command-switch
  (or
   (and (boundp 'shell-command-switch) shell-command-switch)
   (and (boundp 'shell-command-option) shell-command-option))
  "シェルにコマンドを渡すときのオプション")

(defvar javaplus:pop-window-height 10
  "コンパイルバッファの行数")

;============================================================
;; ライブラリ関数
;;;
(defun javaplus*pop-to-buffer (buffer)
  (cond
   ((one-window-p)
    (split-window)
    (other-window 1)
    (switch-to-buffer buffer)
    (shrink-window (- (window-height) javaplus:pop-window-height)))
   (t
    (other-window 1)
    (switch-to-buffer buffer))))

;============================================================
;; プロセス処理関数
;;;
(defun javaplus*process-sentinel (proc mes)
  (cond
   ((memq (process-status proc) '(signal exit))
    (save-excursion
      (set-buffer (process-buffer proc))
      (goto-char (point-max))
      (insert
       (format "\nProcess %s finished at %s" proc (current-time-string)))
      (if (get-buffer-window (current-buffer))
	  (let ((sw (selected-window)))
	    (select-window (get-buffer-window (current-buffer)))
	    (recenter -1)
	    (select-window sw))
	(message "process %s done" proc))))))

(defun javaplus-send-process-command-line ()
  "プロセスバッファの入力行をプロセスに送る"
  (interactive)
  (let* ((proc (get-buffer-process (current-buffer)))
	 (cmd (buffer-substring
	       (progn (goto-char (process-mark proc))
		      (skip-chars-forward " \t")
		      (point))
	       (progn (end-of-line) (point)))))
    (insert "\n ")
    (set-marker (process-mark proc) (1- (point)))
    (process-send-string proc (concat cmd "\n"))))

(defvar javaplus:process-buffer-map (make-keymap) "プロセスバッファキーマップ")
(let ((ch ? ))
  (while (< ch 128)
    (define-key javaplus:process-buffer-map
      (make-string 1 ch) 'javaplus-process-buffer-insert)
    (setq ch (1+ ch))))

;(suppress-keymap javaplus:process-buffer-map)
(define-key javaplus:process-buffer-map
  "\C-m" 'javaplus-send-process-command-line)

(defun javaplus-process-buffer-insert (x)
  "プロセスバッファでのキー入力"
  (interactive "p")
  (if (> (point) (process-mark (get-buffer-process (current-buffer))))
      (call-interactively
       (lookup-key global-map (this-command-keys)))))

(defun javaplus-start-command (name command &optional dir)
  "外部コマンドをstart-processで起動する"
  (let* ((buf (get-buffer-create (concat " *" name "*")))
	 (proc (get-buffer-process buf))
	 (code (or (and (boundp 'buffer-file-coding-system)
			buffer-file-coding-system)
		   (and (boundp 'file-coding-system)
			file-coding-system)))
	 (dir (or dir
		  (and buffer-file-name (file-name-directory buffer-file-name))
		  default-direct))
	 (sw (selected-window)))
    (save-excursion
      (set-buffer buf)
      (cd dir)
      (and proc (eq (process-status proc) 'run)
	   (progn
	     (message "Process %s running.  Killed" proc)
	     (kill-process proc)
	     (sleep-for 1)))
      (javaplus*pop-to-buffer buf)
      (erase-buffer)
      (insert "cd " default-directory "\n")
      (setq proc
	    (start-process
	     name buf javaplus:path-shell javaplus:shell-command-switch
	     command))
      (set-process-sentinel proc 'javaplus*process-sentinel)
      (use-local-map javaplus:process-buffer-map)
      (insert command "\n ")
      (set-marker (process-mark proc) (1- (point)))
      (set-process-coding-system proc code code)
      (bury-buffer buf) ;priority down
      (select-window sw)
    )))

(defun javaplus-start-compile ()
  "カレントバッファの *.java にたいするjavacの起動"
  (interactive)
  (basic-save-buffer)
  (let ((code (symbol-name buffer-file-coding-system))
	(basename (file-name-nondirectory buffer-file-name)))
    (setq code
	  (cond
	   ((string-match "shift.jis\\|sjis" code)	" -encoding SJIS ")
	   ((string-match "euc-jp" code)		" -encoding EUC ")
	   (t " ")))
    (javaplus-start-command
     "javac"
     (concat javaplus:path-javac code basename))
    (message "Starting Java Compiler for %s..."
	     (file-name-nondirectory buffer-file-name))))

(defvar javaplus:current-package nil "このjavaファイルのpackage名")
(make-variable-buffer-local 'javaplus:current-package)
(defun javaplus-read-package-name ()
  "ファイル先頭から package 名を取得して javaplus:current-package にセット."
  (interactive)
  (setq javaplus:current-package nil)
  (save-excursion
    (goto-char (point-min))
    (if (re-search-forward "package\\s +\\([^\;]+\\);" nil t)
	(setq javaplus:current-package
	      (buffer-substring (match-beginning 1) (match-end 1))))))

(defun javaplus*n-of-. (package)
  "パッケージ名中のピリオドの数を返す."
  (let ((n 0) (pos 0))
    (while (setq pos (string-match "\\." package pos))
      (setq n (1+ n) pos (1+ pos)))
    n))

(defun javaplus*class2path (class)
  "クラス名からクラスファイル名を得る."
  (let ((path (copy-sequence class)) (pos 0))
    (while (setq pos (string-match "\\." path pos))
      (aset path pos ?/)
      (setq pos (1+ pos)))
    path))

(defvar javaplus:classpath nil
  "現在のEmacsの保持している$CLASSPATHをリストで保持する.")

(defvar javaplus:classpath-default (getenv "CLASSPATH")
  "Emacsが最初に持っていた$CLASSPATH")

(defun javaplus*setup-classpath (path)
  "必要なCLASSPATHをセットする."
  "ちょっと保留"
  )

(defun javaplus*quote-shell-metachars (str)
  "シェルのメタキャラクタをクォート"
  (cond
   ((eq system-type 'ms-dos) str)
   (t
    (let ((ret "") (p 0) pp)
      (while (setq pp (string-match "[][{}*?<>\"\']" str p))
	(setq ret (concat ret (substring str p pp)
			  "\"" (substring str pp (1+ pp)) "\"")
	      p (1+ pp)))
      (setq ret (concat ret (substring str p)))))))

(defun javaplus-start-run ()
  "カレントバッファから生成された *.class にたいするjavaインタプリタの起動."
  (or javaplus:current-package
      (javaplus-read-package-name))
  (let* ((bfn (file-name-nondirectory buffer-file-name))
	 (class (substring bfn 0 (string-match "\\.java?$" bfn)))
	 (fullclass class)
	 classfile (dir ".") args)
    (if javaplus:current-package
	(setq fullclass (concat javaplus:current-package "." fullclass)))
    (cd (file-name-directory buffer-file-name))
    (let ((n (javaplus*n-of-. fullclass)))
      (while (> n 0)
	(setq dir (concat dir "/.."))
	(setq n (1- n))))
    (setq dir (expand-file-name dir))
    ;(setq classfile (concat (javaplus*class2path class) ".class"))
    (setq classfile (concat class ".class"))
    (if (file-exists-p classfile)
	(progn
	  (setq args
		(read-string "コマンドライン: java " fullclass))
	  (setq args (javaplus*quote-shell-metachars args))
	  (if (string< "" args) (setq args (concat " " args)))
	  (javaplus-start-command
	   "java"
	   (concat javaplus:path-java " " args)
	   dir)
	  (message "Starting java interpreter for %s..." class))
      (message "先にコンパイルして %s を作りましょう." classfile))))

(defun javaplus-start-appletviewer ()
  "カレントバッファの *.html にたいするappletviewerの起動"
  (interactive)
  (let* ((bfn (file-name-nondirectory buffer-file-name))
	 (html (concat (substring bfn 0 (string-match "\\.java?$" bfn))
		       ".html")))
    (cd (file-name-directory buffer-file-name))
    (if (file-exists-p html)
	(progn
	  (javaplus-start-command
	   "appletviewer"
	   (concat javaplus:path-appletviewer " " html))
	  (message "Starting Applet Viewer for %s..." html))
      (message "まず %s を作る必要があります." html))))

(defun javaplus-kill-processes ()
  "javaに関連する走行中のプロセスを全てkill"
  (interactive)
  (let ((list (process-list)) prc)
    (while list
      (setq prc (car list))
      (and (string-match "java\\|applet" (buffer-name (process-buffer prc)))
	   (y-or-n-p (format "Kill process [%s]?" prc))
	   (kill-process prc))
      (setq list (cdr list)))
    (message " ")))

(defun javaplus-process-menu ()
  "JDK環境を呼ぶためのメニュー"
  (interactive)
  (message "J)avac R)un A)ppletviewer K)ill")
  (let ((c (read-char)))
    (cond
     ((eq c ?j) (javaplus-start-compile))
     ((eq c ?r) (javaplus-start-run))
     ((eq c ?a) (javaplus-start-appletviewer))
     ((eq c ?r) (javaplus-read-package-name))
     ((eq c ?k) (javaplus-kill-processes)))))

;============================================================
;; hooks
;;;
;(add-hook 'java-mode-hook
;	  '(lambda ()
;	     (define-key java-mode-map "\C-c\C-t" 'javaplus-process-menu)))


; (start-process "apv" "hoge" "start" "lissajous.html")

; (start-process "apv" "hoge" "c:\\command"
; 	       "/cc:\\usr\\local\\jdk1.1.7B\\bin\\appletviewer lissajous.html")
; (start-process "apv" "hoge" "c:\\command"
; 	       "/cc:\\bat\\appv lissajous.html")

(provide 'javaplus)