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

Last change on this file since 11973 was 11973, checked in by rme, 10 years ago

Some bug fixes.

File size: 17.5 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  (set-results-string wc #@"Searching...")
182  (setf (find-string-value wc) (#/stringValue (find-combo-box wc))
183        (folder-string-value wc) (#/stringValue (folder-combo-box wc))
184        (file-name-string-value wc) (#/stringValue (file-name-combo-box wc)))
185  (let* ((find-str (lisp-string-from-nsstring (find-string-value wc)))
186         (folder-str (lisp-string-from-nsstring (folder-string-value wc)))
187         (file-str (lisp-string-from-nsstring (file-name-string-value wc)))
188         (grep-args (list "-I" "-s" "-c" "-e" find-str "--include" file-str
189                          (get-full-dir-string folder-str))))
190    (when (recursive-p wc)
191      (push "-r" grep-args))
192    (unless (case-sensitive-p wc)
193      (push "-i" grep-args))
194    (setf (search-dir wc) folder-str
195          (search-str wc) find-str)
196    (#/setEnabled: (search-button wc) nil)
197    (process-run-function "grep" 'run-grep grep-args wc)
198    (#/setTitle: (#/window wc) (#/autorelease
199                                (%make-nsstring (format nil "Search Files: ~a"
200                                                        find-str))))))
201
202(defun auto-expandable-p (results)
203  (let ((n 0))
204    (dotimes (f (length results) t)
205      (dotimes (l (length (search-result-file-lines (aref results f))))
206        (incf n)
207        (when (> n 20)
208          (return-from auto-expandable-p nil))))))
209
210(objc:defmethod (#/updateResults: :void) ((wc search-files-window-controller)
211                                          msg)
212  (let* ((old-results (search-results wc)))
213    (setf (search-results wc) (new-results wc))
214    ;; release NSString instances.  sigh.
215    (dotimes (f (length old-results))
216      (dotimes (l (length (search-result-file-lines f)))
217        (and (search-result-line-nsstr l)
218             (#/release (search-result-line-nsstr l))))
219      (and (search-result-file-nsstr f)
220           (#/release (search-result-file-nsstr f))))
221    (set-results-string wc msg)
222    (when (or (auto-expandable-p (search-results wc))
223              (expand-results-p wc))
224      (expand-all-results wc))
225    (#/reloadData (outline-view wc))
226    (#/setEnabled: (search-button wc) t)))
227   
228;;; This is run in a secondary thread.
229(defun run-grep (grep-arglist wc)
230  (with-autorelease-pool 
231      (#/performSelectorOnMainThread:withObject:waitUntilDone:
232       (progress-indicator wc) (@selector #/startAnimation:) nil t)
233    (unwind-protect
234         (let* ((grep-output (call-grep grep-arglist)))
235           (multiple-value-bind (results message)
236               (results-and-message grep-output wc)
237             ;; This assumes that only one grep can be running at
238             ;; a time.
239             (setf (new-results wc) results)
240             (#/performSelectorOnMainThread:withObject:waitUntilDone:
241              wc
242              (@selector #/updateResults:)
243              (#/autorelease (%make-nsstring message))
244              t)))
245      (#/performSelectorOnMainThread:withObject:waitUntilDone:
246       (progress-indicator wc) (@selector #/stopAnimation:) nil t))))
247
248(defun results-and-message (grep-output wc)
249  (let* ((results (make-array 10 :fill-pointer 0 :adjustable t))
250         (occurrences 0)
251         (file-count 0)
252         (dir-len (length (search-dir wc))))
253    (map-lines
254     grep-output
255     #'(lambda (start end)
256         (let* ((colon-pos (position #\: grep-output :from-end t :start start
257                                     :end end))
258                (count (and colon-pos
259                            (parse-integer grep-output :start (1+ colon-pos)
260                                           :end end))))
261           (when count
262             (incf file-count)
263             (when (> count 0)
264               (vector-push-extend (make-search-result-file
265                                    :name (subseq grep-output
266                                                  (+ start dir-len)
267                                                  colon-pos)
268                                    :lines (make-array count :initial-element nil))
269                                   results)
270               (incf occurrences count))))))
271    (values results
272            (format nil "Found ~a occurrence~:p in ~a file~:p out of ~a ~
273                         file~:p searched." occurrences (length results)
274                         file-count))))
275                   
276(defmethod expand-all-results ((wc search-files-window-controller))
277  (with-slots (outline-view) wc
278    (#/expandItem:expandChildren: outline-view +null-ptr+ t)
279    (#/reloadData outline-view)))
280
281(defmethod collapse-all-results ((wc search-files-window-controller))
282  (with-slots (outline-view) wc
283    (#/collapseItem:collapseChildren: outline-view +null-ptr+ t)
284    (#/reloadData outline-view)))
285
286(defun set-results-string (wc str)
287  (#/setStringValue: (status-field wc) str))
288           
289(objc:defmethod (#/doBrowse: :void) ((wc search-files-window-controller) sender)
290  (declare (ignore sender))
291  (let ((pathname (cocoa-choose-directory-dialog)))
292    (when pathname
293      (ccl::with-autoreleased-nsstring
294          (dir (native-translated-namestring pathname))
295        (with-slots (folder-combo-box) wc
296          (#/setStringValue: folder-combo-box dir)
297          (#/updateFolderString: wc folder-combo-box))))))
298
299(objc:defmethod (#/editLine: :void) ((wc search-files-window-controller) outline-view)
300  (let* ((item (get-selected-item outline-view))
301         (line-result (and item (nsstring-to-line-result wc item))))
302    (unless line-result
303      (let ((file-result (and item (nsstring-to-file-result wc item))))
304        (when file-result
305          (setf line-result (get-line-result wc file-result 0)))))         
306    (when line-result
307      (cocoa-edit-grep-line (concatenate 'string (search-dir wc) "/" (search-result-line-file line-result))
308                      (1- (search-result-line-number line-result))))))
309
310(defun get-selected-item (outline-view)
311  (let ((index (#/selectedRow outline-view)))
312    (when (> index -1)
313      (#/itemAtRow: outline-view (#/selectedRow outline-view)))))
314
315(defun nsstring-to-file-result (wc nsstring)
316  (find nsstring (search-results wc) :test #'ns-string-equal :key #'search-result-file-nsstr))
317
318(defun nsstring-to-line-result (wc nsstring)
319  (loop for file-result across (search-results wc)
320    do (loop for line-result across (search-result-file-lines file-result)
321         while line-result
322         do (when (ns-string-equal nsstring (search-result-line-nsstr line-result))
323              (return-from nsstring-to-line-result line-result)))))
324
325;;NSOutlineView data source protocol
326;- (id)outlineView:(NSOutlineView *)outlineView child:(NSInteger)index ofItem:(id)item
327(objc:defmethod #/outlineView:child:ofItem: ((wc search-files-window-controller) view (child :<NSI>nteger) item)
328  (declare (ignore view))
329  (with-slots (results) wc
330    (if (eql item +null-ptr+)
331      (let ((result (aref results child)))
332        (or (search-result-file-nsstr result)
333            (setf (search-result-file-nsstr result)
334                  (%make-nsstring (format nil "[~a] ~a" 
335                                          (length (search-result-file-lines result))
336                                          (search-result-file-name result))))))
337      (let* ((file-result (nsstring-to-file-result wc item))
338             (line-result (get-line-result wc file-result child)))
339        (search-result-line-nsstr line-result)))))
340
341(defun get-line-result (wc file-result index)
342  (let ((lines (search-result-file-lines file-result)))
343    (or (aref lines index)
344        (progn
345          (compute-line-results wc file-result)
346          (aref lines index)))))
347
348(defun compute-line-results (wc file-result)
349  (with-slots (search-str search-dir) wc
350    (let* ((grep-output (call-grep (nconc (unless (case-sensitive-p wc) (list "-i"))
351                                          (list "-n" "-e" search-str 
352                                                (concatenate 'string search-dir (search-result-file-name file-result))))))
353           (index -1))
354      (map-lines grep-output
355                 #'(lambda (start end)
356                     (let* ((str (subseq grep-output start end))
357                            (colon-pos (position #\: str))
358                            (num (parse-integer str :end colon-pos)))
359                       (setf (aref (search-result-file-lines file-result) (incf index))
360                             (make-search-result-line :file (search-result-file-name file-result) 
361                                                      :number num 
362                                                      :nsstr (%make-nsstring str)))))))))
363
364;- (BOOL)outlineView:(NSOutlineView *)outlineView isItemExpandable:(id)item
365(objc:defmethod (#/outlineView:isItemExpandable: :<BOOL>) ((wc search-files-window-controller) view item)
366  (declare (ignore view))
367  ;;it's expandable if it starts with #\[ (it's a file)
368  (and (typep item 'ns:ns-string)
369       (= (char-code #\[) (#/characterAtIndex: item 0))))
370
371;- (NSInteger)outlineView:(NSOutlineView *)outlineView numberOfChildrenOfItem:(id)item
372(objc:defmethod (#/outlineView:numberOfChildrenOfItem: :<NSI>nteger)
373                ((wc search-files-window-controller) view item)
374  (declare (ignore view))
375  (if (eql item +null-ptr+)
376    (length (search-results wc))
377    (let ((file-result (nsstring-to-file-result wc item)))
378      (if file-result
379        (length (search-result-file-lines file-result))
380        0))))
381
382;- (id)outlineView:(NSOutlineView *)outlineView objectValueForTableColumn:(NSTableColumn *)tableColumn byItem:(id)item
383(objc:defmethod #/outlineView:objectValueForTableColumn:byItem: 
384                ((wc search-files-window-controller) outline-view table-column item)
385  (declare (ignore outline-view table-column))
386  (let ((file-result (nsstring-to-file-result wc item)))
387    (if file-result
388      (search-result-file-nsstr file-result)
389      (let ((line-result (nsstring-to-line-result wc item)))
390        (if line-result
391          (search-result-line-nsstr line-result)
392          #@"ERROR")))))
393
394(defun call-grep (args)
395  ;;Calls grep with the strings as arguments, and returns a string containing the output
396  (with-output-to-string (stream)
397    (let* ((proc (run-program "grep" args :input nil :output stream)))
398      (multiple-value-bind (status exit-code) (external-process-status proc)
399        (let ((output (get-output-stream-string stream)))
400          (if (eq :exited status)
401            (return-from call-grep output)
402            (error "~a returned exit status ~s" *grep-program* exit-code)))))))
403
404(defun map-lines (string fn)
405  "For each line in string, fn is called with the start and end of the line"
406  (loop with end = (length string)
407    for start = 0 then (1+ pos)
408    as pos = (or (position #\Newline string :start start :end end) end)
409    when (< start pos) do (funcall fn start pos)
410    while (< pos end)))
411
412
413#|
414(defun top-search ()
415  (#/windowController
416   (first-window-with-controller-type 'search-files-window-controller)))
417|#
418
Note: See TracBrowser for help on using the repository browser.