Search Systems (for defsystem users)

[Repenning Alexander <ralex@tigger.cs.colorado.edu>]

The following is only relevant to users of Mark Kantrowitz's defsystem
tool.

The "Search Files" tool of MCL is really helpfull. However, as a user
of a DEFSYSTEM I would realy like to search systems and not directories
or single files. Mark Kantrowitz's defsystem supports the addition of
new system operations. Here's a first naive implementation:

(in-package "MAKE")

(make::component-operation :search 'search-operation)
(make::component-operation 'search 'search-operation)

(defun SEARCH-OPERATION (Component Force) "
  Every :file component will be called with this function.
  Force is misused to hold the search string."
  (with-tell-user ("Searching source" component :source)
    (ccl::do-dialog-file-search (component-full-pathname Component :source) Force))
  nil)


(defun GET-LIST-OF-SYSTEMS-FROM-USER () "
  Prompts the user for systems, which it returns. "
  (mapcar
   #'(lambda (Name) (read-from-string (format nil ":~A" Name)))
   (ccl:select-item-from-list
    (mapcar #'component-name (defined-systems))
    :window-title "Select Systems:"
    :selection-type :disjoint)))


(defun SEARCH-SYSTEMS (String &optional (Systems (get-list-of-systems-from-user))) "
  Search all files in <Systems> for <String>."
  (dolist (System Systems)
    (operate-on-system System :search :force String)))

Now here's the problem: ccl::do-dialog-file-search is not excately
what I need.  The search works but.. 

(a) I don't like the side effects of ccl::do-dialog-file-search (beep if no
match, verbose ";searching ...")  and

(b) since it can deal only with one pathname it creates a list dialog
box for every matching file in my system. I would prefer to have just
one list dialog box for ALL matching files. Are there any other handy
functions to search files for strings efficiently?  ..something like:

FILE-CONTAINS-STRING-P (Pathname String)

Btw, here's a hack to add this functionality to the menu:

;;; insert "Search Systems" menu item after "Search Files"
(let* ((File-Menu (ccl:find-menu "Tools"))
       (Search-File-Menu-Item (ccl:find-menu-item File-Menu "Search Files")))
  (unless (ccl:find-menu-item File-Menu "Search Systems")
    (let ((New-Items nil) (Old-Items (ccl:menu-items File-Menu)))
      (apply #'ccl:remove-menu-items File-Menu (ccl:menu-items File-Menu))
      (apply #'ccl:add-menu-items File-Menu
             (dolist (Item Old-Items (reverse New-Items))
               (push Item New-Items)
               (when (equal Item Search-File-Menu-Item)
                 (push 
                  (make-instance
                    'ccl:menu-item
                    :menu-item-title "Search Systems"     
                    :menu-item-action 
                    #'(lambda () (ccl:eval-enqueue 
                                  '(search-systems 
                                    (ccl:get-string-from-user "System Search String:")))))
                  New-Items)))))))


  Alex Repenning