Created
May 2, 2012 11:00
-
-
Save southly/2575861 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;;;; -*- Mode: Lisp -*- | |
;; (get-window-handle :filer) | |
;; で、ファイラのウィンドウハンドルが取得できる必要がある。 | |
;; | |
;; ttray.l を書き換えた方がいろいろ自然だけどサンプルということで。 | |
(provide "ttray-addon") | |
(eval-when (:compile-toplevel :load-toplevel :execute) | |
(require "foreign") | |
(require "wip/winapi") | |
(require "ttray")) | |
(in-package "win-user") | |
(when *ttray-wc* | |
(ttray-cleanup)) | |
(defvar *ttray-filer-status* t) | |
; toggle filer | |
(defun ttray-toggle-filer () | |
(if (and (ignore-errors (ed::get-window-handle :filer)) | |
*ttray-filer-status*) | |
(ttray-hide-filer) | |
(ttray-show-filer))) | |
; hide filer | |
(defun ttray-hide-filer () | |
(let ((hwnd (ignore-errors (ed::get-window-handle :filer)))) | |
(when (and hwnd *ttray-filer-status*) | |
(setq *ttray-filer-status* nil) | |
(ShowWindow hwnd SW_HIDE)))) | |
; show filer | |
(defun ttray-show-filer () | |
(let ((hwnd (ignore-errors (ed::get-window-handle :filer)))) | |
(cond ((and hwnd *ttray-filer-status*) | |
(SetForegroundWindow (ed::get-window-handle :filer))) | |
((null hwnd) | |
(setq *ttray-filer-status* t) | |
(ed::open-filer)) | |
(t | |
(setq *ttray-filer-status* t) | |
(ShowWindow hwnd SW_SHOW) | |
(PostMessage hwnd WM_SHOWWINDOW 1 0) | |
(unless (zerop (IsIconic hwnd)) | |
(ShowWindow hwnd SW_RESTORE)))))) | |
(defun ttray-toggle-both () | |
(cond (*ttray-status* | |
(ttray-hide-xyzzy) | |
(ttray-hide-filer)) | |
(t | |
(ttray-show-xyzzy) | |
(and (ignore-errors (ed::get-window-handle :filer)) | |
(ttray-show-filer))))) | |
(setf *ttray-menu-list* | |
'(; 書式 1:name 2:checked 3:show-after-function 4:function | |
("エディタ(&e)" nil nil ttray-toggle-xyzzy) | |
("ファイラ(&f)" nil nil ttray-toggle-filer) | |
:sep | |
("終了(&X)" nil nil | |
; wndprocからのkillは危険な気がするのでメッセージを通知 | |
(lambda () (PostMessage (ed::get-window-handle) WM_CLOSE 0 0))))) | |
; window procedure | |
(defun-c-callable LRESULT ttray-wndproc | |
((HWND hwnd) (UINT msg) (WPARAM wparam) (LPARAM lparam)) | |
(cond ((= msg WM_NCDESTROY) | |
(setq break-loop t)) | |
((= msg WM_PAINT) | |
(let* ((ps (make-PAINTSTRUCT)) | |
(hdc (BeginPaint hwnd ps))) | |
(EndPaint hwnd ps)) | |
(return-from ttray-wndproc 0)) | |
; initmenupopup | |
((= msg WM_INITMENUPOPUP) | |
(when *ttray-initmenupopup-hook* | |
(funcall *ttray-initmenupopup-hook*)) | |
(return-from ttray-wndproc 0)) | |
; tasktray | |
((= msg WM_TTRAY_NOTIFY) | |
(cond ; popup menu | |
((= lparam WM_RBUTTONUP) (ttray-popup-menu)) | |
; activation / deactivation | |
((= lparam WM_LBUTTONDOWN) (ttray-toggle-both)) | |
((= lparam WM_LBUTTONDBLCLK) (ttray-toggle-both))) | |
(return-from ttray-wndproc 0)) | |
; popup-function | |
((= msg WM_COMMAND) | |
(ttray-popup-callback (LOWORD wparam)) | |
(return-from ttray-wndproc 0))) | |
(DefWindowProc hwnd msg wparam lparam)) | |
(if (member "startup" *modules* :test #'string=) | |
(ttray-setup) | |
(ed::add-hook 'ed::*post-startup-hook* 'ttray-setup)) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment