<commit_before>#lang scheme/unit

(require scheme/gui/base
         browser/external
         framework
         scheme/class
         net/url
         setup/dirs
         help/search
         help/private/buginfo
         "drsig.ss")

(import [prefix drscheme:frame: drscheme:frame^]
        [prefix drscheme:language-configuration: drscheme:language-configuration/internal^])
(export drscheme:help-desk^)

(define (-add-help-desk-font-prefs b) '(add-help-desk-font-prefs b))

;; : -> string
(define (get-computer-language-info)
  (let* ([language/settings (preferences:get 
                             drscheme:language-configuration:settings-preferences-symbol)]
         [language (drscheme:language-configuration:language-settings-language
                    language/settings)]
         [settings (drscheme:language-configuration:language-settings-settings
                    language/settings)])
    (format
     "~s"
     (list
      (send language get-language-position)
      (send language marshall-settings settings)))))

(set-bug-report-info! "Computer Language" get-computer-language-info)

(define lang-message%
  (class canvas%
    (init-field button-release font)
    (define/override (on-event evt)
      (when (send evt button-up?)
        (button-release)))
    (field [msg ""])
    (define/public (set-msg l) (set! msg l) (on-paint))
    (inherit get-dc get-client-size)
    (define/override (on-paint)
      (let ([dc (get-dc)]
            [dots "..."])
        (let-values ([(tw th _1 _2) (send dc get-text-extent msg)]
                     [(dw dh _3 _4) (send dc get-text-extent dots)]
                     [(cw ch) (get-client-size)])
          (send dc set-brush (send the-brush-list find-or-create-brush (get-panel-background) 'panel))
          (send dc set-pen (send the-pen-list find-or-create-pen "black" 1 'transparent))
          (send dc set-font font)
          (send dc draw-rectangle 0 0 cw ch)
          (cond
            [(tw . <= . cw)
             (send dc draw-text msg 0 (- (/ ch 2) (/ th 2)))]
            [(cw . <= . dw)  ;; just give up if there's not enough room to draw the dots
             (void)]
            [else
             (send dc set-clipping-rect 0 0 (- cw dw 2) ch)
             (send dc draw-text msg 0 (- (/ ch 2) (/ th 2)))
             (send dc set-clipping-region #f)
             (send dc draw-text dots (- cw dw) (- (/ ch 2) (/ th 2)))]))))
    (super-new)))

(define (goto-plt-license) 
  (send-url
    (url->string
     (path->url (build-path (find-doc-dir) "license" "index.html")))))

(define (get-docs) '())

(define help-desk
  (case-lambda
    [() (send-main-page)]
    [(key) (perform-search (list key))]))<commit_msg>perform-search expects a single string, at least for now<commit_after>#lang scheme/unit

(require scheme/gui/base
         browser/external
         framework
         scheme/class
         net/url
         setup/dirs
         help/search
         help/private/buginfo
         "drsig.ss")

(import [prefix drscheme:frame: drscheme:frame^]
        [prefix drscheme:language-configuration: drscheme:language-configuration/internal^])
(export drscheme:help-desk^)

(define (-add-help-desk-font-prefs b) '(add-help-desk-font-prefs b))

;; : -> string
(define (get-computer-language-info)
  (let* ([language/settings (preferences:get 
                             drscheme:language-configuration:settings-preferences-symbol)]
         [language (drscheme:language-configuration:language-settings-language
                    language/settings)]
         [settings (drscheme:language-configuration:language-settings-settings
                    language/settings)])
    (format
     "~s"
     (list
      (send language get-language-position)
      (send language marshall-settings settings)))))

(set-bug-report-info! "Computer Language" get-computer-language-info)

(define lang-message%
  (class canvas%
    (init-field button-release font)
    (define/override (on-event evt)
      (when (send evt button-up?)
        (button-release)))
    (field [msg ""])
    (define/public (set-msg l) (set! msg l) (on-paint))
    (inherit get-dc get-client-size)
    (define/override (on-paint)
      (let ([dc (get-dc)]
            [dots "..."])
        (let-values ([(tw th _1 _2) (send dc get-text-extent msg)]
                     [(dw dh _3 _4) (send dc get-text-extent dots)]
                     [(cw ch) (get-client-size)])
          (send dc set-brush (send the-brush-list find-or-create-brush (get-panel-background) 'panel))
          (send dc set-pen (send the-pen-list find-or-create-pen "black" 1 'transparent))
          (send dc set-font font)
          (send dc draw-rectangle 0 0 cw ch)
          (cond
            [(tw . <= . cw)
             (send dc draw-text msg 0 (- (/ ch 2) (/ th 2)))]
            [(cw . <= . dw)  ;; just give up if there's not enough room to draw the dots
             (void)]
            [else
             (send dc set-clipping-rect 0 0 (- cw dw 2) ch)
             (send dc draw-text msg 0 (- (/ ch 2) (/ th 2)))
             (send dc set-clipping-region #f)
             (send dc draw-text dots (- cw dw) (- (/ ch 2) (/ th 2)))]))))
    (super-new)))

(define (goto-plt-license) 
  (send-url
    (url->string
     (path->url (build-path (find-doc-dir) "license" "index.html")))))

(define (get-docs) '())

(define help-desk
  (case-lambda
    [() (send-main-page)]
    [(key) (perform-search key)]))
{'fraction_non_alphanumeric': 0.14843462246777164, 'fraction_numerical': 0.0066298342541436465, 'mean_word_length': 2.101656196459166, 'pattern_counts': {'":': 0, '<': 7, '<?xml version=': 0, '>': 9, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3296986', 'n_tokens_mistral': 1778, 'n_tokens_neox': 1689, 'n_words': 434}