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

Last change on this file since 11960 was 11960, checked in by rme, 11 years ago

Updates to the search files dialog.

Instead of combo box data sources, use the built-in combo box list. Enable
and disable the search button based on the state of the dialog. Run grep
in a separate thread. Use checkboxes instead of a menu for search options.

File size: 17.4 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(defconstant $find-combo-box-tag 0)
23(defconstant $folder-combo-box-tag 1)
24(defconstant $file-name-combo-box-tag 2)
25
26(defparameter *search-files-history-limit* 5 "combo box history length")
27
28(defclass search-files-window-controller (ns:ns-window-controller)
29  ((find-combo-box :foreign-type :id :accessor find-combo-box)
30   (folder-combo-box :foreign-type :id :accessor folder-combo-box)
31   (file-name-combo-box :foreign-type :id :accessor file-name-combo-box)
32   (search-button :foreign-type :id :accessor search-button)
33   (browse-button :foreign-type :id :accessor browse-button)
34   (outline-view :foreign-type :id :accessor outline-view)
35   (recursive-checkbox :foreign-type :id :accessor recursive-checkbox)
36   (case-sensitive-checkbox :foreign-type :id :accessor case-sensitive-checkbox)
37   (expand-results-checkbox :foreign-type :id :accessor expand-results-checkbox)
38   (progress-indicator :foreign-type :id :accessor progress-indicator)
39   (status-field :foreign-type :id :accessor status-field)
40   (find-string-value :foreign-type :id :reader find-string-value)
41   (folder-string-value :foreign-type :id :reader folder-string-value)
42   (file-name-string-value :foreign-type :id :reader file-name-string-value)
43   (results :initform (make-array 10 :fill-pointer 0 :adjustable t)
44            :accessor search-results) ;contains a vector of search-result-files
45   (new-results :accessor new-results)
46   (search-dir :initform "" :accessor search-dir) ;the expanded search directory
47   (search-str :initform "" :accessor search-str) ;a lisp string
48   (recursive-p :initform t :reader recursive-p)
49   (case-sensitive-p :initform nil :reader case-sensitive-p)
50   (expand-results-p :initform nil :reader expand-results-p))
51  (:metaclass ns:+ns-object))
52
53(defmacro def-copying-setter (slot-name class-name)
54  (let* ((new (gensym))
55         (obj (gensym)))
56    `(defmethod (setf ,slot-name) (,new (,obj ,class-name))
57       (with-slots (,slot-name) ,obj
58         (unless (eql ,slot-name ,new)
59           (#/release ,slot-name)
60           (setq ,slot-name (#/copy ,new)))))))
61
62(def-copying-setter find-string-value search-files-window-controller)
63(def-copying-setter folder-string-value search-files-window-controller)
64(def-copying-setter file-name-string-value search-files-window-controller)
65
66
67
68;;; Enable and disable the Search button according to the state of the
69;;; search files dialog.
70
71(defun can-search-p (wc)
72  (and (plusp (#/length (find-string-value wc)))
73       (folder-valid-p wc)
74       (plusp (#/length (file-name-string-value wc)))))
75
76(defmethod folder-valid-p ((wc search-files-window-controller))
77  (let* ((fm (#/defaultManager ns:ns-file-manager))
78         (path (folder-string-value wc)))
79    (rlet ((dir-p #>BOOL))
80      (and
81       (#/fileExistsAtPath:isDirectory: fm path dir-p)
82       (plusp (%get-byte dir-p))))))
83
84(objc:defmethod (#/controlTextDidChange: :void) ((wc search-files-window-controller) notification)
85  (let* ((object (#/object notification))
86         (info (#/userInfo notification))
87         (field-editor (#/valueForKey: info #@"NSFieldEditor"))
88         (string-ok (plusp (#/length (find-string-value wc))))
89         (folder-ok (folder-valid-p wc))
90         (file-ok (plusp (#/length (file-name-string-value wc)))))
91    (cond ((eql object (find-combo-box wc))
92           (setf string-ok (plusp (#/length (#/string field-editor)))))
93          ((eql object (folder-combo-box wc))
94           (setf (folder-string-value wc) (#/string field-editor))
95           (setf folder-ok (folder-valid-p wc)))
96          ((eql object (file-name-combo-box wc))
97           (setf file-ok (#/length (#/string field-editor)))))
98    (#/setEnabled: (search-button wc) (and string-ok folder-ok file-ok))))
99
100(objc:defmethod (#/comboBoxSelectionDidChange: :void) ((wc search-files-window-controller) notification)
101  (declare (ignore notification))
102  (#/setEnabled: (search-button wc) (can-search-p wc)))
103
104(objc:defmethod (#/toggleCheckbox: :void) ((wc search-files-window-controller) checkbox)
105  (with-slots (recursive-checkbox case-sensitive-checkbox expand-results-checkbox
106               recursive-p case-sensitive-p expand-results-p) wc
107    (cond ((eql checkbox recursive-checkbox)
108           (setf recursive-p (not recursive-p)))
109          ((eql checkbox case-sensitive-checkbox)
110           (setf case-sensitive-p (not case-sensitive-p)))
111          ((eql checkbox expand-results-checkbox)
112           (setf expand-results-p (not expand-results-p))
113           (if expand-results-p
114             (expand-all-results wc)
115             (collapse-all-results wc))
116           (#/reloadData (outline-view wc)))
117          (t
118           (error "Unknown checkbox ~s" checkbox)))))
119
120;;; For simple strings, it's easier to use the combo box's built-in
121;;; list than it is to mess around with a data source.
122
123(defun update-combo-box (combo-box string)
124  (check-type string ns:ns-string)
125  (unless (#/isEqualToString: string #@"")
126    (#/removeItemWithObjectValue: combo-box string)
127    (#/insertItemWithObjectValue:atIndex: combo-box string 0)
128    (when (> (#/numberOfItems combo-box) *search-files-history-limit*)
129      (#/removeItemAtIndex: combo-box *search-files-history-limit*))))
130
131(objc:defmethod (#/updateFindString: :void) ((wc search-files-window-controller)
132                                             sender)
133  (setf (find-string-value wc) (#/stringValue sender))
134  (update-combo-box sender (find-string-value wc)))
135
136(objc:defmethod (#/updateFolderString: :void) ((wc search-files-window-controller) sender)
137  (setf (folder-string-value wc) (#/stringValue sender))
138  (update-combo-box sender (folder-string-value wc)))
139
140(objc:defmethod (#/updateFileNameString: :void) ((wc search-files-window-controller) sender)
141  (setf (file-name-string-value wc) (#/stringValue sender))
142  (update-combo-box sender (file-name-string-value wc)))
143
144
145
146(objc:defmethod #/init ((self search-files-window-controller))
147  (#/initWithWindowNibName: self #@"SearchFiles"))
148
149(objc:defmethod (#/awakeFromNib :void) ((wc search-files-window-controller))
150  (#/setStringValue: (status-field wc) #@"")
151  (with-slots (outline-view) wc
152    (#/setTarget: outline-view wc)
153    (#/setDoubleAction: outline-view (@selector #/editLine:)))
154  (setf (find-string-value wc) #@"")
155  (with-slots (file-name-combo-box) wc
156    (#/setStringValue: file-name-combo-box #@"*.lisp")
157    (#/updateFileNameString: wc file-name-combo-box))
158  (with-slots (folder-combo-box) wc
159    (let ((dir (ccl::native-translated-namestring (ccl:current-directory))))
160    (#/setStringValue: folder-combo-box
161                       (#/autorelease (%make-nsstring dir)))
162    (#/updateFolderString: wc folder-combo-box))))
163
164(defun ns-string-equal (ns1 ns2)
165  (and (typep ns1 'ns:ns-string)
166       (typep ns2 'ns:ns-string)
167       (#/isEqualToString: ns1 ns2)))
168
169(defmethod get-full-dir-string ((str string))
170  ;make sure it has a trailing slash
171  (let ((ret (ccl::native-untranslated-namestring str)))
172    (unless (eql #\/ (aref str (1- (length str))))
173      (setf ret (concatenate 'string ret "/")))
174    ret))
175
176(defmethod get-full-dir-string ((nsstring ns:ns-string))
177  (get-full-dir-string (lisp-string-from-nsstring nsstring)))
178
179(objc:defmethod (#/doSearch: :void) ((wc search-files-window-controller) sender)
180  (declare (ignore sender))
181  (queue-for-gui #'(lambda ()
182                     (with-slots (outline-view results) wc
183                       (setf (fill-pointer results) 0)
184                       (set-results-string wc #@"Searching...")
185                       (#/startAnimation: (progress-indicator wc) nil)
186                       (#/reloadData outline-view))))
187
188  (let* ((find-str (lisp-string-from-nsstring (find-string-value wc)))
189         (folder-str (lisp-string-from-nsstring (folder-string-value wc)))
190         (file-str (lisp-string-from-nsstring (file-name-string-value wc)))
191         (grep-args (list (when (recursive-p wc) "-r")
192                          (unless (case-sensitive-p wc) "-i")
193                          "-I" "-s" "-c" "-e" find-str "--include" file-str
194                          (get-full-dir-string folder-str))))
195    (setf (search-dir wc) folder-str
196          (search-str wc) find-str)
197    (#/setEnabled: (search-button wc) nil)
198    (process-run-function "grep" 'run-grep grep-args wc)
199    (#/setTitle: (#/window wc) (#/autorelease
200                                (%make-nsstring (format nil "Search Files: ~a"
201                                                        find-str))))))
202
203(defun auto-expandable-p (results)
204  (let ((n 0))
205    (dotimes (f (length results) t)
206      (dotimes (l (length (search-result-file-lines (aref results f))))
207        (incf n)
208        (when (> n 20)
209          (return-from auto-expandable-p nil))))))
210
211(objc:defmethod (#/updateResults: :void) ((wc search-files-window-controller)
212                                          msg)
213  (let* ((old-results (search-results wc)))
214    (setf (search-results wc) (new-results wc))
215    ;; release NSString instances.  sigh.
216    (dotimes (f (length old-results))
217      (dotimes (l (length (search-result-file-lines f)))
218        (and (search-result-line-nsstr l)
219             (#/release (search-result-line-nsstr l))))
220      (and (search-result-file-nsstr f)
221           (#/release (search-result-file-nsstr f))))
222    (set-results-string wc msg)
223    (when (or (auto-expandable-p (search-results wc))
224              (expand-results-p wc))
225      (expand-all-results wc))
226    (#/reloadData (outline-view wc))
227    (#/setEnabled: (search-button wc) t)))
228   
229;;; This is run in a secondary thread.
230(defun run-grep (grep-arglist wc)
231  (with-autorelease-pool 
232      (#/performSelectorOnMainThread:withObject:waitUntilDone:
233       (progress-indicator wc) (@selector #/startAnimation:) nil nil)
234    (unwind-protect
235         (let* ((grep-output (call-grep grep-arglist)))
236           (multiple-value-bind (results message)
237               (results-and-message grep-output wc)
238             ;; This assumes that only one grep can be running at
239             ;; a time.
240             (setf (new-results wc) results)
241             (#/performSelectorOnMainThread:withObject:waitUntilDone:
242              wc
243              (@selector #/updateResults:)
244              (#/autorelease (%make-nsstring message))
245              nil)))
246      (#/performSelectorOnMainThread:withObject:waitUntilDone:
247       (progress-indicator wc) (@selector #/stopAnimation:) nil nil))))
248
249(defun results-and-message (grep-output wc)
250  (let* ((results (make-array 10 :fill-pointer 0 :adjustable t))
251         (occurrences 0)
252         (file-count 0)
253         (dir-len (length (search-dir wc))))
254    (map-lines
255     grep-output
256     #'(lambda (start end)
257         (let* ((colon-pos (position #\: grep-output :from-end t :start start
258                                     :end end))
259                (count (parse-integer grep-output :start (1+ colon-pos)
260                                      :end end)))
261           (incf file-count)
262           (when (> count 0)
263             (vector-push-extend (make-search-result-file
264                                  :name (subseq grep-output
265                                                (+ start dir-len)
266                                                colon-pos)
267                                  :lines (make-array count :initial-element nil))
268                                 results)
269             (incf occurrences count)))))
270    (values results
271            (format nil "Found ~a occurrence~:p in ~a file~:p out of ~a ~
272                         file~:p searched." occurrences (length results)
273                         file-count))))
274                   
275(defmethod expand-all-results ((wc search-files-window-controller))
276  (with-slots (outline-view) wc
277    (#/expandItem:expandChildren: outline-view +null-ptr+ t)
278    (#/reloadData outline-view)))
279
280(defmethod collapse-all-results ((wc search-files-window-controller))
281  (with-slots (outline-view) wc
282    (#/collapseItem:collapseChildren: outline-view +null-ptr+ t)
283    (#/reloadData outline-view)))
284
285(defun set-results-string (wc str)
286  (#/setStringValue: (status-field wc) str))
287           
288(objc:defmethod (#/doBrowse: :void) ((wc search-files-window-controller) sender)
289  (declare (ignore sender))
290  (let ((dir (choose-directory-dialog)))
291    (when dir
292      (with-slots (folder-combo-box) wc
293        (#/setStringValue: folder-combo-box dir)
294        (#/updateFolderString: wc folder-combo-box)))))
295
296(objc:defmethod (#/editLine: :void) ((wc search-files-window-controller) outline-view)
297  (let* ((item (get-selected-item outline-view))
298         (line-result (and item (nsstring-to-line-result wc item))))
299    (unless line-result
300      (let ((file-result (and item (nsstring-to-file-result wc item))))
301        (when file-result
302          (setf line-result (get-line-result wc file-result 0)))))         
303    (when line-result
304      (cocoa-edit-grep-line (concatenate 'string (search-dir wc) "/" (search-result-line-file line-result))
305                      (1- (search-result-line-number line-result))))))
306
307(defun get-selected-item (outline-view)
308  (let ((index (#/selectedRow outline-view)))
309    (when (> index -1)
310      (#/itemAtRow: outline-view (#/selectedRow outline-view)))))
311
312(defun nsstring-to-file-result (wc nsstring)
313  (find nsstring (search-results wc) :test #'ns-string-equal :key #'search-result-file-nsstr))
314
315(defun nsstring-to-line-result (wc nsstring)
316  (loop for file-result across (search-results wc)
317    do (loop for line-result across (search-result-file-lines file-result)
318         while line-result
319         do (when (ns-string-equal nsstring (search-result-line-nsstr line-result))
320              (return-from nsstring-to-line-result line-result)))))
321
322;;NSOutlineView data source protocol
323;- (id)outlineView:(NSOutlineView *)outlineView child:(NSInteger)index ofItem:(id)item
324(objc:defmethod #/outlineView:child:ofItem: ((wc search-files-window-controller) view (child :<NSI>nteger) item)
325  (declare (ignore view))
326  (with-slots (results) wc
327    (if (eql item +null-ptr+)
328      (let ((result (aref results child)))
329        (or (search-result-file-nsstr result)
330            (setf (search-result-file-nsstr result)
331                  (%make-nsstring (format nil "[~a] ~a" 
332                                          (length (search-result-file-lines result))
333                                          (search-result-file-name result))))))
334      (let* ((file-result (nsstring-to-file-result wc item))
335             (line-result (get-line-result wc file-result child)))
336        (search-result-line-nsstr line-result)))))
337
338(defun get-line-result (wc file-result index)
339  (let ((lines (search-result-file-lines file-result)))
340    (or (aref lines index)
341        (progn
342          (compute-line-results wc file-result)
343          (aref lines index)))))
344
345(defun compute-line-results (wc file-result)
346  (with-slots (search-str search-dir) wc
347    (let* ((grep-output (call-grep (nconc (unless (case-sensitive-p wc) (list "-i"))
348                                          (list "-n" "-e" search-str 
349                                                (concatenate 'string search-dir (search-result-file-name file-result))))))
350           (index -1))
351      (map-lines grep-output
352                 #'(lambda (start end)
353                     (let* ((str (subseq grep-output start end))
354                            (colon-pos (position #\: str))
355                            (num (parse-integer str :end colon-pos)))
356                       (setf (aref (search-result-file-lines file-result) (incf index))
357                             (make-search-result-line :file (search-result-file-name file-result) 
358                                                      :number num 
359                                                      :nsstr (%make-nsstring str)))))))))
360
361;- (BOOL)outlineView:(NSOutlineView *)outlineView isItemExpandable:(id)item
362(objc:defmethod (#/outlineView:isItemExpandable: :<BOOL>) ((wc search-files-window-controller) view item)
363  (declare (ignore view))
364  ;;it's expandable if it starts with #\[ (it's a file)
365  (and (typep item 'ns:ns-string)
366       (= (char-code #\[) (#/characterAtIndex: item 0))))
367
368;- (NSInteger)outlineView:(NSOutlineView *)outlineView numberOfChildrenOfItem:(id)item
369(objc:defmethod (#/outlineView:numberOfChildrenOfItem: :<NSI>nteger)
370                ((wc search-files-window-controller) view item)
371  (declare (ignore view))
372  (if (eql item +null-ptr+)
373    (length (search-results wc))
374    (let ((file-result (nsstring-to-file-result wc item)))
375      (if file-result
376        (length (search-result-file-lines file-result))
377        0))))
378
379;- (id)outlineView:(NSOutlineView *)outlineView objectValueForTableColumn:(NSTableColumn *)tableColumn byItem:(id)item
380(objc:defmethod #/outlineView:objectValueForTableColumn:byItem: 
381                ((wc search-files-window-controller) outline-view table-column item)
382  (declare (ignore outline-view table-column))
383  (let ((file-result (nsstring-to-file-result wc item)))
384    (if file-result
385      (search-result-file-nsstr file-result)
386      (let ((line-result (nsstring-to-line-result wc item)))
387        (if line-result
388          (search-result-line-nsstr line-result)
389          #@"ERROR")))))
390
391(defun call-grep (args)
392  ;;Calls grep with the strings as arguments, and returns a string containing the output
393  (with-output-to-string (stream)
394    (let* ((proc (run-program "grep" args :input nil :output stream)))
395      (multiple-value-bind (status exit-code) (external-process-status proc)
396        (let ((output (get-output-stream-string stream)))
397          (if (eq :exited status)
398            (return-from call-grep output)
399            (error "~a returned exit status ~s" *grep-program* exit-code)))))))
400
401(defun map-lines (string fn)
402  "For each line in string, fn is called with the start and end of the line"
403  (loop with end = (length string)
404    for start = 0 then (1+ pos)
405    as pos = (or (position #\Newline string :start start :end end) end)
406    when (< start pos) do (funcall fn start pos)
407    while (< pos end)))
408
409
410#|
411(defun top-search ()
412  (#/windowController
413   (first-window-with-controller-type 'search-files-window-controller)))
414|#
415
Note: See TracBrowser for help on using the repository browser.