]> gitweb.factorcode.org Git - factor.git/commitdiff
Merge branch 'master' of git://factorcode.org/git/factor
authorJoe Groff <arcata@gmail.com>
Tue, 10 Jun 2008 01:24:10 +0000 (18:24 -0700)
committerJoe Groff <arcata@gmail.com>
Tue, 10 Jun 2008 01:24:10 +0000 (18:24 -0700)
1  2 
extra/ui/windows/windows.factor

index 6b2abcbd7618148ca4fcfbc3f0db311ca86c966b,4a9417fc6b5f65bddf27f215efffdded427e940f..3fc5d4abcd8fac94968ff0095a5fe47b507d6fd4
@@@ -3,7 -3,7 +3,7 @@@
  ! See http://factorcode.org/license.txt for BSD license.
  USING: alien alien.c-types alien.strings arrays assocs ui
  ui.gadgets ui.backend ui.clipboards ui.gadgets.worlds
- ui.gestures io kernel math math.vectors namespaces prettyprint
+ ui.gestures io kernel math math.vectors namespaces
  sequences strings vectors words windows.kernel32 windows.gdi32
  windows.user32 windows.opengl32 windows.messages windows.types
  windows.nt windows threads libc combinators continuations
@@@ -13,8 -13,11 +13,11 @@@ IN: ui.window
  
  SINGLETON: windows-ui-backend
  
- : crlf>lf CHAR: \r swap remove ;
- : lf>crlf [ [ dup CHAR: \n = [ CHAR: \r , ] when , ] each ] "" make ;
+ : crlf>lf ( str -- str' )
+     CHAR: \r swap remove ;
+ : lf>crlf ( str -- str' )
+     [ [ dup CHAR: \n = [ CHAR: \r , ] when , ] each ] "" make ;
  
  : enum-clipboard ( -- seq )
      0
@@@ -127,7 -130,7 +130,7 @@@ SYMBOLS: msg-obj class-name-ptr mouse-c
          { 123 "F12" }
      } ;
  
- : key-state-down?
+ : key-state-down? ( key -- ? )
      GetKeyState 16 bit? ;
  
  : left-shift? ( -- ? ) VK_LSHIFT key-state-down? ;
@@@ -380,7 -383,7 +383,7 @@@ SYMBOL: trace-messages
      "uint" { "void*" "uint" "long" "long" } "stdcall" [
          [
              pick
-             trace-messages? get-global [ dup windows-message-name . ] when
+             trace-messages? get-global [ dup windows-message-name word-name print flush ] when
              wm-handlers get-global at* [ call ] [ drop DefWindowProc ] if
          ] ui-try
       ] alien-callback ;
@@@ -503,9 -506,6 +506,9 @@@ M: windows-ui-backend u
          ] [ cleanup-win32-ui ] [ ] cleanup
      ] ui-running ;
  
 +M: windows-ui-backend beep ( -- )
 +    0 MessageBeep drop ;
 +
  windows-ui-backend ui-backend set-global
  
  [ "ui" ] main-vocab-hook set-global