home *** CD-ROM | disk | FTP | other *** search
/ Chip 2004 July / CHIP_CD_2004-07.iso / software / nncron_hit / files / nncron189.exe / plugins / win2tray.spf < prev    next >
Encoding:
Text File  |  2004-03-27  |  6.5 KB  |  287 lines
  1. \ File:         win2tray.spf
  2. \ Author:       Nicholas Nemtsev
  3. \ Date:         22.03.2003
  4. \ Modified:     08.11.2003 (crash bug fixed)
  5. \ Modified:     18.11.2003 (ADD-HOST bug fixed)
  6. \ Modified:     28.03.2004 (Crash fixed (Win NT))
  7. \ Description:  Place windows to system tray
  8.  
  9. \ Usage: [ALL] WIN-TO-TRAY: "pattern"
  10.  
  11.  
  12. WINAPI: GetClassLongA USER32.DLL
  13. WINAPI: LoadImageA USER32.DLL
  14.  
  15. \ : LoadIcon ( addr u -- h )
  16. \  DROP >R
  17. \  ( LR_LOADFROMFILE) 16 16 16 IMAGE_ICON R> 0 LoadImageA
  18. \ ;
  19.  
  20. 5 CONSTANT SW_SHOW
  21. 6 CONSTANT SW_MINIMIZE
  22. 9 CONSTANT SW_RESTORE
  23. 0 CONSTANT SW_HIDE
  24.  
  25. 1000 VALUE W2T-DELAY
  26.  
  27. 127 CONSTANT WM_GETICON
  28. -34 CONSTANT GCLP_HICONSM
  29.  
  30. : (WIN-ICON) ( hwnd -- hicon )
  31.     >R
  32.     0 0 WM_GETICON R@ SendMessageA ?DUP 0=
  33.     IF
  34.         -34 R@ GetClassLongA ?DUP 0=
  35.         IF  0x7F00 0 LoadIconA THEN
  36.     THEN
  37.     RDROP
  38. ;
  39.  
  40. USER AppIconHwnd    \ handle of app window
  41. USER AppIconHandle  \ handle of app icon
  42. USER AppIcon        \ tray icon id
  43. VARIABLE TRAY-LIST
  44. VARIABLE TRAY-ICON-LIST
  45.  
  46. : AppRest  0 PostQuitMessage DROP ;
  47.  
  48. : ADD-TI ( a u hicon  -- id )
  49.     GLOBAL TrayIcon NEW LOCAL >R
  50.     R@ ->CLASS TrayIcon Create
  51.     R@ TRAY-ICON-LIST GLOBAL AddNode LOCAL
  52.     R>
  53. ;
  54.  
  55. : DEL-TI ( id -- )
  56.   DUP TRAY-ICON-LIST GLOBAL DelNode LOCAL
  57.   ->CLASS TrayIcon Delete
  58. ;
  59.  
  60. : MODIFY-TI ( a u hicon id -- )
  61.   >R
  62.   R@ ->CLASS TrayIcon ModifyIcon
  63.   R> ->CLASS TrayIcon ModifyText
  64. ;
  65.  
  66. : W2T-TITLE 256 PAD AppIconHwnd @ GetWindowTextA PAD SWAP ;
  67.  
  68. :NONAME { time event msg hwnd -- }
  69.     0 SP@ event CELL+ @ GetWindowThreadProcessId NIP
  70.     IF
  71.         256 PAD event CELL+ @ GetWindowTextA PAD SWAP
  72.         event 2 CELLS + @ event @ MODIFY-TI
  73.     ELSE
  74.     \ delete tray icon
  75.         AppRest
  76.     THEN
  77.     WinNT? Win2k? 0= AND IF 0 THEN
  78. ; WNDPROC: W2T-TIMER
  79.  
  80. :NONAME ( buf -- )
  81.     >R R@ @ AppIconHwnd !
  82.     R@ CELL+ @ AppIconHandle ! \ AppIcon @ ->CLASS TrayIcon Create
  83. \    TrayIcon NEW AppIcon !
  84.     W2T-TITLE AppIconHandle @ ADD-TI AppIcon !
  85.     R> GLOBAL FREE LOCAL THROW
  86.  
  87.     ['] AppRest AppIcon @ ->CLASS TrayIcon OnLB !
  88.     ['] AppRest AppIcon @ ->CLASS TrayIcon OnRB !
  89.  
  90.     SW_MINIMIZE AppIconHwnd @ ShowWindow DROP
  91.     SW_HIDE AppIconHwnd @ ShowWindow DROP
  92.     AppIconHwnd @ TRAY-LIST AddNode
  93. \    AppIcon @ TRAY-ICON-LIST AddNode
  94.     3 CELLS ALLOCATE THROW >R
  95.     AppIcon @       R@ !
  96.     AppIconHwnd @   R@ CELL+ !
  97.     AppIconHandle @ R@ 2 CELLS + !
  98.  
  99.     ['] W2T-TIMER W2T-DELAY R> AppIcon @ ->CLASS TrayIcon hWnd @ SetTimer DROP
  100.     MessageLoop
  101.     SW_SHOW AppIconHwnd @ ShowWindow DROP
  102.     SW_RESTORE AppIconHwnd @ ShowWindow DROP
  103.     AppIconHwnd @ PUSH-WINDOW DROP
  104.     100 PAUSE
  105.     AppIconHwnd @ TRAY-LIST DelNode
  106. \    AppIcon @ TRAY-ICON-LIST DelNode
  107. \    AppIcon @ ->CLASS TrayIcon Delete
  108.     AppIcon @ DEL-TI
  109. ; TASK: win-to-tray-task
  110.  
  111. : IN-TRAY? ( hwnd -- ? ) TRAY-LIST InList? 0<> ;
  112.  
  113. : WIN-TO-TRAY ( a u -- )
  114.     [NONAME
  115.         WIN-HWND IN-TRAY? 0=
  116.         IF
  117.             WIN-HWND (WIN-ICON) ?DUP
  118.             IF
  119.                 2 CELLS GLOBAL ALLOCATE LOCAL THROW >R
  120.                 R@ CELL+ !
  121.                 WIN-HWND R@ !
  122.                 R> win-to-tray-task START CLOSE-FILE DROP
  123.             THEN
  124.         THEN
  125.     NONAME] WIN-PASS
  126. ;
  127.  
  128. C" BeforeStop" FIND NIP
  129. [IF]
  130. WARNING @ WARNING 0!
  131. :NONAME NodeValue >R 0 0 0x3B R> ->CLASS TrayIcon hWnd @ PostMessageA DROP ;
  132. \ restore all windows before nnCron stopping
  133. : BeforeStop
  134.     LITERAL
  135.     TRAY-ICON-LIST @
  136.     IF
  137.         TRAY-ICON-LIST DoList
  138.         500 PAUSE
  139.     ELSE DROP THEN
  140.     BeforeStop
  141. ;
  142. WARNING !
  143. [THEN]
  144.  
  145. C" eval-string," FIND NIP
  146. [IF]
  147. : WIN-TO-TRAY: eval-string, POSTPONE WIN-TO-TRAY ; IMMEDIATE
  148.  
  149. [THEN]
  150.  
  151. \ ======================= HOST STATE =============================
  152. \ Usage: HOST-STATE: "host-name" (in nncron.ini)
  153.  
  154.  
  155. VARIABLE on-icon
  156. VARIABLE off-icon
  157. VARIABLE HOST-LIST
  158. VARIABLE <HOST-TASK>
  159. 0
  160. CELL -- .host-icon
  161. CELL -- .host-name
  162. CONSTANT /host-state
  163. \ USER host-icon
  164. \ USER host-name
  165.  
  166. WINAPI: LoadIconA USER32.DLL
  167.  
  168. VARIABLE HOST-STATE-DELAY 60 HOST-STATE-DELAY !
  169.  
  170. VARIABLE HTI-RES
  171. : set-host-ti
  172.     NodeValue >R 
  173.     R@ .host-icon @ 
  174.     IF
  175.         R@ .host-name @ ASCIIZ> 2DUP 
  176.     \    ." set-host-ti: " 2DUP TYPE CR
  177.         3 ['] PING CATCH
  178.         ?DUP IF ." Ping error # " . CR DROP 2DROP FALSE THEN
  179.         IF on-icon @ ELSE off-icon @ THEN
  180.         R@ .host-icon @ MODIFY-TI
  181.     THEN
  182.     RDROP
  183. ;
  184.  
  185. : DEL-HOST-ICONS
  186.     HTI-RES GET
  187.     [NONAME
  188.        NodeValue .host-icon @ DEL-TI
  189.     NONAME] HOST-LIST DoList
  190.     HOST-LIST 0!
  191.    
  192.     HTI-RES RELEASE
  193. ;
  194.  
  195.  
  196. : add-new-ti ( node -- )
  197.     NodeValue >R
  198.     R@ .host-icon @ 0=
  199.     IF
  200.        R@ .host-name @ ASCIIZ> off-icon @ ADD-TI
  201.        R@ .host-icon !
  202.     THEN
  203.     RDROP
  204. ;
  205.  
  206. :NONAME { dwTime idEvent uMsg hwnd -- }
  207.     HOST-LIST @ 
  208.     IF 
  209.       HTI-RES GET
  210.       ['] add-new-ti  HOST-LIST DoList
  211.       ['] set-host-ti HOST-LIST DoList
  212.       HTI-RES RELEASE
  213.     ELSE
  214.         0 PostQuitMessage DROP
  215.     THEN
  216.     0
  217. ; WNDPROC: host-state-icons-test
  218.  
  219. :NONAME ( 0 -- )
  220.     GetCurrentThreadId <HOST-TASK> !
  221.     BEGIN LOGGEDON? 0= WHILE 5000 PAUSE REPEAT
  222.     5000 PAUSE
  223.     
  224.     
  225.     ['] host-state-icons-test HOST-STATE-DELAY @ 1000 * 0 0 SetTimer >R
  226.     0 0 0 0 ['] host-state-icons-test API-CALL DROP
  227.     
  228.     MessageLoop
  229.     
  230.     R> 0 KillTimer DROP
  231.     
  232.     DEL-HOST-ICONS
  233.     <HOST-TASK> 0!
  234. ; TASK: host-state-task
  235.  
  236.  
  237. : host-in-list? { a u -- ?)
  238.     HOST-LIST
  239.     BEGIN @ ?DUP WHILE
  240.         DUP NodeValue .host-name @ ASCIIZ>
  241.         a u ICOMPARE 0= IF DROP TRUE EXIT THEN
  242.     REPEAT
  243.     FALSE
  244. ;
  245.  
  246. : ADD-HOST { a u  -- }
  247.     HTI-RES GET
  248.     on-icon @ 0=
  249.     IF
  250. \      S" ico\on.ico" LoadIcon on-icon !
  251. \      S" ico\off.ico" LoadIcon off-icon !
  252.         S" iconon" DROP HINST LoadIconA ?DUP 0=
  253.         IF
  254.            ( 0x7F05) 0x7F00 ( IDI_WINLOGO) 0 LoadIconA
  255.         THEN
  256.         on-icon !
  257.         
  258.         S" iconoff" DROP HINST LoadIconA ?DUP 0=
  259.         IF       
  260.             0x7F01 ( IDI_ERROR) 0 LoadIconA
  261.         THEN
  262.         off-icon !
  263.     THEN
  264.     a u host-in-list? 0=
  265.     IF
  266.         GLOBAL
  267.         /host-state ALLOCATE THROW >R
  268.         a u S>ZALLOC R@ .host-name !
  269.         R@ .host-icon 0!
  270.         R> HOST-LIST AddNode
  271.         LOCAL
  272.         <HOST-TASK> @ 0= IF 0 host-state-task START CLOSE-FILE DROP <HOST-TASK> ON THEN
  273.     THEN
  274.     HTI-RES RELEASE
  275. ;
  276.  
  277. WARNING @ WARNING 0!
  278. : BeforeStop
  279.     DEL-HOST-ICONS
  280.     BeforeStop
  281. ;
  282. WARNING !
  283.  
  284. : HOST-STATE ( a u -- ) RUN-FILE 0= IF ADD-HOST ELSE 2DROP THEN ;
  285.  
  286. : HOST-STATE: get-string EVAL-SUBST HOST-STATE ; IMMEDIATE
  287.