Menu
▾
▴
[Win32forth-cvs] win32forth/src Class-errs.f, NONE, 1.1 CHILDWND.F, 1.11, 1.12 CONTROL.F, 1.11, 1.12 Class.f, 1.36, 1.37
|
From: George H. <geo...@us...> - 2011-07-21 18:26:23
|
Update of /cvsroot/win32forth/win32forth/src
In directory vz-cvs-4.sog:/tmp/cvs-serv21602
Modified Files:
CHILDWND.F CONTROL.F Class.f
Added Files:
Class-errs.f
Log Message:
Added Class-errs.f for object compiler error messages (work in progress) and minor optimisations
Index: CHILDWND.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/CHILDWND.F,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** CHILDWND.F 9 May 2007 07:46:40 -0000 1.11
--- CHILDWND.F 21 Jul 2011 18:26:20 -0000 1.12
***************
*** 125,130 ****
:M AutoSize: ( -- )
\ *G Size the window to fit into the client area of the parent window.
! tempRect.AddrOf GetClientRect: Parent
! 0 0 Right: tempRect Bottom: tempRect \ x,y,h,w
Move: self
;M
--- 125,130 ----
:M AutoSize: ( -- )
\ *G Size the window to fit into the client area of the parent window.
! winRect GetClientRect: Parent
! 0 0 Right: winRect Bottom: winRect \ x,y,h,w
Move: self
;M
Index: Class.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/Class.f,v
retrieving revision 1.36
retrieving revision 1.37
diff -C2 -d -r1.36 -r1.37
*** Class.f 6 Aug 2010 20:03:27 -0000 1.36
--- Class.f 21 Jul 2011 18:26:21 -0000 1.37
***************
*** 11,14 ****
--- 11,16 ----
cr .( Loading Class.f : Primitive Object Class...)
+ REQUIRE CLASS-ERRS.F
+
-4105 constant warn_clash
***************
*** 39,46 ****
\ ** produce a valid object address. \n
\ ** An compile-time error also occurs if [[ isn't preceeded by a selector.
! true abort" [[ must be preceeded by a selector " ; IMMEDIATE
: ** ( -- )
! true abort" ** must be preceeded by a selector " ; immediate
private classes internal
--- 41,48 ----
\ ** produce a valid object address. \n
\ ** An compile-time error also occurs if [[ isn't preceeded by a selector.
! THROW_NEED_SEL THROW ; IMMEDIATE
: ** ( -- )
! THROW_NEED_SEL THROW ; immediate
private classes internal
***************
*** 52,56 ****
: >selector ( str -- SelID ) \ get a selector from the input stream
! ?isSel 0= abort" not a selector" count method-hash ;
: getSelect ( -- SelID ) \ get a selector from the input stream
--- 54,58 ----
: >selector ( str -- SelID ) \ get a selector from the input stream
! ?isSel 0= THROW_NOT_SEL ?THROW count method-hash ;
: getSelect ( -- SelID ) \ get a selector from the input stream
--- NEW FILE: Class-errs.f ---
\ $Id: Class-errs.f,v 1.1 2011/07/21 18:26:21 georgeahubert Exp $
\ : .THROW-CODES CELL+ DUP @ 6 .R 6 SPACES CELL+ COUNT TYPE CR ;
\ : THROW-CODES CR ['] .THROW-CODES THROW_MSGS DO-LINK ;
\ Throw codes for classes
-350
DUP 1- SWAP CONSTANT THROW_NEED_SEL
DUP 1- SWAP CONSTANT THROW_NOT_SEL
DUP 1- SWAP CONSTANT THROW_NO_BITS
DUP 1- SWAP CONSTANT THROW_ZERO_BITS
DUP 1- SWAP CONSTANT THROW_BIG_BITS
DUP 1- SWAP CONSTANT THROW_NOT_SELF
DUP 1- SWAP CONSTANT THROW_NOT_IN_CLASS
DUP 1- SWAP CONSTANT THROW_IVAR_EXISTS
DUP 1- SWAP CONSTANT THROW_NEW>
DUP 1- SWAP CONSTANT THROW_NOT_CLASS_OR_OBJ
DUP 1- SWAP CONSTANT THROW_NO_CLONE
DUP 1- SWAP CONSTANT THROW_NOT_CLASS
DUP 1- SWAP CONSTANT THROW_NOT_OBJ
DUP 1- SWAP CONSTANT THROW_NOT_METHOD
DUP 1- SWAP CONSTANT THROW_INVALID_OBJ_REF
DUP 1- SWAP CONSTANT THROW_NO_FIND_VAR
DUP 1- SWAP CONSTANT THROW_INVALID_IVAR
DUP 1- SWAP CONSTANT THROW_NO_FIND_OBJ
DUP 1- SWAP CONSTANT THROW_OBJ_EXPO
DUP 1- SWAP CONSTANT THROW_NO_WM
DUP 1- SWAP CONSTANT THROW_METH_BUFF_OVERFLOW
DUP 1- SWAP CONSTANT THROW_INDEX_OFR
DUP 1- SWAP CONSTANT THROW_DISPOSE_ERR
DUP 1- SWAP CONSTANT THROW_UNDEF_METH
DROP
THROW_MSGS LINK, THROW_NEED_SEL , ," must be preceeded by a selector "
THROW_MSGS LINK, THROW_NOT_SEL , ," not a selector"
THROW_MSGS LINK, THROW_NO_BITS , ," Bit fields are not allowed on this data type"
THROW_MSGS LINK, THROW_ZERO_BITS , ," Zero length bit fields are not allowed"
THROW_MSGS LINK, THROW_BIG_BITS , ," Bit field exceeded bits allowed in this field"
THROW_MSGS LINK, THROW_NOT_SELF , ," Use only for self-reference to object"
THROW_MSGS LINK, THROW_NOT_IN_CLASS , ," Not in a class"
THROW_MSGS LINK, THROW_IVAR_EXISTS , ," Duplicate Instance Variable"
THROW_MSGS LINK, THROW_NEW> , ," Use: New> classname"
THROW_MSGS LINK, THROW_NOT_CLASS_OR_OBJ , ," not a class or object"
THROW_MSGS LINK, THROW_NO_CLONE , ," Can only clone Objects"
THROW_MSGS LINK, THROW_NOT_CLASS , ," Classes must start with :Class or |Class"
THROW_MSGS LINK, THROW_NOT_OBJ , ," Objects must start with :Object"
THROW_MSGS LINK, THROW_NOT_METHOD , ," Methods must START with :M !"
THROW_MSGS LINK, THROW_INVALID_OBJ_REF , ," Invalid object type"
THROW_MSGS LINK, THROW_NO_FIND_VAR , ," Can't find Variable"
THROW_MSGS LINK, THROW_INVALID_IVAR , ," Can ONLY use DOT notation on BYTE, SHORT, INT, BYTES or RECORD:"
THROW_MSGS LINK, THROW_NO_FIND_OBJ , ," Can't find object"
THROW_MSGS LINK, THROW_OBJ_EXPO , ," No object exposed"
THROW_MSGS LINK, THROW_NO_WM , ," Must be preceeded by a WM_MESSAGE"
THROW_MSGS LINK, THROW_METH_BUFF_OVERFLOW , ," Unresolved Methods buffer overflow!"
THROW_MSGS LINK, THROW_INDEX_OFR , ," Index out of range"
THROW_MSGS LINK, THROW_DISPOSE_ERR , ," Disposing Object failed!"
THROW_MSGS LINK, THROW_UNDEF_METH , ," Undefined Method"
Index: CONTROL.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/CONTROL.F,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** CONTROL.F 15 Feb 2010 22:42:56 -0000 1.11
--- CONTROL.F 21 Jul 2011 18:26:21 -0000 1.12
***************
*** 187,192 ****
:M AutoSize: ( -- )
\ *G Size the window to fit into the client area of the parent window.
! tempRect.AddrOf GetClientRect: Parent
! 0 0 Right: tempRect Bottom: tempRect \ x,y,h,w
Move: self
;M
--- 187,192 ----
:M AutoSize: ( -- )
\ *G Size the window to fit into the client area of the parent window.
! winRect GetClientRect: Parent
! 0 0 Right: winRect Bottom: winRect \ x,y,h,w
Move: self
;M
|
