;; refe.l
;;
;; このファイルをsite-lisp以下に置いて、バイトコンパイル。
;;
;; ~/.xyzzyに
;; (require "refe")
;; 
;; (define-key *ruby-mode-map* '(#\C-c #\r) 'win-user::refe)
;; とか、好きなキーにバインド。
;;

(eval-when (:compile-toplevel :load-toplevel :execute)
  (require "wip/winapi"))

(in-package "win-user")

(export '(refe
		  *refe-font-size*
		  *refe-default-alpha*
		  *refe-limit*
		  *refe-height*
		  *refe-width*))

(defconstant *refe-class* "refe-class")
(defvar *hwnd-refe* nil)
(defvar *refe-dc-handle* nil)

;; ポップアップウィンドウのフォントサイズ
(defvar *refe-font-size* 14)
;; 透過ウィンドウのアルファ値 0-255で値が大きくなるほど透過しない
(defvar *refe-default-alpha* 200)
;; ポップアップウィンドウが非表示になるまでの秒数
(defvar *refe-limit* 30)
;; ポップアップウィンドウのサイズ。表示後に変更可
(defvar *refe-height* 600)
(defvar *refe-width* 400)

(defun refe (word)
  (ed:interactive "sSearch reference: ")
  (refe-pop word))

; dll関数の登録
(c:define-dll-entry winapi:LONG GetWindowLong (winapi:HWND c:int) "user32" "GetWindowLongA")
(c:define-dll-entry winapi:LONG SetWindowLong (winapi:HWND c:int winapi:LONG) "user32" "SetWindowLongA")
(c:define-dll-entry winapi:LONG SetLayeredWindowAttributes (winapi:HWND winapi:DWORD winapi:BYTE winapi:DWORD) "user32")
(c:define-dll-entry c:int DrawText (winapi:HDC winapi:LPCSTR c:int (winapi:RECT *) winapi:UINT) "user32" "DrawTextA")
;; api.lでdefineされていたらコメントアウト
;; それでも名前の衝突が起こったらGWL_EXSTYLEを直接-20に置き換え(笑)
;;(c:*define GWL_EXSTYLE  -20)
(c:*define SW_SHOWNA 8)
(c:*define WS_EX_TOOLWINDOW #x00000080)

(defun set-layered-window (hwnd alpha)
  (let ((ex-style (GetWindowLong hwnd GWL_EXSTYLE)))
    (SetWindowLong hwnd GWL_EXSTYLE (logior ex-style #x80000))
    (SetLayeredWindowAttributes hwnd 0 alpha 2)))

(defun set-hide-window ()
  (let ((ex-style (GetWindowLong *hwnd-refe* GWL_EXSTYLE)))
    (SetWindowLong *hwnd-refe* GWL_EXSTYLE (logior ex-style #x80000))
    (SetLayeredWindowAttributes *hwnd-refe* 0 0 2)))
  
(defun draw-text-ex (hwnd hdc)
  (let* ((r (make-RECT))
		 (sz (make-SIZE))
		 (text (si:make-string-chunk *refe-result-string*))
		 (l (- (si:chunk-size text) 1))
		 ofont)
	(let ((lf (make-LOGFONT)))
	  (si:clear-chunk lf)
	  (setf (LOGFONT-lfHeight lf) *refe-font-size*)
	  (setf (LOGFONT-lfCharSet lf) SHIFTJIS_CHARSET)
	  (si:pack-string lf (c-struct-offset-of LOGFONT winapi::lfFaceName)
					  "ＭＳ ゴシック")
	  (setq ofont (SelectObject hdc (CreateFontIndirect lf))))
	(GetClientRect hwnd r)
	(GetTextExtentPoint32 hdc text l sz)
	(setf (RECT-right r) (- (RECT-right r) 5))
	(setf (RECT-left r) (+ (RECT-left r) 10))
	(setf (RECT-top r) (+ (RECT-top r) 10))
	(setf (RECT-bottom r) (- (RECT-bottom r) 5))
	(DrawText hdc text l r 16)
	(DeleteObject (SelectObject hdc ofont))
	;; 透過ウィンドウにしない場合はコメントアウト
	(set-layered-window *hwnd-refe* *refe-default-alpha*)
	(ShowWindow hwnd SW_SHOWNA)
	))

(unless (fboundp 'refe-wndproc-stub)
  (defun-c-callable LRESULT refe-wndproc-stub ((HWND hwnd) (UINT msg) (WPARAM wparam) (LPARAM lparam))
					(refe-wndproc hwnd msg wparam lparam)))

(defun refe-wndproc (hwnd msg wparam lparam)
  (cond ((= msg WM_NCDESTROY)
		 (setq *hwnd-refe* nil))
		((= msg WM_PAINT)
		 (let* ((ps (make-PAINTSTRUCT))
				(hdc (BeginPaint hwnd ps)))
		   (draw-text-ex hwnd hdc)
		   (EndPaint hwnd ps))
		 (return-from refe-wndproc 0))
		)
  (DefWindowProc hwnd msg wparam lparam))

(defun register-refe-window ()
  (let ((wc (make-WNDCLASS)))
	(setf (WNDCLASS-style wc) (logior CS_HREDRAW CS_VREDRAW))
	(setf (WNDCLASS-lpfnWndProc wc) #'refe-wndproc-stub)
	(setf (WNDCLASS-cbClsExtra wc) 0)
	(setf (WNDCLASS-cbWndExtra wc) 0)
	(setf (WNDCLASS-hInstance wc) (GetModuleHandle 0))
	(setf (WNDCLASS-hIcon wc) (LoadIcon 0 (MAKEINTRESOURCE IDI_APPLICATION)))
	(setf (WNDCLASS-hCursor wc) (LoadCursor 0 (MAKEINTRESOURCE IDC_ARROW)))
	(setf (WNDCLASS-hbrBackground wc) (+ 1 5))
	(setf (WNDCLASS-lpszMenuName wc) 0)
	(setf (WNDCLASS-lpszClassName wc)
		  (si:make-string-chunk *refe-class*))
	(RegisterClass wc)))

(defun create-refe-window ()
  (let ((hwnd (CreateWindowEx WS_EX_TOOLWINDOW (si:make-string-chunk *refe-class*)
							(si:make-string-chunk "Refe")
							WS_OVERLAPPEDWINDOW
							;;WS_POPUPWINDOW
							CW_USEDEFAULT CW_USEDEFAULT
							*refe-height* *refe-width*
							0 0 (GetModuleHandle 0) 0)))
	(UpdateWindow hwnd)
	hwnd))

(defun refe-init ()
  (cond (*hwnd-refe*
		 (InvalidateRect *hwnd-refe* 0 1)
		 (UpdateWindow *hwnd-refe*))
		(t
		 (register-refe-window)
		 (setq *hwnd-refe* (create-refe-window))
		 (setf ps (make-PAINTSTRUCT))
		 (setq *refe-dc-handle* (BeginPaint *hwnd-refe* ps))
		 )))

(defvar *refe-result-string* nil)
(defun refe-pop (word)
  (ed:save-window-excursion
	(let ((outbuffer nil)
		  (outstr nil))
	  (setq outbuffer (ed:create-new-buffer "refe output"))
	  ;; cygwinが入っていない場合はバッチファイルを指定？バッチファイルを使う場合の指定方法は知らん(笑)
	  (ed:execute-shell-command (ed:concat "bash -t -c 'refe " word "'") :output outbuffer)
	  (ed:set-buffer outbuffer)
	  (setq *refe-result-string* (ed:buffer-substring (ed:point-min) (ed:point-max)))
	  (ed:delete-buffer outbuffer)
	  (refe-init)
	  (draw-text-ex *hwnd-refe* *refe-dc-handle*)
	  ;; 非表示にしない場合は下の2行をコメントアウトする
	  (ed:stop-timer 'set-hide-window)
	  (ed:start-timer *refe-limit* 'set-hide-window t)
	  )))

;;EOF