
(module multi-file-search mzscheme
  (require (lib "framework.ss" "framework")
           (lib "class.ss")
           (lib "unitsig.ss")
           (lib "mred.ss" "mred")
           (lib "file.ss")
           (lib "thread.ss")
           (lib "async-channel.ss")
           (lib "string-constant.ss" "string-constants")
           "drsig.ss")
  
  (provide multi-file-search@)
  
  (define multi-file-search@
    (unit/sig drscheme:multi-file-search^
      (import [drscheme:frame : drscheme:frame^]
              [drscheme:unit : drscheme:unit^])
      
      ;; multi-file-search : -> void
      ;; opens a dialog to configure the search and initiates the search
      (define (multi-file-search)
        (let ([search-info  (configure-search)])
          (when search-info
            (open-search-window search-info))))
      
      ;; searcher = (string (string int int int -> void) -> void)
      ;; this performs a single search.
      ;; the first argument is the filename to be searched
      ;; the second argument is called for each match.
      ;;     the arguments are: line-string line-number col-number match-length
      
      
      ;; search-type = (make-search-type string make-searcher (listof (cons string boolean)))
      ;; the param strings are the labels for checkboxes
      ;; the param booleans are the default values for the checkboxes
      ;; these are the available searches
      (define-struct search-type (label make-searcher params))
      
      ;; search-info = (make-search-info string boolean (union #f regexp) search-type)
      (define-struct search-info (dir recur? filter searcher))
      
      ;; search-types : (listof search-type)
      (define search-types
        (list (make-search-type
               (string-constant mfs-string-match/graphics)
               (λ (info search-string) (exact-match-searcher info search-string))
               (list (cons (string-constant mfs-case-sensitive-label) #f)))
              (make-search-type
               (string-constant mfs-regexp-match/no-graphics)
               (λ (info search-string) (regexp-match-searcher info search-string))
               (list))))
      
      ;; search-entry = (make-search-entry string number number number)
      (define-struct search-entry (filename line-string line-number col-number match-length))
      
      ;; preferences initialization
      (preferences:set-default 'drscheme:multi-file-search:recur? #t boolean?)
      (preferences:set-default 'drscheme:multi-file-search:filter? #t boolean?)
      (preferences:set-default 'drscheme:multi-file-search:filter-string "\\.(ss|scm)$" string?)
      (preferences:set-default 'drscheme:multi-file-search:search-string "" string?)
      (preferences:set-default 'drscheme:multi-file-search:search-type
                               1
                               (λ (x) 
                                 (and (number? x)
                                      (exact? x)
                                      (integer? x)
                                      (<= 0 x)
                                      (< x (length search-types)))))
      
      ;; drscheme:mult-file-search:search-check-boxes : (listof (listof boolean))
      (preferences:set-default 'drscheme:multi-file-search:search-check-boxes 
                               (map (λ (x) (map cdr (search-type-params x)))
                                    search-types)
                               (λ (x) 
                                 (and (list? x)
                                      (andmap (λ (x)
                                                (and (list? x)
                                                     (andmap boolean? x)))
                                              x))))
      
      (preferences:set-default 'drscheme:multi-file-search:percentages
                               '(1/3 2/3)
                               (λ (x) (and (list? x)
                                                (= 2 (length x))
                                                (= 1 (apply + x)))))
      
      (preferences:set-default 'drscheme:multi-file-search:frame-size '(300 . 400) 
                               (λ (x) (and (pair? x)
                                                (number? (car x))
                                                (number? (cdr x)))))
      (preferences:set-default 'drscheme:multi-file-search:directory 
                               ;; The default is #f because
                               ;; filesystem-root-list is expensive under Windows
                               #f 
                               (lambda (x) (or (not x) (path? x))))
      (preferences:set-un/marshall 
       'drscheme:multi-file-search:directory
       (λ (v) (path->string v))
       (λ (p) (if (path-string? p)
                       (string->path p)
                       #f)))
      
      
      ;; open-search-window : search-info -> void
      ;; thread: eventspace main thread
      ;; opens a window and creates the thread that does the search
      (define (open-search-window search-info)
        (define frame (make-object search-size-frame% (string-constant mfs-drscheme-multi-file-search)))
        (define panel (make-object saved-vertical-resizable% (send frame get-area-container)))
        (define button-panel (make-object horizontal-panel% (send frame get-area-container)))
        (define open-button (make-object button% (string-constant mfs-open-file) button-panel
                              (λ (x y) (open-file-callback))))
        (define stop-button (make-object button% (string-constant mfs-stop-search) button-panel
                              (λ (x y) (stop-callback))))
        (define grow-box-pane (make-object grow-box-spacer-pane% button-panel))
        
        (define zoom-text (make-object scheme:text%))
        (define results-text (make-object results-text% zoom-text))
        (define results-ec (instantiate searching-canvas% ()
                             (parent panel)
                             (editor results-text)
                             (frame frame)))
        (define zoom-ec (instantiate searching-canvas% ()
                          (parent panel)
                          (editor zoom-text)
                          (frame frame)))
        
        (define (open-file-callback)
          (send results-text open-file))
        
	;; sometimes, breaking the other thread puts
	;; the break message in the channel behind
	;; many many requests. Rather than show those,
	;; we use the `broken?' flag as a shortcut.
	(define broken? #f)
        (define (stop-callback)
          (break-thread search-thd)
	  (set! broken? #t)
          (send stop-button enable #f))
        
        ;; channel : async-channel[(union 'done search-entry)]
        (define channel (make-async-channel 100))
        (define search-thd (thread (λ () (do-search search-info channel))))
        
        (send frame set-text-to-search results-text) ;; just to initialize it to something.
        (send results-text lock #t)
        (send frame reflow-container)
        (send panel set-percentages (preferences:get 'drscheme:multi-file-search:percentages))
        (send button-panel set-alignment 'right 'center)
        (send button-panel stretchable-height #f)
        (send frame show #t)
        
        (let loop ()
          (let ([match (yield channel)])
            (yield)
            (cond
              [(eq? match 'done)
               (send results-text search-complete)
               (send stop-button enable #f)]
              [(or broken? (eq? match 'break))
               (send results-text search-interrupted)]
              [else
               (send results-text add-match
                     (search-info-dir search-info)
                     (search-entry-filename match)
                     (search-entry-line-string match)
                     (search-entry-line-number match)
                     (search-entry-col-number match)
                     (search-entry-match-length match))
               (loop)]))))
      
      (define results-super-text% 
        (text:hide-caret/selection-mixin
         (text:basic-mixin 
          (editor:standard-style-list-mixin 
           (editor:basic-mixin
            text%)))))
      
      ;; results-text% : derived from text%
      ;; init args: zoom-text
      ;;   zoom-text : (instance-of text%)
      ;; public-methods:
      ;;   add-match : string string int int int int -> void
      ;;      adds a match to the text
      ;;   search-interrupted : -> void
      ;;      inserts a message saying "search interrupted".
      ;;      search-complete is not expected to be called if this method is called.
      ;;   search-complete : -> void
      ;;      inserts a message saying "no matches found" if none were reported
      (define results-text%
        (class results-super-text%
          (init-field zoom-text)
          (inherit insert last-paragraph erase
                   paragraph-start-position paragraph-end-position
                   last-position change-style
                   set-clickback set-position
                   end-edit-sequence begin-edit-sequence
                   lock)
          
          [define filename-delta (make-object style-delta% 'change-bold)]
          [define match-delta (let ([d (make-object style-delta%)])
                                (send d set-delta-foreground
				      (make-object color%
					0
					160
					0))
                                d)]
          [define hilite-line-delta (make-object style-delta% 'change-style 'italic)]
          [define unhilite-line-delta (make-object style-delta% 'change-style 'normal)]
          [define widest-filename #f]
          [define/private indent-all-lines
            ;; indent-all-lines : number -> void
            ;; inserts `offset' spaces to the beginning of each line,
            ;; except the last one. Must be at least one such line in the text.
            (λ (offset)
              (let ([spaces (make-string offset #\space)])
                (let loop ([para (- (last-paragraph) 1)])
                  (let ([para-start (paragraph-start-position para)])
                    (insert spaces para-start para-start)
                    (change-style filename-delta para-start (+ para-start offset)))
                  (unless (zero? para)
                    (loop (- para 1))))))]
          
          ;; match-shown? : boolean
          ;; indicates if a match has ever been shown.
          ;; if not, need to clean out the "searching" message
          ;; and show a match. Done in `add-match'
          [define match-shown? #f]
          
          ;; current-file : (union #f string)
          ;; the name of the currently viewed file, if one if viewed.
          ;; line-in-current-file and col-in-current-file are linked
          [define current-file #f]
          [define line-in-current-file #f]
          [define col-in-current-file #f]
          
          [define old-line #f]
          [define/private hilite-line
            (λ (line)
              (begin-edit-sequence)
              (lock #f)
              (when old-line
                (change-style unhilite-line-delta
                              (paragraph-start-position old-line)
                              (paragraph-end-position old-line)))
              (when line
                (change-style hilite-line-delta
                              (paragraph-start-position line)
                              (paragraph-end-position line)))
              (set! old-line line)
              (lock #t)
              (end-edit-sequence))]
          
          [define/public (open-file)
            (when current-file
              (let ([f (handler:edit-file current-file)])
                (when (and f
                           (is-a? f drscheme:unit:frame<%>))
                  (let* ([t (send f get-definitions-text)]
                         [pos (+ (send t paragraph-start-position line-in-current-file)
                                 col-in-current-file)])
                    (send t set-position pos)))))]
          
          [define/public add-match
            (λ (base-filename full-filename line-string line-number col-number match-length)
              (lock #f)
              (let* ([new-line-position (last-position)]
                     [short-filename 
                      (path->string
                       (find-relative-path 
                        (normalize-path base-filename)
                        (normalize-path full-filename)))]
                     [this-match-number (last-paragraph)]
                     [len (string-length short-filename)]
                     [insertion-start #f]
                     [show-this-match
                      (λ ()
                        (set! match-shown? #t)
                        (set! current-file full-filename)
                        (set! line-in-current-file line-number)
                        (set! col-in-current-file col-number)
                        (set-position new-line-position new-line-position)
                        (send zoom-text begin-edit-sequence)
                        (send zoom-text lock #f)
                        (send zoom-text load-file/gui-error full-filename)
                        (send zoom-text set-position (send zoom-text paragraph-start-position line-number))
                        (let ([start (+ (send zoom-text paragraph-start-position line-number)
                                        col-number)])
                          (send zoom-text change-style match-delta start (+ start match-length)))
                        (send zoom-text lock #t)
                        (send zoom-text set-caret-owner #f 'global)
                        (hilite-line this-match-number)
                        (send zoom-text end-edit-sequence))])
                (unless match-shown?
                  (erase))
                (unless widest-filename
                  (set! widest-filename len))
                (if (<= len widest-filename)
                    (begin
                      (set! insertion-start (last-position))
                      (insert (make-string (- widest-filename len) #\space) 
                              (last-position) (last-position)))
                    (begin
                      (indent-all-lines (- len widest-filename))
                      (set! insertion-start (last-position))
                      (set! widest-filename len)))
                (let ([filename-start (last-position)])
                  (insert short-filename (last-position) (last-position))
                  (insert ": " (last-position) (last-position))
                  (change-style filename-delta insertion-start (last-position))
                  (let ([line-start (last-position)])
                    (insert line-string (last-position) (last-position))
                    (change-style match-delta
                                  (+ line-start col-number)
                                  (+ line-start col-number match-length)))
                  (set-clickback filename-start (last-position)
                                 (λ (_1 _2 _3)
                                   (show-this-match)))
                  (insert #\newline (last-position) (last-position))
                  
                  (unless match-shown?
                    (show-this-match))))
              (lock #t))]
          
          (define/public (search-interrupted)
            (lock #f)
            (insert #\newline (last-position) (last-position))
            (insert (string-constant mfs-search-interrupted) (last-position) (last-position))
            (lock #t))
          
          (define/public (search-complete)
            (unless match-shown?
              (lock #f)
              (insert #\newline (last-position) (last-position))
              (insert (string-constant mfs-no-matches-found) (last-position) (last-position))
              (lock #t)))
          
          (inherit get-style-list set-style-list set-styles-sticky)
          (super-instantiate ())
          (send zoom-text lock #t)
          (set-styles-sticky #f)
          (insert (string-constant mfs-searching...))))
      
      ;; collaborates with search-size-frame%
      (define searching-canvas%
        (class canvas:basic%
          (init-field frame)
          (inherit get-editor)
          (define/override (on-focus on?)
            (when on?
              (send frame set-text-to-search (get-editor)))
            (super on-focus on?))
          (super-instantiate ())))
      
      ;; thread: eventspace main thread
      (define search-size-frame%
        (class (drscheme:frame:basics-mixin 
                (frame:searchable-mixin
                 frame:standard-menus%))
          (init-field name)
          
          (field [text-to-search #f])
          (define/public (set-text-to-search text) (set! text-to-search text))
          (define/override (get-text-to-search) text-to-search)
          
          (define/override (on-size w h)
            (preferences:set 'drscheme:multi-file-search:frame-size (cons w h))
            (super on-size w h))
          (let ([size (preferences:get 'drscheme:multi-file-search:frame-size)])
            (super-instantiate ()
              (label name)
              (width (car size))
              (height (cdr size))))))
      
      
      ;; this vertical-resizable class just remembers the percentage between the
      ;; two panels
      ;; thread: eventspace main thread
      (define saved-vertical-resizable%
        (class panel:vertical-dragable%
          (inherit get-percentages)
          (define/augment (after-percentage-change)
            (let ([ps (get-percentages)])
              (when (= (length ps) 2)
                (preferences:set 'drscheme:multi-file-search:percentages ps)))
            (inner (void) after-percentage-change))
          (super-instantiate ())))
      
      ;; configure-search : -> (union #f search-info)
      ;; thread: eventspace main thread
      ;; configures the search
      (define (configure-search)
        (define dialog (make-object dialog% (string-constant mfs-configure-search)
                         #f 500 #f #f #f '(resize-border)))
        (define outer-files-panel (make-object vertical-panel% dialog '(border)))
        (define outer-method-panel (make-object vertical-panel% dialog '(border)))
        (define button-panel (make-object horizontal-panel% dialog))
        (define files-label (make-object message% (string-constant mfs-files-section) outer-files-panel))
        (define files-inset-outer-panel (make-object horizontal-panel% outer-files-panel))
        (define files-inset-panel (make-object horizontal-panel% files-inset-outer-panel))
        (define files-panel (make-object vertical-panel% files-inset-outer-panel))
        (define method-label (make-object message% (string-constant mfs-search-section) outer-method-panel))
        (define method-inset-outer-panel (make-object horizontal-panel% outer-method-panel))
        (define method-inset-panel (make-object horizontal-panel% method-inset-outer-panel))
        (define method-panel (make-object vertical-panel% method-inset-outer-panel))
        
        (define dir-panel (make-object horizontal-panel% files-panel))
        (define dir-field (make-object text-field% (string-constant mfs-dir) dir-panel
                            (λ (x y) (dir-field-callback))))
        (define dir-button (make-object button% (string-constant browse...) dir-panel 
                             (λ (x y) (dir-button-callback))))
        
        (define recur-check-box (make-object check-box% (string-constant mfs-recur-over-subdirectories) files-panel
                                  (λ (x y) (recur-check-box-callback))))
        
        (define filter-panel (make-object horizontal-panel% files-panel))
        (define filter-check-box (make-object check-box% (string-constant mfs-regexp-filename-filter) filter-panel
                                   (λ (x y) (filter-check-box-callback))))
        (define filter-text-field (make-object text-field% #f filter-panel 
                                    (λ (x y) (filter-text-field-callback))))
        
        (define methods-choice (make-object choice% #f (map search-type-label search-types) method-panel 
                                 (λ (x y) (methods-choice-callback))))
        (define search-text-field (make-object text-field% (string-constant mfs-search-string) method-panel
                                    (λ (x y) (search-text-field-callback))))
        (define active-method-panel (make-object panel:single% method-panel))
        (define methods-check-boxess
          (let ([pref (preferences:get 'drscheme:multi-file-search:search-check-boxes)])
            (map
             (λ (search-type prefs-settings)
               (let ([p (make-object vertical-panel% active-method-panel)]
                     [params (search-type-params search-type)])
                 (send p set-alignment 'left 'center)
                 (map (λ (flag-pair prefs-setting)
                        (let ([cb (make-object check-box% 
                                    (car flag-pair)
                                    p
                                    (λ (evt chk) (method-callback chk)))])
                          (send cb set-value prefs-setting)
                          cb))
                      params
                      (if (= (length params) (length prefs-settings))
                          prefs-settings
                          (map (λ (x) #f) params)))))
             search-types
             (if (= (length search-types) (length pref))
                 pref
                 (map (λ (x) '()) search-types)))))
        (define-values (ok-button cancel-button)
          (gui-utils:ok/cancel-buttons
           button-panel
           (λ (x y) (ok-button-callback))
           (λ (x y) (cancel-button-callback))))
        (define spacer (make-object grow-box-spacer-pane% button-panel))
        
        ;; initialized to a searcher during the ok button callback
        ;; so the user can be informed of an error before the dialog
        ;; closes.
        (define searcher #f)
        
        ;; initialized to a regexp if the user wants to filter filenames,
        ;; during the ok-button-callback, so errors can be signalled.
        (define filter #f)
        
        ;; title for message box that signals error messages
        (define message-box-title (string-constant mfs-drscheme-multi-file-search))
        
        (define (ok-button-callback)
          (cond
            [(with-handlers ([exn:fail:filesystem?
                              (λ (x) #f)])
               (directory-exists? (send dir-field get-value)))
             (let ([_searcher
                    ((search-type-make-searcher (list-ref search-types (send methods-choice get-selection)))
                     (map (λ (cb) (send cb get-value))
                          (send (send active-method-panel active-child) get-children))
                     (send search-text-field get-value))])
               (if (string? _searcher)
                   (message-box message-box-title _searcher dialog)
                   (let ([regexp (with-handlers ([(λ (x) #t)
                                                  (λ (exn)
						    (format "~a" (exn-message exn)))])
                                   (and (send filter-check-box get-value)
                                        (regexp (send filter-text-field get-value))))])
                     (if (string? regexp)
                         (message-box message-box-title regexp dialog)
                         (begin (set! searcher _searcher)
                                (set! filter regexp)
                                (set! ok? #t)
                                (send dialog show #f))))))]
            [else
             (message-box message-box-title
                          (format (string-constant mfs-not-a-dir) (send dir-field get-value))
                          dialog)]))
        (define (cancel-button-callback)
          (send dialog show #f))
        
        (define (method-callback chk)
          (preferences:set
           'drscheme:multi-file-search:search-check-boxes
           (let loop ([methods-check-boxess methods-check-boxess])
             (cond
               [(null? methods-check-boxess) null]
               [else
                (let loop ([methods-check-boxes (car methods-check-boxess)])
                  (cond
                    [(null? methods-check-boxes) null]
                    [else (cons (send (car methods-check-boxes) get-value)
                                (loop (cdr methods-check-boxes)))]))]))))
        
        (define (dir-field-callback)
          (let ([df (send dir-field get-value)])
            (when (path-string? df)
              (preferences:set 'drscheme:multi-file-search:directory (string->path df)))))
        
        (define (filter-check-box-callback) 
          (preferences:set 'drscheme:multi-file-search:filter? (send filter-check-box get-value))
          (send filter-text-field enable (send filter-check-box get-value)))
        (define (filter-text-field-callback)
          (preferences:set 'drscheme:multi-file-search:filter-string (send filter-text-field get-value)))
        
        (define (recur-check-box-callback)
          (preferences:set 'drscheme:multi-file-search:recur? (send recur-check-box get-value)))
        (define (methods-choice-callback)
          (preferences:set 'drscheme:multi-file-search:search-type (send methods-choice get-selection)) 
          (send active-method-panel active-child
                (list-ref (send active-method-panel get-children)
                          (send methods-choice get-selection))))
        (define (search-text-field-callback)
          (preferences:set 'drscheme:multi-file-search:search-string (send search-text-field get-value)))
        (define (dir-button-callback) 
          (let ([d (get-directory)])
            (when (and d
                       (directory-exists? d))
              (preferences:set 'drscheme:multi-file-search:directory d)
              (send dir-field set-value (path->string d)))))
        
        (define (get-files)
          (let ([dir (string->path (send dir-field get-value))])
            (and (directory-exists? dir)
                 (if (send recur-check-box get-value)
                     (build-recursive-file-list dir filter)
                     (build-flat-file-list dir filter)))))
        
        (define ok? #f)
        
        (send button-panel set-alignment 'right 'center)
        (send dir-panel stretchable-height #f)
        (send outer-files-panel stretchable-height #f)
        (send outer-files-panel set-alignment 'left 'center)
        (send files-inset-panel min-width 20)
        (send files-inset-panel stretchable-width #f)
        (send files-panel set-alignment 'left 'center)
        
        (send recur-check-box set-value (preferences:get 'drscheme:multi-file-search:recur?))
        (send filter-check-box set-value (preferences:get 'drscheme:multi-file-search:filter?))
        (send search-text-field set-value (preferences:get 'drscheme:multi-file-search:search-string))
        (send filter-text-field set-value (preferences:get 'drscheme:multi-file-search:filter-string))
        (send dir-field set-value (path->string 
                                   (let ([p (preferences:get 'drscheme:multi-file-search:directory)])
                                     (if (not p)
                                         (let ([p (car (filesystem-root-list))])
                                           (preferences:set 'drscheme:multi-file-search:directory p)
                                           p)
                                         p))))
        
        (send outer-method-panel stretchable-height #f)
        (send outer-method-panel set-alignment 'left 'center)
        (send method-inset-panel min-width 20)
        (send method-inset-panel stretchable-width #f)
        (send method-panel set-alignment 'left 'center)
        (send filter-panel stretchable-height #f)
        
        (send search-text-field focus)
        (send dialog show #t)
        
        (and
         ok?
         (make-search-info
          (send dir-field get-value)
          (send recur-check-box get-value)
          (and (send filter-check-box get-value)
               (regexp (send filter-text-field get-value)))
          searcher)))
      
      
      ;; do-search : search-info text -> void
      ;; thread: searching thread
      ;; called in a new thread that may be broken (to indicate a stop)
      (define (do-search search-info channel)
        (let* ([dir (search-info-dir search-info)]
               [filter (search-info-filter search-info)]
               [searcher (search-info-searcher search-info)]
               [get-filenames (if (search-info-recur? search-info)
                                  (build-recursive-file-list dir filter)
                                  (build-flat-file-list dir filter))])
          (with-handlers ([exn:break? (λ (x) (async-channel-put channel 'break))])
            (let loop ()
              (let ([filename (get-filenames)])
                (when filename
                  (searcher filename
                            (λ (line-string line-number col-number match-length)
                              (async-channel-put
                               channel
                               (make-search-entry
                                filename
                                line-string
                                line-number
                                col-number
                                match-length))))
                  (loop))))
            (async-channel-put channel 'done))))
      
      ;; build-recursive-file-list : string (union regexp #f) -> (-> (union string #f))
      ;; thread: search thread
      (define (build-recursive-file-list dir filter)
        (letrec ([touched (make-hash-table 'equal)]
                 [next-thunk (λ () (process-dir dir (λ () #f)))]
                 [process-dir
                  ; string[dirname] (listof string[filename]) -> (listof string[filename])
                  (λ (dir k)
                    (let* ([key (normalize-path dir)]
                           [traversed? (hash-table-get touched key (λ () #f))])
                      (if traversed? 
                          (k)
                          (begin
                            (hash-table-put! touched key #t)
                            (process-dir-contents 
                             (map (λ (x) (build-path dir x))
                                  (directory-list dir))
                             k)))))]
                 [process-dir-contents
                  ; string[dirname] (listof string[filename]) -> (listof string[filename])
                  (λ (contents k)
                    (cond
                      [(null? contents) 
                       (k)]
                      [else 
                       (let ([file/dir (car contents)])
                         (cond
                           [(and (file-exists? file/dir)
                                 (or (not filter)
                                     (regexp-match filter (path->string file/dir))))
                            (set! next-thunk
                                  (λ ()
                                    (process-dir-contents (cdr contents) k)))
                            file/dir]
                           [(directory-exists? file/dir)
                            (process-dir-contents 
                             (cdr contents)
                             (λ ()
                               (process-dir file/dir k)))]
                           [else 
                            (process-dir-contents (cdr contents) k)]))]))])
          (λ () (next-thunk))))
      
      ;; build-flat-file-list : (union #f regexp) string -> (-> (union string #f))
      ;; thread: searching thread
      (define (build-flat-file-list dir filter)
        (let ([contents (map (λ (x) (build-path dir x)) (directory-list dir))])
          (λ ()
            (let loop ()
              (cond
                [(null? contents)
                 #f]
                [(and filter (regexp-match filter (car contents)))
                 (begin0
                   (car contents)
                   (set! contents (cdr contents)))]
                [else
                 (set! contents (cdr contents))
                 (loop)])))))
      
      ;; exact-match-searcher : make-searcher
      (define (exact-match-searcher params key)        ;; thread: main eventspace thread
        (let ([case-sensitive? (car params)])
          (λ (filename add-entry)                 ;; thread: searching thread
            (let ([text (make-object text:basic%)])
              (send text load-file filename)
              (let loop ([pos 0])
                (let ([found (send text find-string key 'forward pos 'eof #t case-sensitive?)])
                  (when found
                    (let* ([para (send text position-paragraph found)]
                           [para-start (send text paragraph-start-position para)]
                           [line-string (send text get-text para-start
                                              (send text paragraph-end-position para))]
                           [line-number para]
                           [col-number (- found para-start)]
                           [match-length (string-length key)])
                      (add-entry line-string line-number col-number match-length)
                      (loop (+ found 1))))))))))
      
      ;; regexp-match-searcher : make-searcher
      ;; thread: searching thread
      (define (regexp-match-searcher parmas key)       ;; thread: main eventspace thread
        (let ([re:key (with-handlers ([(λ (x) #t)
                                       (λ (exn)
                                         (format "~a" (exn-message exn)))])
                        (regexp key))])
          (if (string? re:key)
              re:key
              (λ (filename add-entry)             ;; thread: searching thread
                (call-with-input-file filename
                  (λ (port)
                    (let loop ([line-number 0])
                      (let ([line (read-line port)])
                        (cond
                          [(eof-object? line) (void)]
                          [else
                           (let ([match (regexp-match-positions re:key line)])
                             (when match
                               (let ([pos (car match)])
                                 (add-entry line line-number 
                                            (car pos)
                                            (- (cdr pos) (car pos))))))
                           (loop (+ line-number 1))]))))
                  'text))))))))
