diff --git a/collects/mrlib/graph.ss b/collects/mrlib/graph.ss index 92368275..a2517c29 100644 --- a/collects/mrlib/graph.ss +++ b/collects/mrlib/graph.ss @@ -146,9 +146,10 @@ label) (send parent add-child child) (send child add-parent parent dark-pen light-pen dark-brush light-brush dark-text light-text dx dy label)) + (define (set-links-label! parent child label) (send child set-parent-link-label parent label)) - + (define graph-snip-mixin (mixin ((class->interface snip%)) (graph-snip<%>) (field (children null)) @@ -163,15 +164,6 @@ (field (parent-links null)) (define/public (get-parent-links) parent-links) (define/public (get-parents) (map link-snip parent-links)) - (define/public (set-parent-link-label parent label) - (let ([parent-link - (cond [(memf (lambda (parent-link) - (eq? (link-snip parent-link) parent)) - parent-links) - => car] - [else #f])]) - (when parent-link - (set-link-label! parent-link label)))) (define/public add-parent (case-lambda [(parent) (add-parent parent #f #f #f #f)] @@ -202,6 +194,15 @@ parent parent-links (lambda (parent parent-link) (eq? (link-snip parent-link) parent)))))) + (define/public (set-parent-link-label parent label) + (let ([parent-link + (cond [(memf (lambda (parent-link) + (eq? (link-snip parent-link) parent)) + parent-links) + => car] + [else #f])]) + (when parent-link + (set-link-label! parent-link label)))) (define/public (has-self-loop?) (memq this (get-children))) diff --git a/collects/mrlib/scribblings/graph/graph-snip-intf.scrbl b/collects/mrlib/scribblings/graph/graph-snip-intf.scrbl index ef630047..c31ca443 100644 --- a/collects/mrlib/scribblings/graph/graph-snip-intf.scrbl +++ b/collects/mrlib/scribblings/graph/graph-snip-intf.scrbl @@ -60,4 +60,16 @@ this snip. Removes a parent snip from this snip. Be sure to remove this snip as a child from the argument, too. -}} +} + + +@defmethod[(set-parent-link-label [parent (is-a?/c graph-snip<%>)] + [label (or/c false/c string/)]) + void?]{ + + Changes the label on the edge going to the @scheme[parent] to be + @scheme[label]. Ignored if no such egde exists. + +} + +} diff --git a/collects/mrlib/scribblings/graph/graph.scrbl b/collects/mrlib/scribblings/graph/graph.scrbl index ecb08768..46b28cbb 100644 --- a/collects/mrlib/scribblings/graph/graph.scrbl +++ b/collects/mrlib/scribblings/graph/graph.scrbl @@ -74,3 +74,12 @@ used.} Like @scheme[add-links], but with extra @scheme[dark-text] and @scheme[light-text] arguments to set the colors of the label.} + +@defproc[(set-links-label! [parent (is-a?/c graph-snip<%>)] + [child (is-a?/c graph-snip<%>)] + [label (or/c string? false/c)]) + void?]{ + +Changes the label on the edge going from @scheme[child] to +@scheme[parent] to be @scheme[label]. If there is no existing edge +between the two nodes, then nothing happens.}