<commit_before>#lang scheme/base
(require scheme/class
         "../syntax.ss"
         "cycle.ss")

(provide editor-wordbreak-map%
         the-editor-wordbreak-map
         standard-wordbreak)

(defclass editor-wordbreak-map% object%
  (define char-map (make-hash))

  (super-new)

  (hash-set! char-map #\- '(line))

  (def/public (set-map [char? ch] [(make-list (symbol-in caret line selection user1 user2)) mask])
    (hash-set! char-map ch mask))

  (def/public (get-map [char? ch])
    (or (hash-ref char-map ch #f)
        (cond
         [(or (char-alphabetic? ch)
              (char-numeric? ch))
          '(caret line selection)]
         [(not (char-whitespace? ch))
          '(line)]
         [else null]))))

(define the-editor-wordbreak-map (new editor-wordbreak-map%))

(define MAX-DIST-TRY 30)

(define wb-get-map (generic editor-wordbreak-map% get-map))

(define (string-ref* str n)
  (if (n . >= . (string-length str))
      #\nul
      (string-ref str n)))

(define/top (standard-wordbreak [text% win] 
                                [(make-or-false (make-box exact-nonnegative-integer?)) startp]
                                [(make-or-false (make-box exact-nonnegative-integer?)) endp]
                                [(symbol-in caret line selection user1 user2)reason])
  (with-method ([get-map ((send win get-wordbreak-map) get-map)])
    (define (nonbreak? ch) (memq reason (get-map ch)))

    (when startp
      (let* ([start (unbox startp)]
             [pstart start]
             [lstart (send win find-newline 'backward start 0)]
             [lstart (if lstart
                         (if (eq? 'caret reason)
                             (or (and (positive? lstart)
                                      (send win find-newline 'backward (sub1 lstart) 0))
                                 0)
                             lstart)
                         0)]
             [lend (min (+ start 1) (send win last-position))]
             [tstart (if ((- start lstart) . > . MAX-DIST-TRY)
                         (- start MAX-DIST-TRY)
                         lstart)]
             [text (send win get-text tstart lend)]
             [start (- start tstart)]
             [pstart (- pstart tstart)])

        (let ploop ([phase1-complete? #f]
                    [phase2-complete? #f]
                    [start start]
                    [pstart pstart]
                    [text text]
                    [tstart tstart])
          (let*-values ([(start phase1-complete?)
                         (if phase1-complete?
                             (values start #t)
                             (let ([start (if (and (positive? start)
                                                   (nonbreak? (string-ref* text start)))
                                              (sub1 start)
                                              start)])
                               (values start
                                       (not (nonbreak? (string-ref* text start))))))]
                        [(start phase2-complete?)
                         (if (not (eq? 'selection reason))
                             (if (not phase2-complete?)
                                 (let loop ([start start])
                                   (if (and (positive? start)
                                            (not (nonbreak? (string-ref* text start))))
                                       (loop (sub1 start))
                                       (if (nonbreak? (string-ref* text start))
                                           (values start #t)
                                           (values start #f))))
                                 (values start #t))
                             (values start phase2-complete?))])
            (let loop ([start start])
              (if (and (positive? start)
                       (nonbreak? (string-ref* text start)))
                  (loop (sub1 start))
                  (let ([start (if (and (start . < . pstart)
                                        (not (nonbreak? (string-ref* text start))))
                                   (add1 start)
                                   start)])
                    (if (and (zero? start)
                             (not (= lstart tstart)))
                        (ploop phase1-complete?
                               phase2-complete?
                               (+ start (- tstart lstart))
                               (+ pstart (- tstart lstart))
                               (send win get-text lstart lend)
                               lstart)
                        (set-box! startp (+ start tstart))))))))))
    
    (when endp
      (let* ([end (unbox endp)]
             [lstart end]
             [lend (send win find-newline 'forward end)]
             [lend (if lend
                       (if (eq? 'caret reason)
                           (or (send win find-newline 'forward (+ lend 1))
                               (send win last-position))
                           lend)
                       (send win last-position))]
             [tend (if ((- lend end) . > . MAX-DIST-TRY)
                       (+ end MAX-DIST-TRY)
                       lend)]
             [text (send win get-text lstart tend)]
             [end (- end lstart)]
             [lend (- lend lstart)]
             [tend (- tend lstart)])
        
        (let ploop ([phase1-complete? #f]
                    [text text]
                    [tend tend])
          (let-values ([(end phase1-complete?)
                        (if phase1-complete?
                            (values end #t)
                            (let loop ([end end])
                              (if (and (end . < . tend) 
                                       (not (nonbreak? (string-ref* text end))))
                                  (loop (add1 end))
                                  (if (end . < . tend)
                                      (values end #t)
                                      (values end #f)))))])
            (let loop ([end end])
              (if (and (end . < . tend)
                       (nonbreak? (string-ref* text end)))
                  (loop (add1 end))
                  (if (and (= tend end) (not (= lend tend)))
                      (ploop phase1-complete?
                             (send win get-text lstart (+ lstart lend))
                             lend)
                      (set-box! endp (+ end lstart)))))))))))
<commit_msg>fix forward-word bug for words > 30 characters<commit_after>#lang scheme/base
(require scheme/class
         "../syntax.ss"
         "cycle.ss")

(provide editor-wordbreak-map%
         the-editor-wordbreak-map
         standard-wordbreak)

(defclass editor-wordbreak-map% object%
  (define char-map (make-hash))

  (super-new)

  (hash-set! char-map #\- '(line))

  (def/public (set-map [char? ch] [(make-list (symbol-in caret line selection user1 user2)) mask])
    (hash-set! char-map ch mask))

  (def/public (get-map [char? ch])
    (or (hash-ref char-map ch #f)
        (cond
         [(or (char-alphabetic? ch)
              (char-numeric? ch))
          '(caret line selection)]
         [(not (char-whitespace? ch))
          '(line)]
         [else null]))))

(define the-editor-wordbreak-map (new editor-wordbreak-map%))

(define MAX-DIST-TRY 30)

(define wb-get-map (generic editor-wordbreak-map% get-map))

(define (string-ref* str n)
  (if (n . >= . (string-length str))
      #\nul
      (string-ref str n)))

(define/top (standard-wordbreak [text% win] 
                                [(make-or-false (make-box exact-nonnegative-integer?)) startp]
                                [(make-or-false (make-box exact-nonnegative-integer?)) endp]
                                [(symbol-in caret line selection user1 user2)reason])
  (with-method ([get-map ((send win get-wordbreak-map) get-map)])
    (define (nonbreak? ch) (memq reason (get-map ch)))

    (when startp
      (let* ([start (unbox startp)]
             [pstart start]
             [lstart (send win find-newline 'backward start 0)]
             [lstart (if lstart
                         (if (eq? 'caret reason)
                             (or (and (positive? lstart)
                                      (send win find-newline 'backward (sub1 lstart) 0))
                                 0)
                             lstart)
                         0)]
             [lend (min (+ start 1) (send win last-position))]
             [tstart (if ((- start lstart) . > . MAX-DIST-TRY)
                         (- start MAX-DIST-TRY)
                         lstart)]
             [text (send win get-text tstart lend)]
             [start (- start tstart)]
             [pstart (- pstart tstart)])

        (let ploop ([phase1-complete? #f]
                    [phase2-complete? #f]
                    [start start]
                    [pstart pstart]
                    [text text]
                    [tstart tstart])
          (let*-values ([(start phase1-complete?)
                         (if phase1-complete?
                             (values start #t)
                             (let ([start (if (and (positive? start)
                                                   (nonbreak? (string-ref* text start)))
                                              (sub1 start)
                                              start)])
                               (values start
                                       (not (nonbreak? (string-ref* text start))))))]
                        [(start phase2-complete?)
                         (if (not (eq? 'selection reason))
                             (if (not phase2-complete?)
                                 (let loop ([start start])
                                   (if (and (positive? start)
                                            (not (nonbreak? (string-ref* text start))))
                                       (loop (sub1 start))
                                       (if (nonbreak? (string-ref* text start))
                                           (values start #t)
                                           (values start #f))))
                                 (values start #t))
                             (values start phase2-complete?))])
            (let loop ([start start])
              (if (and (positive? start)
                       (nonbreak? (string-ref* text start)))
                  (loop (sub1 start))
                  (let ([start (if (and (start . < . pstart)
                                        (not (nonbreak? (string-ref* text start))))
                                   (add1 start)
                                   start)])
                    (if (and (zero? start)
                             (not (= lstart tstart)))
                        (ploop phase1-complete?
                               phase2-complete?
                               (+ start (- tstart lstart))
                               (+ pstart (- tstart lstart))
                               (send win get-text lstart lend)
                               lstart)
                        (set-box! startp (+ start tstart))))))))))
    
    (when endp
      (let* ([end (unbox endp)]
             [lstart end]
             [lend (send win find-newline 'forward end)]
             [lend (if lend
                       (if (eq? 'caret reason)
                           (or (send win find-newline 'forward (+ lend 1))
                               (send win last-position))
                           lend)
                       (send win last-position))]
             [tend (if ((- lend end) . > . MAX-DIST-TRY)
                       (+ end MAX-DIST-TRY)
                       lend)]
             [text (send win get-text lstart tend)]
             [end (- end lstart)]
             [lend (- lend lstart)]
             [tend (- tend lstart)])
        
        (let ploop ([phase1-complete? #f]
                    [text text]
                    [tend tend]
                    [end end])
          (let-values ([(end phase1-complete?)
                        (if phase1-complete?
                            (values end #t)
                            (let loop ([end end])
                              (if (and (end . < . tend) 
                                       (not (nonbreak? (string-ref* text end))))
                                  (loop (add1 end))
                                  (if (end . < . tend)
                                      (values end #t)
                                      (values end #f)))))])
            (let loop ([end end])
              (if (and (end . < . tend)
                       (nonbreak? (string-ref* text end)))
                  (loop (add1 end))
                  (if (and (= tend end) (not (= lend tend)))
                      (ploop phase1-complete?
                             (send win get-text lstart (+ lstart lend))
                             lend
                             end)
                      (set-box! endp (+ end lstart)))))))))))

{'fraction_non_alphanumeric': 0.11614384085692425, 'fraction_numerical': 0.0050497322111706195, 'mean_word_length': 0.933293891436178, 'pattern_counts': {'":': 0, '<': 11, '<?xml version=': 0, '>': 10, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 80, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5756783', 'n_tokens_mistral': 3409, 'n_tokens_neox': 3195, 'n_words': 913}