<commit_before>#lang scheme/unit

(require scheme/class
         scheme/list
         scheme/runtime-path
         scheme/contract
         setup/getinfo
         mred
         framework
         framework/splash
         "drsig.ss"
         "language-object-contract.ss"
         string-constants)

(require (for-syntax scheme/base scheme/match))

(import [prefix drscheme:frame: drscheme:frame^]
        [prefix drscheme:unit: drscheme:unit^]
        [prefix drscheme:rep: drscheme:rep^]
        [prefix drscheme:get/extend: drscheme:get/extend^]
        [prefix drscheme:language: drscheme:language^]
        [prefix drscheme:language-configuration: drscheme:language-configuration^]
        [prefix drscheme:help-desk: drscheme:help-desk^]
        [prefix drscheme:init: drscheme:init^]
        [prefix drscheme:debug: drscheme:debug^]
        [prefix drscheme:eval: drscheme:eval^]
        [prefix drscheme:modes: drscheme:modes^]
        [prefix drscheme:tracing: drscheme:tracing^])
(export drscheme:tools^)

;; An installed-tool is
;; (make-installed-tool directory-record module-spec string/#f string/#f string/#f string/#f)
(define-struct installed-tool (dir spec bitmap name url))

;; installed-tools : (list-of installed-tool)
(define installed-tools null)

;; successful-tool = (make-successful-tool module-spec 
;;                                         (union #f (instanceof bitmap%))
;;                                         (union #f string)
;;                                         (union #f string))
(define-struct successful-tool (spec bitmap name url))

;; successful-tools : (listof successful-tool)
(define successful-tools null)

;; get-successful-tools : -> (listof successful-tool)
(define (get-successful-tools) successful-tools)

;; successfully-loaded-tool = 
;; (make-successfully-loaded-tool 
;;    module-spec (union #f (instanceof bitmap%)) (union #f string) (union #f string)
;;    (-> void) (-> void))
(define-struct successfully-loaded-tool (spec bitmap name url phase1 phase2))

;; successfully-loaded-tools : (listof successfully-loaded-tool)
;; this list contains the tools that successfully were loaded
;; it is updated in load/invoke-tool. 
(define successfully-loaded-tools null)

;; load/invoke-all-tools : -> void
(define (load/invoke-all-tools phase1-extras phase2-extras)
  (rescan-installed-tools!)
  (set! current-phase 'loading-tools)
  (let ([candidate-tools (filter candidate-tool? installed-tools)])
    (for-each load/invoke-tool candidate-tools)
    (run-phases phase1-extras phase2-extras)))

;; rescan-installed-tools! : -> void
(define (rescan-installed-tools!)
  (set! installed-tools (all-installed-tools)))

;; all-installed-tools : -> (list-of installed-tool)
(define (all-installed-tools)
  (apply append
         (map installed-tools-for-directory
              (all-tool-directories))))

;; all-tool-directories : -> (list-of directory-record)
(define (all-tool-directories)
  (find-relevant-directory-records '(tools tool-icons tool-names tool-urls)))

;; installed-tools-for-directory : directory-record -> (list-of installed-tool)
(define (installed-tools-for-directory coll-dir)
  (let ([table (get-info/full (directory-record-path coll-dir))])
    (if table
        (let* ([tools (table 'tools (lambda () null))]
               [tool-icons (table 'tool-icons (lambda () (map (lambda (x) #f) tools)))]
               [tool-names (table 'tool-names (lambda () (map (lambda (x) #f) tools)))]
               [tool-urls (table 'tool-urls (lambda () (map (lambda (x) #f) tools)))])
          (unless (= (length tools) (length tool-icons))
            (message-box (string-constant drscheme)
                         (format (string-constant tool-tool-icons-same-length)
                                 coll-dir tools tool-icons)
                         #f
                         '(ok stop))
            (set! tool-icons (map (lambda (x) #f) tools)))
          (unless (= (length tools) (length tool-names))
            (message-box (string-constant drscheme)
                         (format (string-constant tool-tool-names-same-length)
                                 coll-dir tools tool-names)
                         #f
                         '(ok stop))
            (set! tool-names (map (lambda (x) #f) tools)))
          (unless (= (length tools) (length tool-urls))
            (message-box (string-constant drscheme)
                         (format (string-constant tool-tool-urls-same-length)
                                 coll-dir tools tool-urls)
                         #f
                         '(ok stop))
            (set! tool-urls (map (lambda (x) #f) tools)))
          (map (lambda (t i n u) (make-installed-tool coll-dir t i n u))
               tools tool-icons tool-names tool-urls))
        null)))

;; candidate-tool? : installed-tool -> boolean
;; Predicate for tools selected for execution in this
;; run of DrScheme (depending on env variables and preferences)
(define candidate-tool?
  (cond<commit_msg>PR 10273<commit_after>#lang scheme/unit

(require scheme/class
         scheme/list
         scheme/runtime-path
         scheme/contract
         setup/getinfo
         mred
         framework
         framework/splash
         "drsig.ss"
         "language-object-contract.ss"
         string-constants)

(require (for-syntax scheme/base scheme/match))

(import [prefix drscheme:frame: drscheme:frame^]
        [prefix drscheme:unit: drscheme:unit^]
        [prefix drscheme:rep: drscheme:rep^]
        [prefix drscheme:get/extend: drscheme:get/extend^]
        [prefix drscheme:language: drscheme:language^]
        [prefix drscheme:language-configuration: drscheme:language-configuration^]
        [prefix drscheme:help-desk: drscheme:help-desk^]
        [prefix drscheme:init: drscheme:init^]
        [prefix drscheme:debug: drscheme:debug^]
        [prefix drscheme:eval: drscheme:eval^]
        [prefix drscheme:modes: drscheme:modes^]
        [prefix drscheme:tracing: drscheme:tracing^])
(export drscheme:tools^)

;; An installed-tool is
;; (make-installed-tool directory-record module-spec string/#f string/#f string/#f string/#f)
(define-struct installed-tool (dir spec bitmap name url))

;; installed-tools : (list-of installed-tool)
(define installed-tools null)

;; successful-tool = (make-successful-tool module-spec 
;;                                         (union #f (instanceof bitmap%))
;;                                         (union #f string)
;;                                         (union #f string))
(define-struct successful-tool (spec bitmap name url))

;; successful-tools : (listof successful-tool)
(define successful-tools null)

;; get-successful-tools : -> (listof successful-tool)
(define (get-successful-tools) successful-tools)

;; successfully-loaded-tool = 
;; (make-successfully-loaded-tool 
;;    module-spec (union #f (instanceof bitmap%)) (union #f string) (union #f string)
;;    (-> void) (-> void))
(define-struct successfully-loaded-tool (spec bitmap name url phase1 phase2))

;; successfully-loaded-tools : (listof successfully-loaded-tool)
;; this list contains the tools that successfully were loaded
;; it is updated in load/invoke-tool. 
(define successfully-loaded-tools null)

;; load/invoke-all-tools : -> void
(define (load/invoke-all-tools phase1-extras phase2-extras)
  (rescan-installed-tools!)
  (set! current-phase 'loading-tools)
  (let ([candidate-tools (filter candidate-tool? installed-tools)])
    (for-each load/invoke-tool candidate-tools)
    (run-phases phase1-extras phase2-extras)))

;; rescan-installed-tools! : -> void
(define (rescan-installed-tools!)
  (set! installed-tools (all-installed-tools)))

;; all-installed-tools : -> (list-of installed-tool)
(define (all-installed-tools)
  (apply append
         (map installed-tools-for-directory
              (all-tool-directories))))

;; all-tool-directories : -> (list-of directory-record)
(define (all-tool-directories)
  (find-relevant-directory-records '(tools tool-icons tool-names tool-urls)))

;; installed-tools-for-directory : directory-record -> (list-of installed-tool)
(define (installed-tools-for-directory coll-dir)
  (let ([table (with-handlers ((exn:fail? values))
                 (get-info/full (directory-record-path coll-dir)))])
    (cond
      [(not table)
       null]
      [(exn? table)
       (message-box (string-constant drscheme)
                    (format (string-constant error-loading-tool-title)
                            (directory-record-path coll-dir)
                            (let ([sp (open-output-string)])
                              (parameterize ([current-error-port sp]
                                             [current-error-port sp])
                                (drscheme:init:original-error-display-handler (exn-message table) table))
                              (get-output-string sp)))
                    #f
                    '(ok stop))
       null]
      [else
       (let* ([tools (table 'tools (lambda () null))]
              [tool-icons (table 'tool-icons (lambda () (map (lambda (x) #f) tools)))]
              [tool-names (table 'tool-names (lambda () (map (lambda (x) #f) tools)))]
              [tool-urls (table 'tool-urls (lambda () (map (lambda (x) #f) tools)))])
         (unless (= (length tools) (length tool-icons))
           (message-box (string-constant drscheme)
                        (format (string-constant tool-tool-icons-same-length)
                                coll-dir tools tool-icons)
                        #f
                        '(ok stop))
           (set! tool-icons (map (lambda (x) #f) tools)))
         (unless (= (length tools) (length tool-names))
           (message-box (string-constant drscheme)
                        (format (string-constant tool-tool-names-same-length)
                                coll-dir tools tool-names)
                        #f
                        '(ok stop))
           (set! tool-names (map (lambda (x) #f) tools)))
         (unless (= (length tools) (length tool-urls))
           (message-box (string-constant drscheme)
                        (format (string-constant tool-tool-urls-same-length)
                                coll-dir tools tool-urls)
                        #f
                        '(ok stop))
           (set! tool-urls (map (lambda (x) #f) tools)))
         (map (lambda (t i n u) (make-installed-tool coll-dir t i n u))
              tools tool-icons tool-names tool-urls))])))

;; candidate-tool? : installed-tool -> boolean
;; Predicate for tools selected for execution in this
;; run of DrScheme (depending on env variables and preferences)
(define candidate-tool?
  (cond
{'fraction_non_alphanumeric': 0.13214419125887186, 'fraction_numerical': 0.0015875980575270825, 'mean_word_length': 2.22851974675912, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 21, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 17, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2957037', 'n_tokens_mistral': 3049, 'n_tokens_neox': 2991, 'n_words': 755}