From 15e9575cb69af8c9213ee5094df8fdebefb33277 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <wayo.cavazos@gmail.com>
Date: Mon, 14 Jan 2008 05:19:00 -0600
Subject: [PATCH] Mortar defined and used parsing words. Refactor this.
---
extra/factory/factory-menus | 2 +-
extra/factory/factory.factor | 2 +-
extra/mortar/mortar.factor | 15 +++++++++++----
extra/mortar/sugar/sugar.factor | 6 ++++++
extra/x/gc/gc.factor | 3 ++-
extra/x/pen/pen.factor | 2 +-
extra/x/widgets/button/button.factor | 4 ++--
extra/x/widgets/keymenu/keymenu.factor | 2 +-
extra/x/widgets/label/label.factor | 2 +-
extra/x/widgets/wm/frame/drag/move/move.factor | 2 +-
extra/x/widgets/wm/frame/drag/size/size.factor | 2 +-
extra/x/widgets/wm/frame/frame.factor | 2 +-
extra/x/widgets/wm/menu/menu.factor | 2 +-
13 files changed, 30 insertions(+), 16 deletions(-)
create mode 100644 extra/mortar/sugar/sugar.factor
diff --git a/extra/factory/factory-menus b/extra/factory/factory-menus
index dd5dc29378..fa72fa6c9a 100644
--- a/extra/factory/factory-menus
+++ b/extra/factory/factory-menus
@@ -1,6 +1,6 @@
! -*-factor-*-
-USING: kernel unix vars mortar slot-accessors
+USING: kernel unix vars mortar mortar.sugar slot-accessors
x.widgets.wm.menu x.widgets.wm.unmapped-frames-menu
factory.commands factory.load ;
diff --git a/extra/factory/factory.factor b/extra/factory/factory.factor
index a5755c2a67..ca534f12c1 100644
--- a/extra/factory/factory.factor
+++ b/extra/factory/factory.factor
@@ -1,6 +1,6 @@
USING: kernel parser io io.files namespaces sequences editors threads vars
- mortar slot-accessors
+ mortar mortar.sugar slot-accessors
x
x.widgets.wm.root
x.widgets.wm.frame
diff --git a/extra/mortar/mortar.factor b/extra/mortar/mortar.factor
index c7522e1db6..b7862af7ac 100644
--- a/extra/mortar/mortar.factor
+++ b/extra/mortar/mortar.factor
@@ -128,7 +128,7 @@ over object-class class-methods 1 head* assoc-stack call ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-: new* ( class -- object ) <<- create ;
+! : new* ( class -- object ) <<- create ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -136,13 +136,20 @@ IN: slot-accessors
IN: mortar
+! : generate-slot-getter ( name -- )
+! "$" over append "slot-accessors" create swap [ slot-value ] curry
+! define-compound ;
+
: generate-slot-getter ( name -- )
-"$" over append "slot-accessors" create swap [ slot-value ] curry
-define-compound ;
+"$" over append "slot-accessors" create swap [ slot-value ] curry define ;
+
+! : generate-slot-setter ( name -- )
+! ">>" over append "slot-accessors" create swap [ swap set-slot-value ] curry
+! define-compound ;
: generate-slot-setter ( name -- )
">>" over append "slot-accessors" create swap [ swap set-slot-value ] curry
-define-compound ;
+define ;
: generate-slot-accessors ( name -- )
dup
diff --git a/extra/mortar/sugar/sugar.factor b/extra/mortar/sugar/sugar.factor
new file mode 100644
index 0000000000..04d2f6f651
--- /dev/null
+++ b/extra/mortar/sugar/sugar.factor
@@ -0,0 +1,6 @@
+
+USING: mortar ;
+
+IN: mortar.sugar
+
+: new* ( class -- object ) <<- create ;
\ No newline at end of file
diff --git a/extra/x/gc/gc.factor b/extra/x/gc/gc.factor
index 77e5313d00..8db610a1ac 100644
--- a/extra/x/gc/gc.factor
+++ b/extra/x/gc/gc.factor
@@ -1,5 +1,6 @@
-USING: kernel namespaces arrays x11.xlib mortar slot-accessors x x.font ;
+USING: kernel namespaces arrays x11.xlib mortar mortar.sugar
+ slot-accessors x x.font ;
IN: x.gc
diff --git a/extra/x/pen/pen.factor b/extra/x/pen/pen.factor
index c4fc6cfa9f..59b8aeea44 100644
--- a/extra/x/pen/pen.factor
+++ b/extra/x/pen/pen.factor
@@ -1,5 +1,5 @@
-USING: kernel arrays math.vectors mortar x.gc slot-accessors geom.pos ;
+USING: kernel arrays math.vectors mortar mortar.sugar x.gc slot-accessors geom.pos ;
IN: x.pen
diff --git a/extra/x/widgets/button/button.factor b/extra/x/widgets/button/button.factor
index b26431c4c2..ea46b62a69 100644
--- a/extra/x/widgets/button/button.factor
+++ b/extra/x/widgets/button/button.factor
@@ -1,6 +1,6 @@
USING: kernel combinators math x11.xlib
- mortar slot-accessors x.gc x.widgets.label ;
+ mortar mortar.sugar slot-accessors x.gc x.widgets.label ;
IN: x.widgets.button
@@ -11,7 +11,7 @@ SYMBOL: <button>
{ "action-1" "action-2" "action-3" } accessors
define-simple-class
-<button> "create" ( <button> -- button ) [
+<button> "create" !( <button> -- button ) [
new-empty
<gc> new* >>gc ExposureMask ButtonPressMask bitor >>mask <- init-widget
] add-class-method
diff --git a/extra/x/widgets/keymenu/keymenu.factor b/extra/x/widgets/keymenu/keymenu.factor
index 6c2fbb1e5c..b10f8f5593 100644
--- a/extra/x/widgets/keymenu/keymenu.factor
+++ b/extra/x/widgets/keymenu/keymenu.factor
@@ -1,6 +1,6 @@
USING: kernel strings arrays sequences sequences.lib math x11.xlib
- mortar slot-accessors x x.pen x.widgets ;
+ mortar mortar.sugar slot-accessors x x.pen x.widgets ;
IN: x.widgets.keymenu
diff --git a/extra/x/widgets/label/label.factor b/extra/x/widgets/label/label.factor
index 11201ae9fc..39eff20221 100644
--- a/extra/x/widgets/label/label.factor
+++ b/extra/x/widgets/label/label.factor
@@ -1,5 +1,5 @@
-USING: kernel x11.xlib mortar slot-accessors x.gc x.widgets ;
+USING: kernel x11.xlib mortar mortar.sugar slot-accessors x.gc x.widgets ;
IN: x.widgets.label
diff --git a/extra/x/widgets/wm/frame/drag/move/move.factor b/extra/x/widgets/wm/frame/drag/move/move.factor
index 2ebb5a7286..2a6d61596e 100644
--- a/extra/x/widgets/wm/frame/drag/move/move.factor
+++ b/extra/x/widgets/wm/frame/drag/move/move.factor
@@ -1,6 +1,6 @@
USING: kernel combinators namespaces math.vectors x11.xlib x11.constants
- mortar slot-accessors x x.gc x.widgets.wm.frame.drag ;
+ mortar mortar.sugar slot-accessors x x.gc x.widgets.wm.frame.drag ;
IN: x.widgets.wm.frame.drag.move
diff --git a/extra/x/widgets/wm/frame/drag/size/size.factor b/extra/x/widgets/wm/frame/drag/size/size.factor
index e98d75259a..5ef28e2a41 100644
--- a/extra/x/widgets/wm/frame/drag/size/size.factor
+++ b/extra/x/widgets/wm/frame/drag/size/size.factor
@@ -1,6 +1,6 @@
USING: kernel combinators namespaces math.vectors x11.xlib x11.constants
- mortar slot-accessors geom.rect x x.gc x.widgets.wm.frame.drag ;
+ mortar mortar.sugar slot-accessors geom.rect x x.gc x.widgets.wm.frame.drag ;
IN: x.widgets.wm.frame.drag.size
diff --git a/extra/x/widgets/wm/frame/frame.factor b/extra/x/widgets/wm/frame/frame.factor
index 0c0075ed3b..d8f08d8772 100644
--- a/extra/x/widgets/wm/frame/frame.factor
+++ b/extra/x/widgets/wm/frame/frame.factor
@@ -2,7 +2,7 @@
USING: kernel io combinators namespaces quotations arrays sequences
math math.vectors
x11.xlib x11.constants
- mortar slot-accessors
+ mortar mortar.sugar slot-accessors
geom.rect
x x.gc x.widgets
x.widgets.button
diff --git a/extra/x/widgets/wm/menu/menu.factor b/extra/x/widgets/wm/menu/menu.factor
index e836b21374..ca79b35136 100644
--- a/extra/x/widgets/wm/menu/menu.factor
+++ b/extra/x/widgets/wm/menu/menu.factor
@@ -1,5 +1,5 @@
-USING: kernel x11.constants mortar slot-accessors x.widgets.keymenu ;
+USING: kernel x11.constants mortar mortar.sugar slot-accessors x.widgets.keymenu ;
IN: x.widgets.wm.menu