Re: Pathname for "Search Files" dialog

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

	When one selects the "Search Files" command under the Tools menu,
	MACL brings up a dialog with the pathname set to "ccl;*.lisp".
	Does anyone have code to set the pathname to something else
	as the default?

	Thanks in advance.



	Rodney Daughtrey           E-mail: rodney@huntsai.boeing.com
	Huntsville AI Center               {major site}!uw-beaver!bcsaic!huntsai!rodney
	Boeing Computer Services   Voice:  (205)-461-2352  Fax: (205)-461-2933

The following is rather more than you asked for but includes presetting
the search path and also saving its value between searches.  (My initial
attempts at presetting to a fixed place got to be very annoying whenever
I wanted to search somewhere else.)  The main thrust of what follows was
to automatically initialize the search-pattern field in several of MACL's
tools to whatever was selected in the front-most fred window.
(Apple, If it wasn't too late, could such a feature go in MACL 2.0?)

Cris Johnson 
Price Waterhouse Technology Centre 
68 Willow Road, Menlo Park, CA 94025 
(415) 322-0606
PS - there is at least one "I" character in what follows that started
out as Apple's three-periods-in-a-row character as appears in some of
the menu-item titles.

; Utilities
(defun current-fred-pattern ()
  (let ((fw (car (windows *fred-window*))))
    (and fw (ask fw
              (multiple-value-bind (b e) (selection-range)
                (and (< b e)
                     (<= e (buffer-line-end (window-buffer) b))
                     (buffer-substring (window-buffer) :start b :end e)))))))

(defun find-labeled-menu-item (n1 n2)
  (ask (etypecase n1
         (string (find-menu n1))
         (integer (nth n1 (menubar))))
    (etypecase n2
      (string (find-menu-item n2))
      (integer (nth n2 (menu-items)))))) 

(defmacro version-free-order (items)    ; dialog-item order varies with CCL release
  (if (string-equal "Version 1.2.2" (lisp-implementation-version))
    `(reverse ,items)
    `,items))



; Modify the "SearchI" menu item's dialog to one whose search pattern is initialized
;  to the selected pattern in the front-most fred window.
(let ((mia (gensym)))
  (ask (find-labeled-menu-item "Edit" "SearchI")
    (fhave mia (symbol-function 'menu-item-action))
    (fhave 'menu-item-action
           #'(lambda () (prog1
                          (funcall mia)
                          (let ((p (current-fred-pattern)))
                            (when p (ask (front-window)  ; i.e. window from mia
                                      (ask (car (version-free-order
                                                 (dialog-items
                                                  *editable-text-dialog-item*)))
                                        (set-dialog-item-text p))))))))))

; Modify the "Apropos" menu item's dialog to one whose search pattern is initialized
;  to the selected pattern in the front-most fred window.
(let ((mia (gensym)))
  (ask (find-labeled-menu-item "Tools" "Apropos")
    (fhave mia (symbol-function 'menu-item-action))
    (fhave 'menu-item-action
           #'(lambda () (prog1
                          (funcall mia)
                          (let ((p (current-fred-pattern)))
                            (when p (ask (front-window) ; i.e. window from mia
                                      (ask (car (version-free-order
                                                 (dialog-items
                                                  *editable-text-dialog-item*)))
                                        (set-dialog-item-text p))))))))))

; Modify the "Search Files" menu item's dialog to one whose search pattern is
;  initialized to the selected pattern in the front-most fred window, and whose
;  search pathname remains unchanged between searches.
(let ((mia (gensym))
      (pnm (gensym))
      (dia (gensym)))
  (ask (find-labeled-menu-item "Tools" "Search Files")
    (fhave mia (symbol-function 'menu-item-action))
    (have pnm "home;**:*.lisp")
    (fhave 'menu-item-action
           #'(lambda () (prog1
                          (funcall mia)
                          (let ((search-path (symbol-value pnm)))
                            (ask (front-window) ; i.e. window from mia
                              (ask (car (version-free-order
                                         (dialog-items
                                          *editable-text-dialog-item*)))
                                (set-dialog-item-text search-path))
                              (let ((p (current-fred-pattern))
                                    (si (cadr (version-free-order
                                               (dialog-items
                                                *editable-text-dialog-item*))))) 
                                (when p (ask si (set-dialog-item-text p)))
                                (set-current-editable-text si))
                              (ask (default-button)
                                (fhave dia (symbol-function 'dialog-item-action))
                                (fhave 'dialog-item-action
                                       #'(lambda ()
                                           (let ((search-path
                                                  (ask (objvar my-dialog)
                                                    (ask
                                                      (car
                                                       (version-free-order
                                                        (dialog-items
                                                         *editable-text-dialog-item*)))
                                                      (dialog-item-text)))))
                                             (ask (find-labeled-menu-item "Tools"
                                                                          "Search Files")
                                               (have pnm search-path)))
                                           (funcall dia)))))))))))