Search-Files dialog feature wish/implementation

[pwtc!cdj@labrea.stanford.edu (Cris Johnson)]

I wish the ACL search-files dialog in ACL 2.0 would not only open files,
but also adjust the scrolling position of files it opens to display the
the pattern I'd searched for.  Here is a hack that does just that in ACL
1.3.2 and 1.2.2.

Cris Johnson
Price Waterhouse Technology Centre
68 Willow Road, Menlo Park, CA 94025

(macrolet ((version-free-order (items)    ; dialog-item order varies with CCL release
                               (if (string-equal "Version 1.2.2"
                                                 (lisp-implementation-version))
                                 `(reverse ,items)
                                 `,items))
           (without-warning (&body forms)
                            `(let ((*warn-if-redefine* nil)
                                   (*warn-if-redefine-kernel* nil))
                               (declare (special *warn-if-redefine-kernel*)
                                        (special *warn-if-redefine*))
                               ,@forms)))
  ; Redefine the function ccl::do-dialog-file-search, called through the
  ;  "Search Files" dialog, to one whose result window has a button action of
  ;  not only opening a selected file, but using the "String Search" dialog to
  ;  position the selected file to the searched-for pattern.
  (let ((asd (gensym))
        (edi (gensym))
        (dia (gensym))
        (dfs (gensym)))
    (eval
     `(defobject ,asd CCL::*ACTION-SEQUENCE-DIALOG*))
    (setf (symbol-function edi)
          #'(lambda () (version-free-order (dialog-items *editable-text-dialog-item*))))
    (eval
     `(defobfun (exist ,asd) (il)
        (usual-exist il)
        (set-default-button (car (dialog-items *button-dialog-item*)))
        (let ((str (let ((ttl (window-title)))
                     (subseq ttl (length "Files with \"") (1- (length ttl))))))
          (ask (car (dialog-items *button-dialog-item*))
            (fhave ',dia (symbol-function 'dialog-item-action))
            (fhave 'dialog-item-action
                   #'(lambda ()
                       (let ((ofw (front-window))
                             (rtv (funcall ',dia)))
                         (unless (eq ofw (front-window))
                           (ask (progn (ccl::wfind) (front-window))
                             (ask (car (funcall ',edi))
                               (set-dialog-item-text str))
                             (ask (find "From Top"
                                        (dialog-items *button-dialog-item*)
                                        :key #'(lambda (i)
                                                 (ask i (dialog-item-text)))
                                        :test #'string-equal)
                               (dialog-item-action))))
                         rtv)))))))
    (setf (symbol-function dfs) (symbol-function 'ccl::do-dialog-file-search))
    (without-warning
     (setf (symbol-function 'ccl::do-dialog-file-search)
           (eval
            `#'(lambda (&rest args)
                 (let ((CCL::*ACTION-SEQUENCE-DIALOG* ,asd))
                   (declare (special CCL::*ACTION-SEQUENCE-DIALOG*))
                   (apply ',dfs args)))))))
  )