<commit_before>#lang racket/base

(require racket/string racket/class racket/gui/base racket/match racket/port
         framework syntax/to-string
         "report.rkt"
         unstable/sequence unstable/pretty)

(provide popup-callback make-color-table)

(define popup-width  500)
(define popup-height 300)

(define tt-style-delta (new style-delta%))
(send tt-style-delta set-family 'modern)

(define ((popup-callback entry) ed start end)
  (match-define (report-entry subs start end badness) entry)
  (define win (new frame% [label "Performance Report"]
                   [width popup-width] [height popup-height]))
  (define pane (new text% [auto-wrap #t]))
  (define canvas
    (new editor-canvas% [parent win] [editor pane] [style '(no-hscroll)]))
  (for-each (format-sub-report-entry pane) subs)
  (send canvas scroll-to 0 0 0 0 #t) ; display the beginning
  (send pane lock #t)
  (send win show #t))

;; each sub-entry is displayed in its own text%, contained in the main
;; editor, to simplify irritant highlighting
(define ((format-sub-report-entry pane) s)
  (match-define (sub-report-entry stx msg) s)

  (define usable-width (- popup-width 20)) ; minus the scrollbar

  ;; the location, the syntax and the message are in separate editors
  (define location-text (new text:basic% [auto-wrap #t]))
  (define location (format "~a:~a:" (syntax-line stx) (syntax-column stx)))
  (send location-text insert-port (open-input-string location))
  (send location-text lock #t)
  ;; add to the main editor
  (send pane insert
        (new editor-snip% [editor location-text] [with-border? #f]))
  (send pane insert-port (open-input-string "\n"))

  (define syntax-text (new text:basic%))
  ;; typeset the syntax as code
  (send syntax-text change-style tt-style-delta)
  (send syntax-text insert-port
        (open-input-string (syntax->string #`(#,stx)))) ; takes a list of stxs
  ;; circle irritants, if necessary
  (when (missed-opt-report-entry? s)
    (for ([i (in-list (missed-opt-report-entry-irritants s))]
          #:when (syntax-position i))
      (define start (- (syntax-position i) (syntax-position stx)))
      (define len   (syntax-span i))
      ;; will be off if there are comments inside an irritant (span will be
      ;; higher than what's actually displayed), but unless we make the
      ;; located version of irritants available, this is the best we can do
      (send syntax-text highlight-range
            start (+ start len) "pink" #f 'high 'rectangle)))
  (send syntax-text set-max-width usable-width)
  (send syntax-text auto-wrap #t)
  (send syntax-text lock #t)
  (send pane insert
        (new editor-snip% [editor syntax-text] [max-width popup-width]
             [with-border? #f] [bottom-margin 10]))
  (send pane insert-port (open-input-string "\n"))

  (define message-text (new text:basic% [auto-wrap #t]))
  (send message-text insert-port (open-input-string msg))
  ;; adjust display
  (send message-text set-max-width usable-width)
  (send message-text auto-wrap #t)
  (send message-text lock #t)
  (send pane insert
        (new editor-snip% [editor message-text] [max-width popup-width]
             [with-border? #f] [top-margin 10] [bottom-margin 15]))

  ;; to place the next sub-entry below
  (send pane insert-port (open-input-string "\n\n"))
  (define line-bitmap (make-object bitmap% usable-width 5))
  (define bitmap-dc (make-object bitmap-dc% line-bitmap))
  (send bitmap-dc draw-line 0 2.5 usable-width 2.5)
  (send pane insert (make-object image-snip% line-bitmap))
  (send pane insert-port (open-input-string "\n\n")))<commit_msg>Use icons to distinguish optimizations from missed optimizations.<commit_after>#lang racket/base

(require racket/string racket/class racket/gui/base racket/match racket/port
         framework syntax/to-string
         "report.rkt"
         unstable/sequence unstable/pretty
         images/icons/symbol)

(provide popup-callback make-color-table)

(define popup-width  500)
(define popup-height 300)

(define tt-style-delta (new style-delta%))
(send tt-style-delta set-family 'modern)

(define ((popup-callback entry) ed start end)
  (match-define (report-entry subs start end badness) entry)
  (define win (new frame% [label "Performance Report"]
                   [width popup-width] [height popup-height]))
  (define pane (new text% [auto-wrap #t]))
  (define canvas
    (new editor-canvas% [parent win] [editor pane] [style '(no-hscroll)]))
  (for-each (format-sub-report-entry pane) subs)
  (send canvas scroll-to 0 0 0 0 #t) ; display the beginning
  (send pane lock #t)
  (send win show #t))

;; each sub-entry is displayed in its own text%, contained in the main
;; editor, to simplify irritant highlighting
(define ((format-sub-report-entry pane) s)
  (match-define (sub-report-entry stx msg) s)

  (define usable-width (- popup-width 20)) ; minus the scrollbar

  ;; the location, the syntax and the message are in separate editors
  (define location-text (new text:basic% [auto-wrap #t]))
  (define location (format "~a:~a:" (syntax-line stx) (syntax-column stx)))
  (send location-text insert-port (open-input-string location))
  (send location-text lock #t)
  ;; add to the main editor
  (send pane insert
        (new editor-snip% [editor location-text] [with-border? #f]))
  (send pane insert-port (open-input-string "\n"))

  (define syntax-text (new text:basic%))
  ;; typeset the syntax as code
  (send syntax-text change-style tt-style-delta)
  (send syntax-text insert-port
        (open-input-string (syntax->string #`(#,stx)))) ; takes a list of stxs
  ;; circle irritants, if necessary
  (when (missed-opt-report-entry? s)
    (for ([i (in-list (missed-opt-report-entry-irritants s))]
          #:when (syntax-position i))
      (define start (- (syntax-position i) (syntax-position stx)))
      (define len   (syntax-span i))
      ;; will be off if there are comments inside an irritant (span will be
      ;; higher than what's actually displayed), but unless we make the
      ;; located version of irritants available, this is the best we can do
      (send syntax-text highlight-range
            start (+ start len) "pink" #f 'high 'rectangle)))
  (send syntax-text set-max-width usable-width)
  (send syntax-text auto-wrap #t)
  (send syntax-text lock #t)
  (send pane insert
        (new editor-snip% [editor syntax-text] [max-width popup-width]
             [with-border? #f] [bottom-margin 10]))
  (send pane insert-port (open-input-string "\n"))

  (define message-text (new text:basic% [auto-wrap #t]))
  (send message-text insert
        (make-object image-snip% (if (missed-opt-report-entry? s)
                                     (x-icon "red" 20)
                                     (check-icon "green" 20))))
  (send message-text insert-port
        (open-input-string (string-append "  " msg)))
  ;; adjust display
  (send message-text set-max-width usable-width)
  (send message-text auto-wrap #t)
  (send message-text lock #t)
  (send pane insert
        (new editor-snip% [editor message-text] [max-width popup-width]
             [with-border? #f] [top-margin 10] [bottom-margin 15]))

  ;; to place the next sub-entry below
  (send pane insert-port (open-input-string "\n\n"))
  (define line-bitmap (make-object bitmap% usable-width 5))
  (define bitmap-dc (make-object bitmap-dc% line-bitmap))
  (send bitmap-dc draw-line 0 2.5 usable-width 2.5)
  (send pane insert (make-object image-snip% line-bitmap))
  (send pane insert-port (open-input-string "\n\n")))
{'fraction_non_alphanumeric': 0.13361781570876116, 'fraction_numerical': 0.006934257901053474, 'mean_word_length': 3.21822272215973, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 5, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 2, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1453409', 'n_tokens_mistral': 2500, 'n_tokens_neox': 2316, 'n_words': 788}