Re: [racket-users] raco test: 0 tests run, 1 test passed
On Friday, March 3, 2017 at 7:18:27 AM UTC+8, schuster wrote: > The problem is that a test-case expression runs a test immediately; it does > not return a test object to be run later. In your case, the test runs while > my-test-case is being defined, then no test at all actually runs > (my-test-case is just #). I did figure out that I need to wrap test-cases in test-suites soon after I posted the message, as it is usually the case :-). Thanks for clarifying that test-case runs immediately. In my case, the tests are in a separate file and I only run the file when I want to run the tests, so it is hard to tell the difference. I still think the output from "rack test" is somewhat confusing. In one of my test files the output is: raco test: (submod "test/df-test.rkt" test) 3 success(es) 0 failure(s) 0 error(s) 3 test(s) run 0 75 tests passed What the above means is that 3 test suites were run and there were 75 checks in total (not sure what the line with the single 0 means). However, the way the message is printed out implies that 3 tests were run and 75 passed. Perhaps the message could be updated to say: raco test: (submod "test/df-test.rkt" test) 3 success(es) 0 failure(s) 0 error(s) 3 test suite(s) run 0 75 checks passed Best Regards, Alex. -- You received this message because you are subscribed to the Google Groups "Racket Users" group. To unsubscribe from this group and stop receiving emails from it, send an email to racket-users+unsubscr...@googlegroups.com. For more options, visit https://groups.google.com/d/optout.
Re: [racket-users] raco test: 0 tests run, 1 test passed
The problem is that a test-case expression runs a test immediately; it does not return a test object to be run later. In your case, the test runs while my-test-case is being defined, then no test at all actually runs (my-test-case is just #). A test-suite expression, however, *does* construct a test for running later. You probably want something more like this: #lang racket (require rackunit) (require rackunit/text-ui) (define my-test-suite (test-suite "My test-suite" (test-case "My Test case" (check eq? 1 1 (module+ test (run-tests my-test-suite)) Note that test-suites can be nested inside of other test-suites, so you can get modularity back that way if desired. -Jon On Sat, Feb 25, 2017 at 1:17 AM, Alex Harsanyi wrote: > I'm a bit confused about how raco test is reporting the number of tests > run, if a test case is defined outside a test suite. If I run the program > below: > > #lang racket > (require rackunit) > (require rackunit/text-ui) > > (define my-test-case >(test-case >"My Test case" > (check eq? 1 1))) > > (define my-test-suite >(test-suite > "My test-suite" >my-test-case)) > > (module+ test >(run-tests my-test-suite)) > > I get: > > $ raco test test/t.rkt > raco test: (submod "test/t.rkt" test) > 0 success(es) 0 failure(s) 0 error(s) 0 test(s) run > 0 > 1 test passed > > the test is clearly run (I even put a printf inside my-test-case to be > convinced of that), yet the first output line indicates that there were 0 > successes and 0 tests run. The last output line seems to be consistent > with the number of tests (checks) run. > > How do I structure my test programs, such that raco test displays the > actual number of tests run? > > Thanks, > Alex. > > -- > You received this message because you are subscribed to the Google Groups > "Racket Users" group. > To unsubscribe from this group and stop receiving emails from it, send an > email to racket-users+unsubscr...@googlegroups.com. > For more options, visit https://groups.google.com/d/optout. > -- You received this message because you are subscribed to the Google Groups "Racket Users" group. To unsubscribe from this group and stop receiving emails from it, send an email to racket-users+unsubscr...@googlegroups.com. For more options, visit https://groups.google.com/d/optout.
Re: [racket-users] change 'random' contract to allow zero in first position?
While we're at it, please allow negative arguments too, to allow for cases such as (random -100 100) Dan -- You received this message because you are subscribed to the Google Groups "Racket Users" group. To unsubscribe from this group and stop receiving emails from it, send an email to racket-users+unsubscr...@googlegroups.com. For more options, visit https://groups.google.com/d/optout.
Re: [racket-users] change 'random' contract to allow zero in first position?
I think that the contract is overly specific on the 2 argument case. But on the 1 argument case, I don't think 0 makes sense: "When called with an integer argument k, returns a random exact integer in the range 0 to k-1."[k <- 0] =_v "When called with an integer argument 0, returns a random exact integer in the range 0 to -1." Jay On Thu, Mar 2, 2017 at 4:41 PM, 'John Clements' via Racket Users wrote: > I have a bunch of students this quarter that are writing code like this: > > (- (random 1 9) 1) > > Why? because they tried writing > > (random 0 8) > > and got a contract error, to wit: > > > random: contract violation > expected: (integer-in 1 4294967087) > given: 0 >> > > I’m assuming that this contract was written by someone who imagined that the > recipient would realize that the first argument could be omitted entirely, > but my sample suggests that’s not the case. > > Would it be all right to just change the contract to allow zero as a first > argument? I’d be happy to submit a pull request, if so. > > John > > > > -- > You received this message because you are subscribed to the Google Groups > "Racket Users" group. > To unsubscribe from this group and stop receiving emails from it, send an > email to racket-users+unsubscr...@googlegroups.com. > For more options, visit https://groups.google.com/d/optout. -- -=[ Jay McCarthy http://jeapostrophe.github.io]=- -=[ Associate ProfessorPLT @ CS @ UMass Lowell ]=- -=[ Moses 1:33: And worlds without number have I created; ]=- -- You received this message because you are subscribed to the Google Groups "Racket Users" group. To unsubscribe from this group and stop receiving emails from it, send an email to racket-users+unsubscr...@googlegroups.com. For more options, visit https://groups.google.com/d/optout.
[racket-users] change 'random' contract to allow zero in first position?
I have a bunch of students this quarter that are writing code like this: (- (random 1 9) 1) Why? because they tried writing (random 0 8) and got a contract error, to wit: random: contract violation expected: (integer-in 1 4294967087) given: 0 > I’m assuming that this contract was written by someone who imagined that the recipient would realize that the first argument could be omitted entirely, but my sample suggests that’s not the case. Would it be all right to just change the contract to allow zero as a first argument? I’d be happy to submit a pull request, if so. John -- You received this message because you are subscribed to the Google Groups "Racket Users" group. To unsubscribe from this group and stop receiving emails from it, send an email to racket-users+unsubscr...@googlegroups.com. For more options, visit https://groups.google.com/d/optout.
Re: [racket-users] Idiomatic way to include numbers in a map?
There is a "generic" `sequence-map`. But it's not variadic like `map` -- and like you want in your example. You could try writing a variadic `sequence-map`? As for `for/list`, you _could_ write: (for/list ([a as] [b bs] [n (in-naturals)]) (foo a b n)) It's faster if you supply `in-list` for `as` and `bs`, as did David. When you do, it expands to code that's about as fast as if you wrote it by hand. But if you know the list will have only a few items, and it doesn't matter, you could omit `in-list`. Granted it's still more verbose than `map` style. Speaking of writing by hand, you could use `match*` to remove some car/cdr textbook tedium -- but it's still fairly tedious: (let loop ([as as] [bs bs] [n 1]) ;`in-naturals` is 1.. -- use 0 here if you prefer (match* [as bs] [[(cons a as) (cons b bs)] (cons (foo a b n) (loop as bs (add1 n)))] [[_ _] '()])) I think one theme here is a trade-off between abstraction and speed Another is a trade-off between functions and macros. Macros like `for` and `match` can expand into efficient code that you wouldn't want to write by hand. -- You received this message because you are subscribed to the Google Groups "Racket Users" group. To unsubscribe from this group and stop receiving emails from it, send an email to racket-users+unsubscr...@googlegroups.com. For more options, visit https://groups.google.com/d/optout.
Re: [racket-users] Idiomatic way to include numbers in a map?
On Thu, Mar 2, 2017 at 12:15 PM, David Storrs wrote: > > > > On Thu, Mar 2, 2017 at 11:22 AM, David Christiansen < > da...@davidchristiansen.dk> wrote: > >> > Not with map, which requires equal-length arguments. >> > >> > You could do the slightly less ugly: >> > >> > (map >> > foo >> > lst-A >> > lst-B >> > (range (length lst-A))) >> >> Why not do it this way? >> >> (struct foo (a b c)) >> (define lst-A '(a b)) >> (define lst-B '(d e)) >> (for/list ([a (in-list lst-A)] >>[b (in-list lst-B)] >>[n (in-naturals)]) >> (foo a b n)) >> >> This seems to be the nicest of the lot. >> >> /David > > > I could, it's just extremely more verbose and therefore obfuscates what's > actually going on as compared to the 'map' form. > > The issue with streams and sequences not being iterable in some cases has > tripped me up several times. I confess I don't understand the design > decisions behind them. Can someone ELI5 for me about what exactly they are > and why they work the way they do / aren't interchangeable? From a naive > perspective it seems like it would be possible to make them work smoothly > together by adding a "cond: choose the right iterator func based on the > type" under the hood. Something like the following, except this is > probably very slow and I'd need to figure out the appropriate generation > for the '(choose-iter sourceN)' lines: > > (define-syntax relaxed-map > > (syntax-case stx () > [(_ func source1 source2 ...) > (let () >(define (choose-iter x) > (cond [(list? x) (list list-ref x)] >[(stream? x) (list stream-ref x)] >[(sequence? x) (list sequence-ref x)])) >(for/list ((i (in-range (add1 (min (map length source1 source2 > ...)) > (list ((choose-iter source1) source1 i) >((choose-iter source2) source2 i) >...)))])) ;; This won't actually generate the 'choose-iter' > lines properly > > Also, that needs to be '(apply min (map ...' Still, you get the point. >> >> -- >> You received this message because you are subscribed to the Google Groups >> "Racket Users" group. >> To unsubscribe from this group and stop receiving emails from it, send an >> email to racket-users+unsubscr...@googlegroups.com. >> For more options, visit https://groups.google.com/d/optout. >> > > -- You received this message because you are subscribed to the Google Groups "Racket Users" group. To unsubscribe from this group and stop receiving emails from it, send an email to racket-users+unsubscr...@googlegroups.com. For more options, visit https://groups.google.com/d/optout.
Re: [racket-users] Idiomatic way to include numbers in a map?
On Thu, Mar 2, 2017 at 11:22 AM, David Christiansen < da...@davidchristiansen.dk> wrote: > > Not with map, which requires equal-length arguments. > > > > You could do the slightly less ugly: > > > > (map > > foo > > lst-A > > lst-B > > (range (length lst-A))) > > Why not do it this way? > > (struct foo (a b c)) > (define lst-A '(a b)) > (define lst-B '(d e)) > (for/list ([a (in-list lst-A)] >[b (in-list lst-B)] >[n (in-naturals)]) > (foo a b n)) > > This seems to be the nicest of the lot. > > /David I could, it's just extremely more verbose and therefore obfuscates what's actually going on as compared to the 'map' form. The issue with streams and sequences not being iterable in some cases has tripped me up several times. I confess I don't understand the design decisions behind them. Can someone ELI5 for me about what exactly they are and why they work the way they do / aren't interchangeable? From a naive perspective it seems like it would be possible to make them work smoothly together by adding a "cond: choose the right iterator func based on the type" under the hood. Something like the following, except this is probably very slow and I'd need to figure out the appropriate generation for the '(choose-iter sourceN)' lines: (define-syntax relaxed-map (syntax-case stx () [(_ func source1 source2 ...) (let () (define (choose-iter x) (cond [(list? x) (list list-ref x)] [(stream? x) (list stream-ref x)] [(sequence? x) (list sequence-ref x)])) (for/list ((i (in-range (add1 (min (map length source1 source2 ...)) (list ((choose-iter source1) source1 i) ((choose-iter source2) source2 i) ...)))])) ;; This won't actually generate the 'choose-iter' lines properly > > > -- > You received this message because you are subscribed to the Google Groups > "Racket Users" group. > To unsubscribe from this group and stop receiving emails from it, send an > email to racket-users+unsubscr...@googlegroups.com. > For more options, visit https://groups.google.com/d/optout. > -- You received this message because you are subscribed to the Google Groups "Racket Users" group. To unsubscribe from this group and stop receiving emails from it, send an email to racket-users+unsubscr...@googlegroups.com. For more options, visit https://groups.google.com/d/optout.
Re: [racket-users] Idiomatic way to include numbers in a map?
> Not with map, which requires equal-length arguments. > > You could do the slightly less ugly: > > (map > foo > lst-A > lst-B > (range (length lst-A))) Why not do it this way? (struct foo (a b c)) (define lst-A '(a b)) (define lst-B '(d e)) (for/list ([a (in-list lst-A)] [b (in-list lst-B)] [n (in-naturals)]) (foo a b n)) This seems to be the nicest of the lot. /David -- You received this message because you are subscribed to the Google Groups "Racket Users" group. To unsubscribe from this group and stop receiving emails from it, send an email to racket-users+unsubscr...@googlegroups.com. For more options, visit https://groups.google.com/d/optout.
Re: [racket-users] Idiomatic way to include numbers in a map?
Not with map, which requires equal-length arguments. You could do the slightly less ugly: (map foo lst-A lst-B (range (length lst-A))) On Thu, Mar 2, 2017 at 11:14 AM, David Storrs wrote: > > > On Thu, Mar 2, 2017 at 10:09 AM, Stephen Chang wrote: >> >> The in-X forms are sequences, and must be used with the sequence API, ie >> for/X. >> >> map only works with lists, so you could use build-list or range: >> (map >> foo >> lst-A >> lst-B >> (range 2)) >> > Is there a way to do it if I don't know how many items will be in the list? > What I want is to say "just keep sticking numbers in until one of the lists > runs out." I could say (range 1) but that's ugly. > > >> >> On Thu, Mar 2, 2017 at 9:55 AM, David Storrs >> wrote: >> > I'd like to be able to do something like this: >> > >> > (struct foo (a b c)) >> > (define lst-A '(a b)) >> > (define lst-B '(d e)) >> > (map >> > foo >> > lst-A >> > lst-B >> > (in-naturals)) >> > >> > I'd expected this to produce: (foo 'a 'd 0) (foo 'b 'e 1), but instead >> > it >> > throws an exception "expected list, given stream". I could do it with a >> > for/list but that's much more verbose. What would be the idiomatic way >> > of >> > doing this? >> > >> > -- >> > You received this message because you are subscribed to the Google >> > Groups >> > "Racket Users" group. >> > To unsubscribe from this group and stop receiving emails from it, send >> > an >> > email to racket-users+unsubscr...@googlegroups.com. >> > For more options, visit https://groups.google.com/d/optout. > > > -- > You received this message because you are subscribed to the Google Groups > "Racket Users" group. > To unsubscribe from this group and stop receiving emails from it, send an > email to racket-users+unsubscr...@googlegroups.com. > For more options, visit https://groups.google.com/d/optout. -- You received this message because you are subscribed to the Google Groups "Racket Users" group. To unsubscribe from this group and stop receiving emails from it, send an email to racket-users+unsubscr...@googlegroups.com. For more options, visit https://groups.google.com/d/optout.
Re: [racket-users] Idiomatic way to include numbers in a map?
On Thu, Mar 2, 2017 at 10:09 AM, Stephen Chang wrote: > The in-X forms are sequences, and must be used with the sequence API, ie > for/X. > > map only works with lists, so you could use build-list or range: > (map > foo > lst-A > lst-B > (range 2)) > > Is there a way to do it if I don't know how many items will be in the list? What I want is to say "just keep sticking numbers in until one of the lists runs out." I could say (range 1) but that's ugly. > On Thu, Mar 2, 2017 at 9:55 AM, David Storrs > wrote: > > I'd like to be able to do something like this: > > > > (struct foo (a b c)) > > (define lst-A '(a b)) > > (define lst-B '(d e)) > > (map > > foo > > lst-A > > lst-B > > (in-naturals)) > > > > I'd expected this to produce: (foo 'a 'd 0) (foo 'b 'e 1), but instead > it > > throws an exception "expected list, given stream". I could do it with a > > for/list but that's much more verbose. What would be the idiomatic way > of > > doing this? > > > > -- > > You received this message because you are subscribed to the Google Groups > > "Racket Users" group. > > To unsubscribe from this group and stop receiving emails from it, send an > > email to racket-users+unsubscr...@googlegroups.com. > > For more options, visit https://groups.google.com/d/optout. > -- You received this message because you are subscribed to the Google Groups "Racket Users" group. To unsubscribe from this group and stop receiving emails from it, send an email to racket-users+unsubscr...@googlegroups.com. For more options, visit https://groups.google.com/d/optout.
Re: [racket-users] Idiomatic way to include numbers in a map?
The in-X forms are sequences, and must be used with the sequence API, ie for/X. map only works with lists, so you could use build-list or range: (map foo lst-A lst-B (range 2)) On Thu, Mar 2, 2017 at 9:55 AM, David Storrs wrote: > I'd like to be able to do something like this: > > (struct foo (a b c)) > (define lst-A '(a b)) > (define lst-B '(d e)) > (map > foo > lst-A > lst-B > (in-naturals)) > > I'd expected this to produce: (foo 'a 'd 0) (foo 'b 'e 1), but instead it > throws an exception "expected list, given stream". I could do it with a > for/list but that's much more verbose. What would be the idiomatic way of > doing this? > > -- > You received this message because you are subscribed to the Google Groups > "Racket Users" group. > To unsubscribe from this group and stop receiving emails from it, send an > email to racket-users+unsubscr...@googlegroups.com. > For more options, visit https://groups.google.com/d/optout. -- You received this message because you are subscribed to the Google Groups "Racket Users" group. To unsubscribe from this group and stop receiving emails from it, send an email to racket-users+unsubscr...@googlegroups.com. For more options, visit https://groups.google.com/d/optout.
[racket-users] Idiomatic way to include numbers in a map?
I'd like to be able to do something like this: (struct foo (a b c)) (define lst-A '(a b)) (define lst-B '(d e)) (map foo lst-A lst-B (in-naturals)) I'd expected this to produce: (foo 'a 'd 0) (foo 'b 'e 1), but instead it throws an exception "expected list, given stream". I could do it with a for/list but that's much more verbose. What would be the idiomatic way of doing this? -- You received this message because you are subscribed to the Google Groups "Racket Users" group. To unsubscribe from this group and stop receiving emails from it, send an email to racket-users+unsubscr...@googlegroups.com. For more options, visit https://groups.google.com/d/optout.
Re: [racket-users] Making a snip% select itself in a text%
I found an easy solution that does what I want it do to. It's only suitable for non-editable snips, of course. Instead of checking whether draw-caret is a pair in draw, I simply use (not (equal? draw-caret 'no-caret)) That does the job. As for keyboard events, I think I'll handle them in the snips. It's really cool what you can do with text% snips and the pict library with a bit of fiddling around. :) Best, Erich On Thu, 2 Mar 2017 06:25:09 -0700 Matthew Flatt wrote: > > (send editor set-caret-owner #f) > > to send keyboard focus back to the editor. > > When you click a snip that has 'handles-events, then keyboard focus is > moved to the snip instead of to the enclosing editor. > -- You received this message because you are subscribed to the Google Groups "Racket Users" group. To unsubscribe from this group and stop receiving emails from it, send an email to racket-users+unsubscr...@googlegroups.com. For more options, visit https://groups.google.com/d/optout.
Re: [racket-users] Making a snip% select itself in a text%
At Thu, 2 Mar 2017 11:12:16 +, Erich Rast wrote: > Hi! I have a simple non-editable and non-resizable snip% class that in > its draw function distinguishes whether it's selected or not. It works > fine when I select it in a text% with the mouse. > > Now I want to select it in the text% when the user left-clicks on it, > so I've overridden on-event and tried this: > > (define/public (select-this-snip) > (define editor (send (get-admin) get-editor)) > (define pos (send editor get-snip-position this)) > (send editor set-position pos (+ pos 1))) > > It *does* select the snip in the sense that a selection background is > drawn (which is visible on the edges, since the snip itself uses a > rounded rectangle), but the snip itself is not drawn as highlighted, > even though I check whether draw-caret is a pair in the draw method. It > is correctly drawn when I select it manually with the mouse, though. Use (send editor set-caret-owner #f) to send keyboard focus back to the editor. When you click a snip that has 'handles-events, then keyboard focus is moved to the snip instead of to the enclosing editor. -- You received this message because you are subscribed to the Google Groups "Racket Users" group. To unsubscribe from this group and stop receiving emails from it, send an email to racket-users+unsubscr...@googlegroups.com. For more options, visit https://groups.google.com/d/optout.
Re: [racket-users] Re: Making a snip% select itself in a text%
On Thu, 2 Mar 2017 03:32:08 -0800 (PST) Alex Harsanyi wrote: > You need to tell the snip admin that the snip needs to be redrawn. > In your select-this-snip method, add > > (send (get-admin) needs-update this 0 0 width height) > It still doesn't work. I'm using this: (define/public (select-this-snip) (define editor (send (get-admin) get-editor)) (define pos (send editor get-snip-position this)) (send editor set-position pos (+ pos 1)) (define w (box 0)) (define h (box 0)) (get-extent (send (get-admin) get-dc) 0 0 w h) (send (get-admin) needs-update this 0 0 (unbox w) (unbox h))) The snip *is* selected but not drawn as selected. The draw method checks (pair? draw-caret) for determining whether its selected, and this works for manual selection, i.e., left-click and mouse drag from adjacent position. Of course, I could work around this by maintaining my own selection flag and resetting it in on-goodbye-event, but that seems like a hack to me. Any ideas what I'm doing wrong? Best, Erich My draw method: (define/override (draw dc x y left top right bottom dx dy draw-caret) (define-values (tw th tdist tvspace) (send dc get-text-extent (get-display-name) (send (get-style) get-font) #t 0)) (define w (+ tw 22)) (define h (max 22 (+ th 4))) (define background-color (if (pair? draw-caret) (scale-color 0.8 (send (get-style) get-background)) (send (get-style) get-background))) (define background (filled-rounded-rectangle w h #:color background-color #:border-color (scale-color 0.8 background-color) #:draw-border? #t)) (define c-new (send (get-style) get-background)) (define old-pen (send dc get-pen)) (send dc set-smoothing 'aligned) (draw-pict background dc x y) (draw-pict (scale-to-fit (get-pict) 16 16) dc (+ x 4) (+ y 4)) (send dc set-pen old-pen) (when (and (pair? draw-caret) (get-highlight-text-color)) (send dc set-text-foreground (get-highlight-text-color))) (send dc set-text-background background-color) (send dc draw-text (get-display-name) (+ x 20) (+ y 4) #t)) -- You received this message because you are subscribed to the Google Groups "Racket Users" group. To unsubscribe from this group and stop receiving emails from it, send an email to racket-users+unsubscr...@googlegroups.com. For more options, visit https://groups.google.com/d/optout.
[racket-users] Re: Making a snip% select itself in a text%
On Thursday, March 2, 2017 at 7:12:22 PM UTC+8, erich wrote: > Hi! I have a simple non-editable and non-resizable snip% class that in > its draw function distinguishes whether it's selected or not. It works > fine when I select it in a text% with the mouse. > > Now I want to select it in the text% when the user left-clicks on it, > so I've overridden on-event and tried this: > > (define/public (select-this-snip) > (define editor (send (get-admin) get-editor)) > (define pos (send editor get-snip-position this)) > (send editor set-position pos (+ pos 1))) > You need to tell the snip admin that the snip needs to be redrawn. In your select-this-snip method, add (send (get-admin) needs-update this 0 0 width height) Where width and height are the dimensions of your snip. Best Regards, Alex. -- You received this message because you are subscribed to the Google Groups "Racket Users" group. To unsubscribe from this group and stop receiving emails from it, send an email to racket-users+unsubscr...@googlegroups.com. For more options, visit https://groups.google.com/d/optout.
[racket-users] Making a snip% select itself in a text%
Hi! I have a simple non-editable and non-resizable snip% class that in its draw function distinguishes whether it's selected or not. It works fine when I select it in a text% with the mouse. Now I want to select it in the text% when the user left-clicks on it, so I've overridden on-event and tried this: (define/public (select-this-snip) (define editor (send (get-admin) get-editor)) (define pos (send editor get-snip-position this)) (send editor set-position pos (+ pos 1))) It *does* select the snip in the sense that a selection background is drawn (which is visible on the edges, since the snip itself uses a rounded rectangle), but the snip itself is not drawn as highlighted, even though I check whether draw-caret is a pair in the draw method. It is correctly drawn when I select it manually with the mouse, though. I've tried resize and various other refresh methods in editor and snip-admin with and without wrapping it into queue-callback, but none of them worked so far. Should I redraw it manually by calling draw directly? Best, Erich (define attachment-snip% (class snip% (inherit set-snipclass set-style get-style set-flags get-admin) (init-field attachment) (init-field (click-callback #f)) (define/public (get-display-name) (string-append " " (send attachment get-name) " ")) (define/override (get-extent dc x y [w #f] [h #f] [descent #f] [space #f] [lspace #f] [rspace #f]) (let-values ([(tw th tdist tvspace) (send dc get-text-extent (get-display-name) (send (get-style) get-font) #t 0)]) (when h (set-box! h (max 22 (+ th 4 (when w (set-box! w (+ tw 22))) (when descent (set-box! descent tdist)) (when space (set-box! space tvspace)) (when lspace (set-box! lspace 5)) (when rspace (set-box! rspace 5 (define (get-pict) (case (send attachment get-type) (("file") icons:snip-file-pict) (("image-file") icons:snip-image-pict) (("link") icons:snip-link-pict) (("url") icons:snip-url-pict) (else (log-warning "attachment-snips:attachment-snip%:get-pict unknown attachment type ~s" (send attachment get-type)) icons:snip-file-pict))) (define (get-init-style) (case (send attachment get-type) (("file") file-style) (("image-file") image-style) (("link") link-style) (("url") url-style) (else (log-warning "attachment-snips:attachment-snip%:get-style unknown attachment type ~s" (send attachment get-type)) link-style))) (define/override (draw dc x y left top right bottom dx dy draw-caret) (define-values (tw th tdist tvspace) (send dc get-text-extent (get-display-name) (send (get-style) get-font) #t 0)) (define w (+ tw 22)) (define h (max 22 (+ th 4))) (define background-color (if (pair? draw-caret) (scale-color 0.8 (send (get-style) get-background)) (send (get-style) get-background))) (define background (filled-rounded-rectangle w h #:color background-color #:border-color (scale-color 0.8 background-color) #:draw-border? #t)) (define c-new (send (get-style) get-background)) (define old-pen (send dc get-pen)) (send dc set-smoothing 'aligned) (draw-pict background dc x y) (draw-pict (scale-to-fit (get-pict) 16 16) dc (+ x 4) (+ y 4)) (send dc set-pen old-pen) (when (and (pair? draw-caret) (get-highlight-text-color)) (send dc set-text-foreground (get-highlight-text-color))) (send dc set-text-background background-color) (send dc draw-text (get-display-name) (+ x 20) (+ y 4) #t)) (define/override (adjust-cursor dc x y editorx editory evt) attachment-snip-cursor) (define/public (select-this-snip) (define editor (send (get-admin) get-editor)) (define pos (send editor get-snip-position this)) (send editor set-position pos (+ pos 1))) (define/override (on-event dc x y editorx editory evt) (case (send evt get-event-type) ((left-down) (select-this-snip)(displayln "left")) ((right-down) (displayln "right")) ((middle-down) (displayln "middle" (define/override (copy) (make-object attachment-snip% attachment)) (define/override (get-text offset num [flattened? #f]) (send attachment get-name)) (define/override (write f) (send f put (send attachment get-id))) (super-new) (set-snipclass attachment-snip-class) (set-style (get-init-style)) (set-flags '(handles-events handles-all-mouse-events handles-between-