suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

allow duplicate struct properties if the values are eq?; add position-locations to text%

Browse Source 
svn: r10849
This commit is contained in:
Matthew Flatt 2008-07-21 18:54:09 +00:00
parent 763d37d775
commit 5ff75bac42
8 changed files with 205 additions and 88 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/scribblings/gui/text-class.scrbl
View File

@ -1611,7 +1611,7 @@ See @|ateoldiscuss| for a discussion of @scheme[at-eol?].
[whole-line? any/c #f])
void?]{
Returns the @techlink{location} of a given @techlink{position}.
Returns the @techlink{location} of a given @techlink{position}. See also @method[text% position-locations].
@boxisfillnull[(scheme x) @elem{the x-@techlink{location} of the @techlink{position} @scheme[start] in editor
coordinates} ]
@ -1634,6 +1634,22 @@ maximum bottom @techlink{location} for the whole line is returned in @scheme[y].
}
@defmethod[(position-locations [start nonnegative-exact-integer?]
[top-x (or/c (box/c real?) false/c) #f]
[top-y (or/c (box/c real?) false/c) #f]
[bottom-x (or/c (box/c real?) false/c) #f]
[bottom-y (or/c (box/c real?) false/c) #f]
[at-eol? any/c #f]
[whole-line? any/c #f])
void?]{
Like @method[text% position-location], but returns both the ``top''
and ``bottom'' results at once.
@|OVD| @|FCA|
}
@defmethod[(position-paragraph [start nonnegative-exact-integer?]
[at-eol? any/c #f])
nonnegative-exact-integer?]{

13
collects/scribblings/reference/struct.scrbl
View File

@ -119,12 +119,13 @@ are initialized with @scheme[auto-v]. The total field count (including
The @scheme[props] argument is a list of pairs, where the @scheme[car]
of each pair is a structure type property descriptor, and the
@scheme[cdr] is an arbitrary value. Each property in @scheme[props]
must be distinct, including properties that are automatically added by
properties that are directly included in @scheme[props]. See
@secref["structprops"] for more information about properties. When
@scheme[inspector] is @scheme['prefab], then @scheme[props] must be
@scheme[null].
@scheme[cdr] is an arbitrary value. A property can be specified
multiple times in in @scheme[props] (including properties that are
automatically added by properties that are directly included in
@scheme[props]) only if the associated values are @scheme[eq?],
otherwise the @exnraise[exn:fail:contract]. See @secref["structprops"]
for more information about properties. When @scheme[inspector] is
@scheme['prefab], then @scheme[props] must be @scheme[null].
The @scheme[inspector] argument normally controls access to reflective
information about the structure type and its instances; see

34
collects/tests/mzscheme/struct.ss
View File

@ -108,9 +108,9 @@
(make-struct-type 'bb type 0 0 #f (list (cons prop:p 12)))
(make-struct-type 'bb btype 0 0 #f (list (cons prop:p3 12)))
(err/rt-test (make-struct-type 'bb type 0 0 #f (list (cons prop:p 12) (cons prop:p 12))) exn:application:mismatch?)
(err/rt-test (make-struct-type 'bb btype 0 0 #f (list (cons prop:p3 12) (cons prop:p3 12))) exn:application:mismatch?)
(err/rt-test (make-struct-type 'bb #f 0 0 #f (list (cons prop:p 12) (cons prop:p2 12) (cons prop:p 12))) exn:application:mismatch?)
(err/rt-test (make-struct-type 'bb type 0 0 #f (list (cons prop:p 12) (cons prop:p 13))) exn:application:mismatch?)
(err/rt-test (make-struct-type 'bb btype 0 0 #f (list (cons prop:p3 12) (cons prop:p3 13))) exn:application:mismatch?)
(err/rt-test (make-struct-type 'bb #f 0 0 #f (list (cons prop:p 12) (cons prop:p2 12) (cons prop:p 13))) exn:application:mismatch?)
(err/rt-test (make-struct-type 'bb type 0 0 #f (list (cons (let-values ([(p p? p-v)
(make-struct-type-property 'p (lambda (v s)
;; this guard will fail!
@ -643,9 +643,19 @@
(let ([try
(lambda (base prop:procedure)
(err/rt-test (make-struct-type '? base 1 0 #f (list (cons prop:procedure 0)
(cons prop:procedure 0))
(cons prop:procedure 1))
#f #f '(0)))
(err/rt-test (make-struct-type '? base 1 0 #f (list (cons prop:procedure 0)) #f 0))
;; Ok to re-set to same value:
(test #t list? (call-with-values
(lambda () (make-struct-type '? base 1 0 #f (list (cons prop:procedure 0)
(cons prop:procedure 0))
#f #f '(0)))
list))
(err/rt-test (make-struct-type '? base 1 0 #f (list (cons prop:procedure 0)) #f 1))
(test #t list? (call-with-values
(lambda () (make-struct-type '? base 1 0 #f (list (cons prop:procedure 0)) #f 0))
list))
(let-values ([(prop:s s? s-get)
(make-struct-type-property 's #f (list (cons prop:procedure (lambda (v) (add1 v)))))])
(define-struct a (x y) #:super base #:property prop:s 0)
@ -655,7 +665,19 @@
(err/rt-test (make-struct-type-property 't #f 10))
(err/rt-test (make-struct-type-property 't #f (list (cons prop:s 10))))
(err/rt-test (make-struct-type-property 't #f (list (cons prop:s void) (cons prop:procedure void))))
;; Allow multiple inheritances of a property at this stage, because we can't in general
;; tell whether the results will be eq?
(test #t list?
(call-with-values
(lambda ()
(make-struct-type-property 't #f (list (cons prop:s void) (cons prop:s values))))
list))
(test #t list?
(call-with-values
(lambda ()
(make-struct-type-property 't #f (list (cons prop:s void) (cons prop:procedure values))))
list))
(let-values ([(prop:t t? t-get)
(make-struct-type-property 't #f (list (cons prop:s (lambda (v) (add1 v)))))]

85
src/mred/wxme/wx_media.cxx
View File

@ -3645,8 +3645,10 @@ long wxMediaEdit::PositionLine(long start, Bool eol)
return line->GetLine();
}
void wxMediaEdit::PositionLocation(long start, double *x, double *y,
Bool top, Bool eol, Bool wholeLine)
void wxMediaEdit::PositionLocations(long start,
double *tx, double *ty,
double *bx, double *by,
Bool eol, Bool wholeLine)
{
double horiz, h, descent, space, topy;
int align;
@ -3662,44 +3664,44 @@ void wxMediaEdit::PositionLocation(long start, double *x, double *y,
if (start <= 0) {
if (wholeLine) {
if (x) {
if (tx || bx) {
double xl;
xl = firstLine->GetLeftLocation(maxWidth);
*x = xl;
if (tx) *tx = xl;
if (bx) *bx = xl;
}
if (y) {
if (ty || by) {
double yl;
yl = firstLine->GetLocation();
*y = yl;
if (!top)
(*y) += firstLine->h;
if (ty) *ty = yl;
if (by) *by = yl + firstLine->h;
}
return;
}
line = firstLine;
} else if (start >= len) {
if (extraLine && !eol) {
if (y)
*y = totalHeight - (top ? extraLineH : 0);
if (x)
*x = 0;
if (ty) *ty = totalHeight - extraLineH;
if (by) *by = totalHeight;
if (tx) *tx = 0;
if (bx) *bx = 0;
return;
}
line = lastLine;
if (wholeLine || !len) {
if (x) {
if (tx || bx) {
double xl;
xl = line->GetRightLocation(maxWidth);
*x = xl;
if (tx) *tx = xl;
if (bx) *bx = xl;
}
if (y) {
if (ty || by) {
double yl;
yl = lastLine->GetLocation();
*y = yl;
if (!top)
(*y) += lastLine->h;
if (ty) *ty = yl;
if (by) *by = yl + lastLine->h;
}
return;
}
@ -3707,14 +3709,13 @@ void wxMediaEdit::PositionLocation(long start, double *x, double *y,
line = lineRoot->FindLine(PositionLine(start, eol));
if (wholeLine) {
if (y) {
if (by || ty) {
double yl;
yl = line->GetLocation();
*y = yl;
if (!top)
(*y) += line->h;
if (ty) *ty = yl;
if (by) *by = yl + line->h;
}
if (!x)
if (!tx && !bx)
return;
}
}
@ -3765,7 +3766,7 @@ void wxMediaEdit::PositionLocation(long start, double *x, double *y,
}
if (x) {
if (tx || bx) {
double xv;
if (start && !dc) {
@ -3778,10 +3779,11 @@ void wxMediaEdit::PositionLocation(long start, double *x, double *y,
}
xv = horiz + (start ? snip->PartialOffset(dc, horiz, topy, start) : 0);
*x = xv;
if (tx) *tx = xv;
if (bx) *bx = xv;
}
if (!wholeLine && y) {
if (!wholeLine && (ty || by)) {
if (!dc) {
dc = admin->GetDC();
if (!dc) {
@ -3793,14 +3795,22 @@ void wxMediaEdit::PositionLocation(long start, double *x, double *y,
h = descent = space = 0.0;
snip->GetExtent(dc, horiz, topy, NULL, &h, &descent, &space);
align = snip->style->GetAlignment();
if (align == wxALIGN_BOTTOM)
*y = topy + line->bottombase + descent - (top ? h : 0);
else if (align == wxALIGN_TOP)
*y = topy + line->topbase - space + (top ? 0 : h);
else {
if (align == wxALIGN_BOTTOM) {
double yl;
yl = topy + line->bottombase + descent;
if (ty) *ty = yl - h;
if (by) *by = yl;
} else if (align == wxALIGN_TOP) {
double yl;
yl = topy + line->topbase - space;
if (ty) *ty = yl;
if (by) *by = yl + h;
} else {
double yl;
h = (h - descent - space) / 2;
*y = topy + ((line->topbase + line->bottombase) / 2)
+ (top ? (- h - space) : (h + descent));
yl = topy + ((line->topbase + line->bottombase) / 2);
if (ty) *ty = yl - h - space;
if (by) *by = yl + h + descent;
}
}
@ -3808,6 +3818,15 @@ void wxMediaEdit::PositionLocation(long start, double *x, double *y,
flowLocked = fl;
}
void wxMediaEdit::PositionLocation(long start, double *x, double *y,
Bool top, Bool eol, Bool wholeLine)
{
PositionLocations(start,
top ? x : NULL, top ? y : NULL,
top ? NULL : x, top ? NULL : y,
eol, wholeLine);
}
double wxMediaEdit::LineLocation(long i, Bool top)
{
wxMediaLine *line;

4
src/mred/wxme/wx_media.h
View File

@ -272,6 +272,10 @@ class wxMediaEdit : public wxMediaBuffer
double *x = NULL, double *y = NULL,
Bool front = TRUE, Bool eol = FALSE,
Bool wholeLine = FALSE);
void PositionLocations(long start,
double *tx, double *ty,
double *bx, double *by,
Bool eol = FALSE, Bool wholeLine = FALSE);
double LineLocation(long line, Bool top = TRUE);
/* Get first/last caret position in a line: */

68
src/mred/wxs/wxs_mede.cxx
View File

@ -5607,6 +5607,71 @@ static Scheme_Object *os_wxMediaEditLineLocation(int n, Scheme_Object *p[])
return WITH_REMEMBERED_STACK(scheme_make_double(r));
}
static Scheme_Object *os_wxMediaEditPositionLocations(int n, Scheme_Object *p[])
{
WXS_USE_ARGUMENT(n) WXS_USE_ARGUMENT(p)
REMEMBER_VAR_STACK();
objscheme_check_valid(os_wxMediaEdit_class, "position-locations in text%", n, p);
nnlong x0;
double _x1;
double* x1 = &_x1;
double _x2;
double* x2 = &_x2;
double _x3;
double* x3 = &_x3;
double _x4;
double* x4 = &_x4;
Bool x5;
Bool x6;
Scheme_Object *sbox_tmp;
SETUP_VAR_STACK_REMEMBERED(1);
VAR_STACK_PUSH(0, p);
x0 = WITH_VAR_STACK(objscheme_unbundle_nonnegative_integer(p[POFFSET+0], "position-locations in text%"));
if (XC_SCHEME_NULLP(p[POFFSET+1]))
x1 = NULL;
else
*x1 = (sbox_tmp = WITH_VAR_STACK(objscheme_nullable_unbox(p[POFFSET+1], "position-locations in text%")), WITH_VAR_STACK(objscheme_unbundle_double(sbox_tmp, "position-locations in text%"", extracting boxed argument")));
if (XC_SCHEME_NULLP(p[POFFSET+2]))
x2 = NULL;
else
*x2 = (sbox_tmp = WITH_VAR_STACK(objscheme_nullable_unbox(p[POFFSET+2], "position-locations in text%")), WITH_VAR_STACK(objscheme_unbundle_double(sbox_tmp, "position-locations in text%"", extracting boxed argument")));
if (XC_SCHEME_NULLP(p[POFFSET+3]))
x3 = NULL;
else
*x3 = (sbox_tmp = WITH_VAR_STACK(objscheme_nullable_unbox(p[POFFSET+3], "position-locations in text%")), WITH_VAR_STACK(objscheme_unbundle_double(sbox_tmp, "position-locations in text%"", extracting boxed argument")));
if (XC_SCHEME_NULLP(p[POFFSET+4]))
x4 = NULL;
else
*x4 = (sbox_tmp = WITH_VAR_STACK(objscheme_nullable_unbox(p[POFFSET+4], "position-locations in text%")), WITH_VAR_STACK(objscheme_unbundle_double(sbox_tmp, "position-locations in text%"", extracting boxed argument")));
if (n > (POFFSET+5)) {
x5 = WITH_VAR_STACK(objscheme_unbundle_bool(p[POFFSET+5], "position-locations in text%"));
} else
x5 = FALSE;
if (n > (POFFSET+6)) {
x6 = WITH_VAR_STACK(objscheme_unbundle_bool(p[POFFSET+6], "position-locations in text%"));
} else
x6 = FALSE;
WITH_VAR_STACK(((wxMediaEdit *)((Scheme_Class_Object *)p[0])->primdata)->PositionLocations(x0, x1, x2, x3, x4, x5, x6));
if (n > (POFFSET+1) && !XC_SCHEME_NULLP(p[POFFSET+1]))
{ Scheme_Object *sbv_ = WITH_VAR_STACK(scheme_make_double(_x1)); WITH_VAR_STACK(objscheme_set_box(p[POFFSET+1], sbv_)); }
if (n > (POFFSET+2) && !XC_SCHEME_NULLP(p[POFFSET+2]))
{ Scheme_Object *sbv_ = WITH_VAR_STACK(scheme_make_double(_x2)); WITH_VAR_STACK(objscheme_set_box(p[POFFSET+2], sbv_)); }
if (n > (POFFSET+3) && !XC_SCHEME_NULLP(p[POFFSET+3]))
{ Scheme_Object *sbv_ = WITH_VAR_STACK(scheme_make_double(_x3)); WITH_VAR_STACK(objscheme_set_box(p[POFFSET+3], sbv_)); }
if (n > (POFFSET+4) && !XC_SCHEME_NULLP(p[POFFSET+4]))
{ Scheme_Object *sbv_ = WITH_VAR_STACK(scheme_make_double(_x4)); WITH_VAR_STACK(objscheme_set_box(p[POFFSET+4], sbv_)); }
READY_TO_RETURN;
return scheme_void;
}
static Scheme_Object *os_wxMediaEditPositionLocation(int n, Scheme_Object *p[])
{
WXS_USE_ARGUMENT(n) WXS_USE_ARGUMENT(p)
@ -8569,7 +8634,7 @@ void objscheme_setup_wxMediaEdit(Scheme_Env *env)
wxREGGLOB(os_wxMediaEdit_class);
os_wxMediaEdit_class = WITH_VAR_STACK(objscheme_def_prim_class(env, "text%", "editor%", (Scheme_Method_Prim *)os_wxMediaEdit_ConstructScheme, 150));
os_wxMediaEdit_class = WITH_VAR_STACK(objscheme_def_prim_class(env, "text%", "editor%", (Scheme_Method_Prim *)os_wxMediaEdit_ConstructScheme, 151));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaEdit_class, "call-clickback" " method", (Scheme_Method_Prim *)os_wxMediaEditCallClickback, 2, 2));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaEdit_class, "remove-clickback" " method", (Scheme_Method_Prim *)os_wxMediaEditRemoveClickback, 2, 2));
@ -8636,6 +8701,7 @@ void objscheme_setup_wxMediaEdit(Scheme_Env *env)
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaEdit_class, "line-end-position" " method", (Scheme_Method_Prim *)os_wxMediaEditLineEndPosition, 1, 2));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaEdit_class, "line-start-position" " method", (Scheme_Method_Prim *)os_wxMediaEditLineStartPosition, 1, 2));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaEdit_class, "line-location" " method", (Scheme_Method_Prim *)os_wxMediaEditLineLocation, 1, 2));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaEdit_class, "position-locations" " method", (Scheme_Method_Prim *)os_wxMediaEditPositionLocations, 5, 7));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaEdit_class, "position-location" " method", (Scheme_Method_Prim *)os_wxMediaEditPositionLocation, 1, 6));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaEdit_class, "position-line" " method", (Scheme_Method_Prim *)os_wxMediaEditPositionLine, 1, 2));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaEdit_class, "set-between-threshold" " method", (Scheme_Method_Prim *)os_wxMediaEditSetBetweenThreshold, 1, 1));

1
src/mred/wxs/wxs_mede.xc
View File

@ -152,6 +152,7 @@
@ "position-line" : long PositionLine(nnlong,bool=FALSE);
@ "position-location" : void PositionLocation(nnlong,double?=NULL,double?=NULL,bool=TRUE,bool=FALSE,bool=FALSE);
@ "position-locations" : void PositionLocations(nnlong,double?,double?,double?,double?,bool=FALSE,bool=FALSE);
@ "line-location" : double LineLocation(nnlong,bool=TRUE);
@ "line-start-position" : long LineStartPosition(nnlong,bool=TRUE);

70
src/mzscheme/src/struct.c
View File

@ -788,26 +788,6 @@ static Scheme_Object *make_struct_type_property(int argc, Scheme_Object *argv[])
"list of pairs of structure type properties and procedures (arity 1)",
2, argc, argv);
}
if (SCHEME_PAIRP(supers) && SCHEME_PAIRP(SCHEME_CDR(supers))) {
/* check for duplicates */
Scheme_Hash_Table *ht;
Scheme_Object *stack = supers;
ht = scheme_make_hash_table(SCHEME_hash_ptr);
while (SCHEME_PAIRP(stack)) {
v = SCHEME_CAR(stack);
if (SCHEME_PAIRP(v)) v = SCHEME_CAR(v); /* appended item */
p = (Scheme_Struct_Property *)v;
stack = SCHEME_CDR(stack);
if (scheme_hash_get(ht, (Scheme_Object *)p)) {
scheme_arg_mismatch("make-struct-type-property",
"super structure type property appears twice in given hierarchy: ",
(Scheme_Object *)p);
}
scheme_hash_set(ht, (Scheme_Object *)p, scheme_true);
stack = scheme_append(p->supers, stack);
}
}
}
}
@ -914,7 +894,7 @@ static Scheme_Object *guard_property(Scheme_Object *prop, Scheme_Object *v, Sche
}
}
return v;
return orig_v;
} else {
/* Normal guard handling: */
if (p->guard) {
@ -2928,9 +2908,10 @@ static Scheme_Object *_make_struct_type(Scheme_Object *basesym, const char *base
scheme_null));
if (props) {
int num_props, i, proc_prop_set = 0;
int num_props, i;
Scheme_Object *proc_prop_set = NULL;
Scheme_Hash_Table *can_override;
Scheme_Object *l, *a, *prop, *propv;
Scheme_Object *l, *a, *prop, *propv, *oldv;
can_override = scheme_make_hash_table(SCHEME_hash_ptr);
@ -2963,24 +2944,29 @@ static Scheme_Object *_make_struct_type(Scheme_Object *basesym, const char *base
a = SCHEME_CAR(l);
prop = SCHEME_CAR(a);
if (scheme_hash_get(ht, prop)) {
/* Property is already in the superstruct_type */
if (!scheme_hash_get(can_override, prop))
break;
/* otherwise we override */
scheme_hash_set(can_override, prop, NULL);
} else if (SAME_OBJ(prop, proc_property)) {
if (proc_prop_set)
break;
}
propv = guard_property(prop, SCHEME_CDR(a), struct_type);
if (SAME_OBJ(prop, proc_property)) {
if (proc_prop_set && !SAME_OBJ(proc_prop_set, propv))
break;
} else {
oldv = scheme_hash_get(ht, prop);
if (oldv) {
/* Property is already in the superstruct_type */
if (!scheme_hash_get(can_override, prop)) {
if (!SAME_OBJ(oldv, propv))
break;
}
/* otherwise we override */
scheme_hash_set(can_override, prop, NULL);
}
}
l = SCHEME_CDR(l);
l = append_super_props((Scheme_Struct_Property *)prop, propv, l);
if (SAME_OBJ(prop, proc_property))
proc_prop_set = 1;
proc_prop_set = propv;
else
scheme_hash_set(ht, prop, propv);
}
@ -3008,9 +2994,11 @@ static Scheme_Object *_make_struct_type(Scheme_Object *basesym, const char *base
prop = SCHEME_CAR(a);
propv = guard_property(prop, SCHEME_CDR(a), struct_type);
/* Check whether already in table: */
if (SAME_OBJ(prop, proc_property)) {
if (proc_prop_set)
if (proc_prop_set && !SAME_OBJ(proc_prop_set, propv))
break;
j = 0;
} else {
@ -3020,21 +3008,21 @@ static Scheme_Object *_make_struct_type(Scheme_Object *basesym, const char *base
}
if (j < num_props) {
/* already there */
if (!scheme_hash_get(can_override, prop))
break;
if (!scheme_hash_get(can_override, prop)) {
if (!SAME_OBJ(propv, SCHEME_CDR(pa[j])))
break;
}
/* overriding it: */
scheme_hash_set(can_override, prop, NULL);
} else
num_props++;
}
propv = guard_property(prop, SCHEME_CDR(a), struct_type);
l = SCHEME_CDR(l);
l = append_super_props((Scheme_Struct_Property *)prop, propv, l);
if (SAME_OBJ(prop, proc_property))
proc_prop_set = 1;
proc_prop_set = propv;
else {
a = scheme_make_pair(prop, propv);
pa[j] = a;