source: trunk/source/cocoa-ide/search-files.lisp @ 9247

Last change on this file since 9247 was 9247, checked in by jaj, 12 years ago

Add a search-files dialog. If command key is held while selecting menu, a new window is created, otherwise the topmost search files dialog is brought to the front.

In inspector.nib set the window outlet.
Set inspector window titles.
Inspector sets @ @@ @@@ in the gui package to the last three items inspected, analogous to * * in the listener. Should these be in the ccl package, and exported?

In cocoa-utils add:
choose-directory-dialog
current-event-modifier-p
current-event-command-key-p
map-windows
first-window-satisfying-predicate
first-window-with-controller-type

File size: 16.6 KB
Line 
1(in-package "GUI")
2
3(defstruct search-result-file 
4  name ;A lisp string that contains the full path of the file
5  nsstr  ;An NSString that is shown in the dialog
6  lines ;A vector of search-result-lines
7  )
8
9(defstruct search-result-line 
10  file ;The search-result-file that contains this search-result-line
11  number ;An integer that is the line-number of the line
12  nsstr ;The NSString used in the dialog
13  )
14
15(defmethod print-object ((srl search-result-line) stream)
16  (print-unreadable-object (srl stream :type t)
17    (format stream "~a ~a ~s" 
18            (search-result-line-file srl)
19            (search-result-line-number srl)
20            (search-result-line-nsstr srl))))
21
22(defclass search-files-window-controller (ns:ns-window-controller)
23  ((find-combo-box :foreign-type :id :accessor find-combo-box) ;IBOutlet
24   (folder-combo-box :foreign-type :id :accessor folder-combo-box) ;IBOutlet
25   (file-name-combo-box :foreign-type :id :accessor file-name-combo-box) ;IBOutlet
26   (search-button :foreign-type :id :accessor search-button) ;IBOutlet
27   (browse-button :foreign-type :id :accessor browse-button) ;IBOutlet
28   (outline-view :foreign-type :id :accessor outline-view) ;IBOutlet
29   (recursive-menu-item :foreign-type :id :accessor recursive-menu-item) ;IBOutlet
30   (case-sensitive-menu-item :foreign-type :id :accessor case-sensitive-menu-item) ;IBOutlet
31   (expand-results-menu-item :foreign-type :id :accessor expand-results-menu-item) ;IBOutlet
32   ;;the following three vectors contain NSStrings, they're treated as stacks, so the last entry appears first
33   ;;They behave as a history so the top of the stack is the most recent
34   ;;TODO:  figure out how to save these as a user preference
35   (find-strings :initform (make-array 10 :fill-pointer 0 :adjustable t)  :accessor find-strings) ;contains NSStrings
36   (folder-strings :initform (make-array 10 :fill-pointer 0 :adjustable t)  :accessor folder-strings) ;contains NSStrings
37   (file-name-strings :initform (make-array 10 :fill-pointer 0 :adjustable t)  :accessor file-name-strings) ;contains NSStrings
38   (results :initform (make-array 10 :fill-pointer 0 :adjustable t) :accessor search-results) ;contains a vector of search-result-files
39   (search-dir :initform "" :accessor search-dir) ;the expanded search directory
40   (search-str :initform "")) ;a lisp string
41  (:metaclass ns:+ns-object))
42
43(defun recursive-p (wc)
44  (not (zerop (#/state (recursive-menu-item wc)))))
45
46(defun case-sensitive-p (wc)
47  (not (zerop (#/state (case-sensitive-menu-item wc)))))
48
49(defun expand-results-p (wc)
50  (not (zerop (#/state (expand-results-menu-item wc)))))
51
52(objc:defmethod (#/toggleMenuItem :void) ((wc search-files-window-controller) menu-item)
53  (#/setState: menu-item (if (zerop (#/state menu-item)) 1 0)))
54
55(objc:defmethod (#/expandResults :void) ((wc search-files-window-controller) menu-item)
56  (#/toggleMenuItem wc menu-item)
57  (if (expand-results-p wc)
58    (expand-all-results wc)
59    (collapse-all-results wc)))
60
61(objc:defmethod #/init ((self search-files-window-controller))
62  (#/initWithWindowNibName: self #@"SearchFiles"))
63
64;;Lifted from apropos-window.lisp, not sure if it's really needed...
65#+later (objc:defmethod (#/automaticallyNotifiesObserversForKey: :<BOOL>) ((self +search-files-window-controller)
66                                                                  key)
67  (declare (ignore key))
68  nil)
69
70(objc:defmethod (#/awakeFromNib :void) ((wc search-files-window-controller))
71  (with-slots (search-button browse-button find-combo-box folder-combo-box file-name-combo-box 
72                             file-name-strings outline-view recursive-menu-item 
73                             case-sensitive-menu-item expand-results-menu-item) wc
74    (#/setTarget: search-button wc)
75    (#/setKeyEquivalent: search-button (%make-nsstring (string #\return))) ;makes it the default button
76    (#/setAction: search-button (@selector #/doSearch))
77    (#/setTarget: browse-button wc)
78    (#/setAction: browse-button (@selector #/doBrowse))
79    (vector-push-extend #@"*.lisp" file-name-strings)
80    (#/setUsesDataSource: find-combo-box t)
81    (#/setDataSource: find-combo-box wc)
82    (#/setUsesDataSource: find-combo-box t)
83    (#/setUsesDataSource: folder-combo-box t)
84    (#/setDataSource: folder-combo-box wc)
85    (#/setUsesDataSource: folder-combo-box t)
86    (#/setUsesDataSource: file-name-combo-box t)
87    (#/setDataSource: file-name-combo-box wc)
88    (#/setUsesDataSource: file-name-combo-box t)
89    (#/setDataSource: outline-view wc)
90    (#/setTarget: outline-view wc)
91    (#/setEditable: (#/objectAtIndex: (#/tableColumns outline-view) 0) nil)
92    (#/setDoubleAction: outline-view (@selector #/editLine))
93    (#/selectItemAtIndex: file-name-combo-box 0)
94    (#/setTarget: recursive-menu-item wc)
95    (#/setAction: recursive-menu-item (@selector #/toggleMenuItem))
96    (#/setTarget: case-sensitive-menu-item wc)
97    (#/setAction: case-sensitive-menu-item (@selector #/toggleMenuItem))
98    (#/setTarget: expand-results-menu-item wc)
99    (#/setAction: expand-results-menu-item (@selector #/expandResults))
100    ))
101
102(defmethod combo-box-to-vector ((wc search-files-window-controller) combo-box)
103  (with-slots (find-combo-box folder-combo-box file-name-combo-box 
104                              find-strings folder-strings file-name-strings) wc
105    (cond ((eql combo-box find-combo-box) find-strings)
106          ((eql combo-box file-name-combo-box) file-name-strings)
107          ((eql combo-box folder-combo-box) folder-strings)
108          (t (error "Unknown combo box: ~s" combo-box)))))
109
110;;; Data source methods for combo box
111
112(objc:defmethod (#/numberOfItemsInComboBox: :<NSI>nteger) ((wc search-files-window-controller)
113                                                   combo-box)
114  (length (combo-box-to-vector wc combo-box)))
115
116(objc:defmethod #/comboBox:objectValueForItemAtIndex: ((wc search-files-window-controller)
117                                                       combo-box
118                                                       (index :<NSI>nteger))
119  (let ((vec (combo-box-to-vector wc combo-box)))
120    (aref vec (- (length vec) index 1))))
121
122(defun ns-string-begins-with (partial-nstr nstr)
123  (eql 0 (ns:ns-range-location (#/rangeOfString:options: nstr partial-nstr #$NSAnchoredSearch))))
124
125(defun ns-string-equal (ns1 ns2)
126  (and (typep ns1 'ns:ns-string)
127       (typep ns2 'ns:ns-string)
128       (#/isEqualToString: ns1 ns2)))
129
130(objc:defmethod #/comboBox:completedString: ((wc search-files-window-controller)
131                                             combo-box
132                                             partial-nstr)
133  (or (find partial-nstr (combo-box-to-vector wc combo-box) :from-end t
134            :test #'ns-string-begins-with)
135      #@""))
136
137(objc:defmethod (#/comboBox:indexOfItemWithStringValue: :<NSUI>nteger)
138    ((wc search-files-window-controller)
139     combo-box
140     string)
141  (let* ((vec (combo-box-to-vector wc combo-box))
142         (pos (position string vec :from-end t :test #'ns-string-equal)))
143    (if pos
144      (1- (length vec))
145      #$NSNotFound)))
146
147(defun get-combo-box-nstr (wc combo-box)
148  (let* ((vec (combo-box-to-vector wc combo-box))
149         (nstr (#/stringValue combo-box))
150         (pos (position nstr vec :test #'eql)))
151    (unless pos (#/retain nstr))
152    (unless (and pos (= (1+ pos) (length vec))) ;already at top of stack
153      (setf vec (delete nstr vec :test #'ns-string-equal)) ;delete string if it's already there
154      (vector-push-extend nstr vec))
155    nstr))
156
157(defmethod get-full-dir-string ((str string))
158  ;make sure it has a trailing slash
159  (let ((ret (ccl::native-untranslated-namestring str)))
160    (unless (eql #\/ (aref str (1- (length str))))
161      (setf ret (concatenate 'string ret "/")))
162    ret))
163
164(defmethod get-full-dir-string ((nsstring ns:ns-string))
165  (get-full-dir-string (lisp-string-from-nsstring nsstring)))
166
167(objc:defmethod (#/doSearch :void) ((wc search-files-window-controller) sender)
168  (declare (ignore sender))
169  (queue-for-gui #'(lambda ()
170                     (with-slots (outline-view results) wc
171                       (setf (fill-pointer results) 0)
172                       (set-results-string wc #@"Searching...")
173                       (#/reloadData outline-view))))
174  (queue-for-gui 
175   #'(lambda ()
176       (with-slots (find-combo-box folder-combo-box file-name-combo-box
177                                   results outline-view search-dir search-str) wc
178         (let* ((find-nstr (get-combo-box-nstr wc find-combo-box))
179                (folder-nstr (get-combo-box-nstr wc folder-combo-box))
180                (file-name-nstr (get-combo-box-nstr wc file-name-combo-box)))
181           (setf search-dir (get-full-dir-string folder-nstr)
182                 search-str (lisp-string-from-nsstring find-nstr))
183           (let* ((grep-output (call-grep (nconc (and (recursive-p wc) (list "-r"))
184                                                 (unless (case-sensitive-p wc) (list "-i"))
185                                                 (list "-c" "-e" (lisp-string-from-nsstring find-nstr)
186                                                  "--include" (lisp-string-from-nsstring file-name-nstr)
187                                                  search-dir))))
188             (dir-len (length search-dir))
189             (occurrences 0)
190             (file-count 0))
191             (map-lines grep-output
192                        #'(lambda (start end)
193                            (let* ((colon-pos (position #\: grep-output :from-end t :start start :end end))
194                                   (count (parse-integer grep-output :start (1+ colon-pos) :end end)))
195                              (incf file-count)
196                              (when (> count 0)
197                                (vector-push-extend (make-search-result-file 
198                                                     :name (subseq grep-output (+ start dir-len) colon-pos)
199                                                     :lines (make-array count :initial-element nil))
200                                                    results)
201                                (incf occurrences count)))))
202             (set-results-string wc (%make-nsstring (format nil "Found ~a occurrences in ~a files out of ~a files searched."
203                                                            occurrences (length results) file-count)))
204             (#/setTitle: (#/window wc) (%make-nsstring (format nil "Search Files: ~a" search-str)))
205             (#/reloadData outline-view)
206             (when (and (> occurrences 0) (or (<  occurrences 20) (expand-results-p wc)))
207               (expand-all-results wc))
208             (#/reloadData outline-view)))))))
209
210(defmethod expand-all-results ((wc search-files-window-controller))
211  (with-slots (outline-view) wc
212    (#/expandItem:expandChildren: outline-view +null-ptr+ t)
213    (#/reloadData outline-view)))
214
215(defmethod collapse-all-results ((wc search-files-window-controller))
216  (with-slots (outline-view) wc
217    (#/collapseItem:collapseChildren: outline-view +null-ptr+ t)
218    (#/reloadData outline-view)))
219
220(defun set-results-string (wc str)
221  (#/setStringValue: (#/headerCell (#/objectAtIndex: (#/tableColumns (outline-view wc)) 0)) str))
222           
223(objc:defmethod (#/doBrowse :void) ((wc search-files-window-controller) sender)
224  (declare (ignore sender))
225  (let ((dir (choose-directory-dialog)))
226    (when dir
227      (with-slots (folder-combo-box) wc
228        (#/setStringValue: folder-combo-box dir)
229        (get-combo-box-nstr wc folder-combo-box)))))
230
231(objc:defmethod (#/editLine :void) ((wc search-files-window-controller) outline-view)
232  (let* ((item (get-selected-item outline-view))
233         (line-result (and item (nsstring-to-line-result wc item))))
234    (unless line-result
235      (let ((file-result (and item (nsstring-to-file-result wc item))))
236        (when file-result
237          (setf line-result (get-line-result wc file-result 0)))))         
238    (when line-result
239      (cocoa-edit-grep-line (concatenate 'string (search-dir wc) "/" (search-result-line-file line-result))
240                      (1- (search-result-line-number line-result))))))
241
242(defun get-selected-item (outline-view)
243  (let ((index (#/selectedRow outline-view)))
244    (when (> index -1)
245      (#/itemAtRow: outline-view (#/selectedRow outline-view)))))
246
247(defun nsstring-to-file-result (wc nsstring)
248  (find nsstring (search-results wc) :test #'ns-string-equal :key #'search-result-file-nsstr))
249
250(defun nsstring-to-line-result (wc nsstring)
251  (loop for file-result across (search-results wc)
252    do (loop for line-result across (search-result-file-lines file-result)
253         while line-result
254         do (when (ns-string-equal nsstring (search-result-line-nsstr line-result))
255              (return-from nsstring-to-line-result line-result)))))
256
257;;NSOutlineView data source protocol
258;- (id)outlineView:(NSOutlineView *)outlineView child:(NSInteger)index ofItem:(id)item
259(objc:defmethod #/outlineView:child:ofItem: ((wc search-files-window-controller) view (child :<NSI>nteger) item)
260  (declare (ignore view))
261  (with-slots (results) wc
262    (if (eql item +null-ptr+)
263      (let ((result (aref results child)))
264        (or (search-result-file-nsstr result)
265            (setf (search-result-file-nsstr result)
266                  (%make-nsstring (format nil "[~a] ~a" 
267                                          (length (search-result-file-lines result))
268                                          (search-result-file-name result))))))
269      (let* ((file-result (nsstring-to-file-result wc item))
270             (line-result (get-line-result wc file-result child)))
271        (search-result-line-nsstr line-result)))))
272
273(defun get-line-result (wc file-result index)
274  (let ((lines (search-result-file-lines file-result)))
275    (or (aref lines index)
276        (progn
277          (compute-line-results wc file-result)
278          (aref lines index)))))
279
280(defun compute-line-results (wc file-result)
281  (with-slots (search-str search-dir) wc
282    (let* ((grep-output (call-grep (nconc (unless (case-sensitive-p wc) (list "-i"))
283                                          (list "-n" "-e" search-str 
284                                                (concatenate 'string search-dir (search-result-file-name file-result))))))
285           (index -1))
286      (map-lines grep-output
287                 #'(lambda (start end)
288                     (let* ((str (subseq grep-output start end))
289                            (colon-pos (position #\: str))
290                            (num (parse-integer str :end colon-pos)))
291                       (setf (aref (search-result-file-lines file-result) (incf index))
292                             (make-search-result-line :file (search-result-file-name file-result) 
293                                                      :number num 
294                                                      :nsstr (%make-nsstring str)))))))))
295
296;- (BOOL)outlineView:(NSOutlineView *)outlineView isItemExpandable:(id)item
297(objc:defmethod (#/outlineView:isItemExpandable: :<BOOL>) ((wc search-files-window-controller) view item)
298  (declare (ignore view))
299  ;;it's expandable if it starts with #\[ (it's a file)
300  (and (typep item 'ns:ns-string)
301       (= (char-code #\[) (#/characterAtIndex: item 0))))
302
303;- (NSInteger)outlineView:(NSOutlineView *)outlineView numberOfChildrenOfItem:(id)item
304(objc:defmethod (#/outlineView:numberOfChildrenOfItem: :<NSI>nteger)
305                ((wc search-files-window-controller) view item)
306  (declare (ignore view))
307  (if (eql item +null-ptr+)
308    (length (search-results wc))
309    (let ((file-result (nsstring-to-file-result wc item)))
310      (if file-result
311        (length (search-result-file-lines file-result))
312        0))))
313
314;- (id)outlineView:(NSOutlineView *)outlineView objectValueForTableColumn:(NSTableColumn *)tableColumn byItem:(id)item
315(objc:defmethod #/outlineView:objectValueForTableColumn:byItem: 
316                ((wc search-files-window-controller) outline-view table-column item)
317  (declare (ignore outline-view table-column))
318  (let ((file-result (nsstring-to-file-result wc item)))
319    (if file-result
320      (search-result-file-nsstr file-result)
321      (let ((line-result (nsstring-to-line-result wc item)))
322        (if line-result
323          (search-result-line-nsstr line-result)
324          #@"ERROR")))))
325
326(defun call-grep (args)
327  ;;Calls grep with the strings as arguments, and returns a string containing the output
328  (with-output-to-string (stream)
329    (let* ((proc (run-program "grep" args :input nil :output stream)))
330      (multiple-value-bind (status exit-code) (external-process-status proc)
331        (let ((output (get-output-stream-string stream)))
332           (if (and (eq :exited status) (or (= exit-code 0) (= exit-code 1)))
333            (return-from call-grep output)
334            (error "Error running ~a, xit code: ~s" *grep-program* exit-code)))))))
335
336(defun map-lines (string fn)
337  "For each line in string, fn is called with the start and end of the line"
338  (loop with end = (length string)
339    for start = 0 then (1+ pos)
340    as pos = (or (position #\Newline string :start start :end end) end)
341    when (< start pos) do (funcall fn start pos)
342    while (< pos end)))
343
344
345#|
346(defun top-search ()
347  (#/windowController
348   (first-window-with-controller-type 'search-files-window-controller)))
349|#
Note: See TracBrowser for help on using the repository browser.