Changeset 16038


Ignore:
Timestamp:
Mar 3, 2014, 4:01:44 PM (6 years ago)
Author:
xach
Message:

Improve the internals of Search Files.

Replaces the existing internals of Search Files with a cleaner version
from rme's implementation for opusmodus.

Some cruft remains to be removed in a near-future commit.

Trac #1154.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/cocoa-ide/search-files.lisp

    r16030 r16038  
    11(in-package "GUI")
     2
     3(defparameter *search-files-history-limit* 5 "combo box history length")
     4
     5;;;
     6;;; Creating the outline view from grep
     7;;;
     8
     9;;; Views for the outline view
     10
     11(defun %image-and-text-table-cell-view ()
     12  (cg:with-rects ((image-frame 0 0 16 16)
     13                  (text-field-frame 0 0 100 16))
     14    (let* ((view (#/initWithFrame: (#/alloc ns:ns-table-cell-view)
     15                                   #&NSZeroRect))
     16           (image-view (#/initWithFrame: (#/alloc ns:ns-image-view)
     17                                         image-frame))
     18           (text-field (#/initWithFrame: (#/alloc ns:ns-text-field)
     19                                         text-field-frame))
     20           (views-dict (#/dictionaryWithObjectsAndKeys: ns:ns-dictionary
     21                                                        image-view #@"imageView"
     22                                                        text-field #@"textField"
     23                                                        +null-ptr+)))
     24      (#/setNextKeyView: view text-field)
     25      (#/setImageView: view image-view)
     26      (#/setTextField: view text-field)
     27      (#/setDrawsBackground: text-field nil)
     28      (#/setFont: text-field (#/systemFontOfSize:
     29                              ns:ns-font
     30                              (#/smallSystemFontSize ns:ns-font)))
     31      (#/setBordered: text-field nil)
     32      (#/setEditable: text-field nil)
     33      (#/setLineBreakMode: (#/cell text-field)
     34                           #$NSLineBreakByTruncatingTail)
     35      (#/setTranslatesAutoresizingMaskIntoConstraints: image-view nil)
     36      (#/setTranslatesAutoresizingMaskIntoConstraints: text-field nil)
     37      (#/addSubview: view image-view)
     38      (#/release image-view)
     39      (#/addSubview: view text-field)
     40      (#/release text-field)
     41      (#/addConstraints: view
     42                         (#/constraintsWithVisualFormat:options:metrics:views:
     43                          ns:ns-layout-constraint
     44                          #@"|-5-[imageView(==16)]-[textField(>=100)]|"
     45                          0 +null-ptr+ views-dict))
     46      (#/addConstraint: view
     47                        (#/constraintWithItem:attribute:relatedBy:toItem:attribute:multiplier:constant:
     48                         ns:ns-layout-constraint image-view #$NSLayoutAttributeCenterY
     49                         #$NSLayoutRelationEqual view #$NSLayoutAttributeCenterY 1d0 0d0))
     50      (#/addConstraint: view
     51                        (#/constraintWithItem:attribute:relatedBy:toItem:attribute:multiplier:constant:
     52                         ns:ns-layout-constraint text-field #$NSLayoutAttributeCenterY
     53                         #$NSLayoutRelationEqual view #$NSLayoutAttributeCenterY 1d0 0d0))
     54      view)))
     55
     56(defun %navigator-search-table-cell-view ()
     57  (%image-and-text-table-cell-view))
     58
     59(defun %navigator-match-table-cell-view ()
     60  (cg:with-rects ((text-field-frame 0 0 100 16))
     61    (let* ((view (#/initWithFrame: (#/alloc ns:ns-table-cell-view)
     62                                   #&NSZeroRect))
     63           (text-field (#/initWithFrame: (#/alloc ns:ns-text-field)
     64                                         text-field-frame))
     65           (views-dict (#/dictionaryWithObjectsAndKeys: ns:ns-dictionary
     66                                                        text-field
     67                                                        #@"textField"
     68                                                        +null-ptr+)))
     69      (#/setNextKeyView: view text-field)
     70      (#/setTextField: view text-field)
     71      (#/setDrawsBackground: text-field nil)
     72      (#/setFont: text-field (#/systemFontOfSize:
     73                              ns:ns-font
     74                              (#/smallSystemFontSize ns:ns-font)))
     75      (#/setBordered: text-field nil)
     76      (#/setEditable: text-field t)
     77      (#/setLineBreakMode: (#/cell text-field)
     78                           #$NSLineBreakByTruncatingTail)
     79      (#/setTranslatesAutoresizingMaskIntoConstraints: text-field nil)
     80      (#/addSubview: view text-field)
     81      (#/release text-field)
     82      (#/addConstraints: view (#/constraintsWithVisualFormat:options:metrics:views:
     83                               ns:ns-layout-constraint
     84                               #@"|-5-[textField(>=100)]|"
     85                               0 +null-ptr+ views-dict))
     86      (#/addConstraint: view
     87                        (#/constraintWithItem:attribute:relatedBy:toItem:attribute:multiplier:constant:
     88                         ns:ns-layout-constraint text-field #$NSLayoutAttributeCenterY
     89                         #$NSLayoutRelationEqual view #$NSLayoutAttributeCenterY 1d0 0d0))
     90      view)))
     91
     92
     93
     94(defun string-to-lines (string)
     95  (with-input-from-string (s string)
     96    (loop for line = (read-line s nil nil) while line collect line)))
     97
     98(defun run-grep (pathnames pattern)
     99  ;; Don't try to grep files that don't exist.  Even if we use
     100  ;; grep's -s flag, the exit code will still indicate an error.
     101  (setq pathnames (remove-if-not #'probe-file pathnames))
     102  (let* ((s (make-string-output-stream))
     103         (args (append (list "-nHI" "--null" "--directories=skip" "-F" pattern) pathnames))
     104         (proc (run-program "/usr/bin/grep" args :input nil :output s)))
     105    (multiple-value-bind (status exit-code)
     106                         (external-process-status proc)
     107      (if (eq status :exited)
     108        (cond ((= exit-code 0)
     109               ;; matched one or more lines
     110               (values (string-to-lines (get-output-stream-string s)) t))
     111              ((= exit-code 1)
     112               ;; no matches
     113               (values nil t))
     114              ((>= exit-code 2)
     115               ;; some error occurred
     116               (values nil nil)))
     117        (values (ccl::describe-external-process-failure proc "running grep") nil)))))
     118
     119(defun run-search-files-grep (folder file-pattern pattern
     120                              &key recursive case-sensitive regex)
     121  (when (probe-file folder)
     122    (let* ((s (make-string-output-stream))
     123           (args (append (list "-snHI" "--null" "--include" file-pattern
     124                               "--directories=skip")
     125                         (when recursive
     126                           (list "-R"))
     127                         (unless case-sensitive
     128                           (list "-i"))
     129                         (unless regex
     130                           (list "-F"))
     131                         (list pattern
     132                               (string-right-trim "/" folder))))
     133           (proc (run-program "/usr/bin/grep" args :input nil :output s)))
     134      (multiple-value-bind (status exit-code)
     135          (external-process-status proc)
     136        (if (eq status :exited)
     137            (cond ((= exit-code 0)
     138                   ;; matched one or more lines
     139                   (values (string-to-lines (get-output-stream-string s)) t))
     140                  ((= exit-code 1)
     141                   ;; no matches
     142                   (values nil t))
     143                  ((>= exit-code 2)
     144                   ;; Return *some* data, even if the exit code
     145                   ;; indicates an error. This is mainly because grep
     146                   ;; will still return useful results even if some
     147                   ;; files were unreadable (e.g. dangling symlinks).
     148                   (values (string-to-lines (get-output-stream-string s))
     149                           nil)))
     150            (values (ccl::describe-external-process-failure proc "running grep") nil))))))
     151
     152(defclass grep-result ()
     153  ((file :accessor grep-result-file :initarg :file)
     154   (matches :accessor grep-result-matches :initarg :matches)))
     155
     156(defun grep-result-match-count (grep-result)
     157  (length (grep-result-matches grep-result)))
     158
     159(defmethod print-object ((g grep-result) stream)
     160  (print-unreadable-object (g stream :type t)
     161    (format stream "~s, ~d matched line~:p" (grep-result-file g)
     162            (length (grep-result-matches g)))))
     163
     164(defun make-grep-result (filename matches)
     165  (make-instance 'grep-result :file filename :matches matches))
     166
     167;; This assumes that grep was called with --null, which prints a null
     168;; after the filname.  If it printed the usual #\: then we would choke
     169;; on file names that contain colons.
     170(defun grep-output-line-values (line)
     171  (let* ((nul (position #\nul line))
     172         (colon (position #\: line :start (1+ nul))))
     173    (values (subseq line 0 nul)
     174            (parse-integer line :start (1+ nul) :end colon)
     175            (subseq line (1+ colon)))))
     176
     177(defun generate-grep-results (lines)
     178  (let ((current-filename nil)
     179        (current-matches nil)
     180        (results nil))
     181    (dolist (line lines)
     182      (multiple-value-bind (filename line-number text)
     183                           (grep-output-line-values line)
     184        (cond ((null current-filename)
     185               (setq current-filename filename)
     186               (push (list line-number text) current-matches))
     187              ((string= filename current-filename)
     188               (push (list line-number text) current-matches))
     189              (t
     190               (push (make-grep-result current-filename
     191                                       (nreverse current-matches)) results)
     192               (setq current-filename filename)
     193               (setq current-matches nil)
     194               (push (list line-number text) current-matches)))))
     195    (when current-matches
     196      (push (make-grep-result current-filename
     197                              (nreverse current-matches)) results))
     198    (nreverse results)))
     199
     200(defclass navigator-search-node-data (ns:ns-object)
     201  ((display-string :foreign-type :id)
     202   (url :foreign-type :id)
     203   (line-number :foreign-type #>NSInteger)
     204   (text :foreign-type :id))
     205  (:metaclass ns:+ns-object))
     206
     207(objc:defmethod (#/setDisplayString: :void) ((self navigator-search-node-data) string)
     208  (with-slots (display-string) self
     209    (unless (eql string display-string)
     210      (#/release display-string)
     211      (setq display-string (#/retain string)))))
     212
     213(objc:defmethod #/URL ((self navigator-search-node-data))
     214  (slot-value self 'url))
     215
     216(objc:defmethod (#/setURL: :void) ((self navigator-search-node-data) new-url)
     217  (with-slots (url) self
     218    (unless (eql url new-url)
     219      (#/release url)
     220      (setq url (#/retain new-url)))))
     221
     222(objc:defmethod (#/lineNumber #>NSInteger) ((self navigator-search-node-data))
     223  (slot-value self 'line-number))
     224
     225(objc:defmethod (#/setLineNumber: :void) ((self navigator-search-node-data)
     226                                          (number #>NSInteger))
     227  (setf (slot-value self 'line-number) number))
     228
     229(objc:defmethod (#/setText: :void) ((self navigator-search-node-data) string)
     230  (with-slots (text) self
     231    (unless (eql string text)
     232      (#/release text)
     233      (setq text (#/retain string)))))
     234
     235(objc:defmethod (#/dealloc :void) ((self navigator-search-node-data))
     236  (#/release (slot-value self 'display-string))
     237  (#/release (slot-value self 'url))
     238  (#/release (slot-value self 'text))
     239  (call-next-method))
     240
     241(objc:defmethod (#/isContainer #>BOOL) ((self navigator-search-node-data))
     242  (%null-ptr-p (slot-value self 'text)))
     243
     244(defun %tree-node-for-grep-result (grep-result)
     245  (let* ((node-data (#/new navigator-search-node-data))
     246         (node (#/initWithRepresentedObject: (#/alloc ns:ns-tree-node) node-data))
     247         (file (grep-result-file grep-result)))
     248    (#/release node-data)
     249    (with-cfstring (s file)
     250      (#/setDisplayString: node-data s))
     251    (with-cfurl (u file)
     252      (#/setURL: node-data u))
     253    (let ((matches (grep-result-matches grep-result)))
     254      (dolist (match matches)
     255        (let* ((child-node-data (#/new navigator-search-node-data))
     256               (child-node (#/initWithRepresentedObject: (#/alloc ns:ns-tree-node)
     257                                                         child-node-data))
     258               (line-number (first match))
     259               (text (second match)))
     260          (#/release child-node-data)
     261          (with-cfurl (u file)
     262            (#/setURL: child-node-data u))
     263          (#/setLineNumber: child-node-data line-number)
     264          (with-cfstring (s text)
     265            (#/setText: child-node-data s))
     266          (#/addObject: (#/childNodes node) child-node))))
     267    node))
     268
     269(defun %tree-node-for-grep-results (grep-results)
     270  (let* ((root-node (#/initWithRepresentedObject: (#/alloc ns:ns-tree-node)
     271                                                  +null-ptr+))
     272         (children (#/mutableChildNodes root-node)))
     273    (dolist (r grep-results)
     274      (let ((node (%tree-node-for-grep-result r)))
     275        (#/addObject: children node)
     276        (#/release node)))
     277    root-node))
     278
     279(defclass grep-results-data-source (ns:ns-object)
     280  ((root-node :foreign-type :id))
     281  (:metaclass ns:+ns-object))
     282
     283(objc:defmethod #/init ((self grep-results-data-source))
     284  (let ((new (call-next-method)))
     285    (unless (%null-ptr-p new)
     286      (setf (slot-value self 'root-node)
     287            (#/initWithRepresentedObject: (#/alloc ns:ns-tree-node)
     288                                          +null-ptr+)))
     289    new))
     290
     291(objc:defmethod (#/dealloc :void) ((self grep-results-data-source))
     292  (#/release (slot-value self 'root-node))
     293  (call-next-method))
     294
     295(objc:defmethod (#/setRootNode: :void) ((self grep-results-data-source) tree-node)
     296  (with-slots (root-node) self
     297    (unless (eql root-node tree-node)
     298      (#/release root-node)
     299      (setq root-node (#/retain tree-node)))))
     300
     301(objc:defmethod #/childrenForItem: ((self grep-results-data-source) item)
     302  (if (%null-ptr-p item)
     303    (#/childNodes (slot-value self 'root-node))
     304    (#/childNodes item)))
     305
     306(objc:defmethod (#/outlineView:numberOfChildrenOfItem: #>NSInteger)
     307                ((self grep-results-data-source) outline-view item)
     308  (declare (ignore outline-view))
     309  (#/count (#/childrenForItem: self item)))
     310
     311(objc:defmethod (#/outlineView:isItemExpandable: #>BOOL)
     312                ((self grep-results-data-source) outline-view item)
     313  (declare (ignore outline-view))
     314  (let* ((node (if (%null-ptr-p item)
     315                 (slot-value self 'root-node)
     316                 item))
     317         (node-data (#/representedObject node)))
     318    (#/isContainer node-data)))
     319
     320(objc:defmethod #/outlineView:child:ofItem: ((self grep-results-data-source)
     321                                             outline-view (index #>NSInteger)
     322                                             item)
     323  (declare (ignore outline-view))
     324  (let ((children (#/childrenForItem: self item)))
     325    (#/objectAtIndex: children index)))
     326
     327(objc:defmethod #/outlineView:viewForTableColumn:item: ((self grep-results-data-source)
     328                                                       outline-view table-column item)
     329  (declare (ignore table-column))
     330  (cond ((zerop (#/count (#/childNodes item)))
     331         (let ((view (%navigator-match-table-cell-view))
     332               (node-data (#/representedObject item)))
     333           (#/setStringValue: (#/textField view) (slot-value node-data 'text))
     334           (#/setEditable: (#/textField view) nil)
     335           (#/autorelease view)))
     336        (t
     337         (let ((view (#/makeViewWithIdentifier:owner: outline-view
     338                                                      #@"search-files-cell" self)))
     339           (when (%null-ptr-p view)
     340             (setq view (%navigator-search-table-cell-view))
     341             (#/setIdentifier: view #@"search-files-cell")
     342             (#/autorelease view))
     343           (let* ((node-data (#/representedObject item))
     344                  (url (slot-value node-data 'url))
     345                  (extension (#/pathExtension url))
     346                  (name +null-ptr+))
     347             (unless (%null-ptr-p url)
     348               (setq name (#/path url)))
     349             (if (%null-ptr-p name)
     350               (setq name #@"no url?"))
     351             (#/setEditable: (#/textField view) nil)
     352             (#/setTranslatesAutoresizingMaskIntoConstraints: (#/imageView view) nil)
     353             (#/setTranslatesAutoresizingMaskIntoConstraints: (#/textField view) nil)
     354             (#/setImage: (#/imageView view)
     355                          (#/iconForFileType: (#/sharedWorkspace ns:ns-workspace) extension))
     356             (#/setStringValue: (#/textField view) name))
     357           view))))
     358
     359(objc:defmethod (#/outlineView:shouldSelectItem: #>BOOL) ((self grep-results-data-source) ov
     360                                                         item)
     361  (declare (ignore ov))
     362  (let ((node-data (#/representedObject item)))
     363    (not (#/isContainer node-data))))
     364
     365;;;
     366;;; Displaying and updating the interface
     367;;;
    2368
    3369(defstruct search-result-file
     
    7373  )
    8374
    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")
    27375
    28376(defclass search-files-window-controller (ns:ns-window-controller)
     
    51399   (case-sensitive-p :initform nil :reader case-sensitive-p)
    52400   (expand-results-p :initform nil :reader expand-results-p)
    53    (grep-process :initform nil :accessor grep-process))
     401   (grep-process :initform nil :accessor grep-process)
     402   (search-data-source :foreign-type :id :accessor search-data-source))
    54403  (:metaclass ns:+ns-object))
    55404
     
    180529(objc:defmethod (#/awakeFromNib :void) ((wc search-files-window-controller))
    181530  (#/setStringValue: (status-field wc) #@"")
    182   (with-slots (outline-view) wc
    183     (#/setTarget: outline-view wc)
    184     (#/setDoubleAction: outline-view (@selector #/editLine:)))
     531  (with-slots (outline-view search-data-source) wc
     532    (#/setTarget: outline-view search-data-source)
     533    (#/setDoubleAction: outline-view (@selector #/editLine:))
     534    (setf search-data-source (#/new grep-results-data-source))
     535    (#/setDelegate: outline-view search-data-source)
     536    (#/setDataSource: outline-view search-data-source))
    185537  (setf (find-string-value wc) #@"")
    186538  (setf (folder-string-value wc) #@"")
     
    218570  (get-full-dir-string (lisp-string-from-nsstring nsstring)))
    219571
    220 (defun make-grep-arglist (wc find-str)
    221   (let ((grep-args (list "-I" "-s" "-e" find-str)))
    222     ; Ignore binary files, suppress error messages
    223     (unless (case-sensitive-p wc)
    224       (push "-i" grep-args))
    225     (unless (regex-p wc)
    226       (push "-F" grep-args))
    227     grep-args))
    228 
    229572(objc:defmethod (#/doSearch: :void) ((wc search-files-window-controller) sender)
    230573  (declare (ignore sender))
    231574  (set-results-string wc #@"Searching...")
    232   (setf (find-string-value wc) (#/stringValue (find-combo-box wc))
    233         (folder-string-value wc) (#/stringValue (folder-combo-box wc))
    234         (file-name-string-value wc) (#/stringValue (file-name-combo-box wc)))
    235   (let* ((find-str (lisp-string-from-nsstring (find-string-value wc)))
    236          (folder-str (get-full-dir-string (folder-string-value wc)))
    237          (file-str (lisp-string-from-nsstring (file-name-string-value wc)))
    238          (grep-args (make-grep-arglist wc find-str)))
    239     (setf (search-str wc) find-str
    240           (search-dir wc) folder-str)
    241     (push "-c" grep-args) ; we just want the count here
    242     (if (recursive-p wc)
    243       (setf grep-args (nconc grep-args (list "-r" "--include" file-str folder-str)))
    244       (list (concatenate 'string folder-str file-str)))
    245     (#/setEnabled: (search-button wc) nil)
    246     (setf (grep-process wc) (process-run-function "grep" 'run-grep grep-args wc))
    247     (#/setTitle: (#/window wc) (#/autorelease
    248                                 (%make-nsstring (format nil "Search Files: ~a"
    249                                                         find-str))))))
     575  (#/setEnabled: (search-button wc) nil)
     576  (#/performSelectorOnMainThread:withObject:waitUntilDone:
     577   (progress-indicator wc) (@selector #/stopAnimation:) nil t)
     578  (process-run-function
     579   'do-search
     580   (lambda ()
     581     (let ((result-status #@"Done"))
     582       (#/performSelectorOnMainThread:withObject:waitUntilDone:
     583        (progress-indicator wc) (@selector #/startAnimation:) nil t)
     584       (unwind-protect
     585            (let* ((pattern (lisp-string-from-nsstring (find-string-value wc)))
     586                   (folder (get-full-dir-string (folder-string-value wc)))
     587                   (file-pattern (lisp-string-from-nsstring (file-name-string-value wc)))
     588                   (lines (run-search-files-grep folder file-pattern pattern
     589                                                     :recursive (recursive-p wc)
     590                                                     :case-sensitive (case-sensitive-p wc)
     591                                                     :regex (regex-p wc)))
     592                   (results (generate-grep-results lines))
     593                   (tree-node (%tree-node-for-grep-results results)))
     594              (setf result-status
     595                    (if results
     596                        (#/autorelease
     597                         (%make-nsstring
     598                          (format nil "~D line~:P matched in ~D file~:P"
     599                                  (reduce #'+ results
     600                                          :key #'grep-result-match-count)
     601                                  (length results))))
     602                        #@"No matches"))
     603              (setf (new-results wc) tree-node))
     604         (progn
     605           (#/performSelectorOnMainThread:withObject:waitUntilDone:
     606            wc
     607            (@selector #/updateResults:)
     608            +null-ptr+
     609            t)
     610           (set-results-string wc result-status)
     611           (#/setTitle: (#/window wc)
     612                        (#/autorelease
     613                         (%make-nsstring (format nil "Search Files: ~a"
     614                                                 (lisp-string-from-nsstring (find-string-value wc))))))
     615           (#/performSelectorOnMainThread:withObject:waitUntilDone:
     616            (progress-indicator wc) (@selector #/stopAnimation:) nil t)
     617           (#/setEnabled: (search-button wc) t)))))))
    250618
    251619(objc:defmethod (#/windowWillClose: :void) ((wc search-files-window-controller)
     
    255623    (when proc (process-kill proc))))
    256624
    257 (defun auto-expandable-p (results)
    258   (let ((n 0))
    259     (dotimes (f (length results) t)
    260       (dotimes (l (length (search-result-file-lines (aref results f))))
    261         (incf n)
    262         (when (> n 20)
    263           (return-from auto-expandable-p nil))))))
    264 
    265625(objc:defmethod (#/updateResults: :void) ((wc search-files-window-controller)
    266                                           msg)
    267   (let* ((old-results (search-results wc)))
    268     (setf (search-results wc) (new-results wc))
    269     ;; release NSString instances.  sigh.
    270     (dotimes (idx (length old-results))
    271       (let* ((file (aref old-results idx))
    272              (lines (when file (search-result-file-lines file))))
    273         (dotimes (idx (length lines))
    274           (let* ((line (aref lines idx))
    275                  (string (when line (search-result-line-nsstr line))))
    276             (and string (#/release string))))
    277         (and (search-result-file-nsstr file)
    278              (#/release (search-result-file-nsstr file)))))
    279     (set-results-string wc msg)
    280 ;;     (when (or (auto-expandable-p (search-results wc))
    281 ;;              (expand-results-p wc))
    282 ;;       (expand-all-results wc))
    283     (setf (grep-process wc) nil)
    284     (#/reloadData (outline-view wc))
    285     (#/setEnabled: (search-button wc) t)))
    286 
    287 ;;; This is run in a secondary thread.
    288 (defun run-grep (grep-arglist wc)
    289   (with-autorelease-pool
    290       (#/performSelectorOnMainThread:withObject:waitUntilDone:
    291        (progress-indicator wc) (@selector #/startAnimation:) nil t)
    292     (unwind-protect
    293          (let* ((grep-output (call-grep grep-arglist)))
    294            (multiple-value-bind (results message)
    295                (results-and-message grep-output wc)
    296              ;; This assumes that only one grep can be running at
    297              ;; a time.
    298              (setf (new-results wc) results)
    299              (#/performSelectorOnMainThread:withObject:waitUntilDone:
    300               wc
    301               (@selector #/updateResults:)
    302               (#/autorelease (%make-nsstring message))
    303               t)))
    304       (#/performSelectorOnMainThread:withObject:waitUntilDone:
    305        (progress-indicator wc) (@selector #/stopAnimation:) nil t))))
    306 
    307 (defun results-and-message (grep-output wc)
    308   (let* ((results (make-array 10 :fill-pointer 0 :adjustable t))
    309          (occurrences 0)
    310          (file-count 0)
    311          (dir-len (length (search-dir wc))))
    312     (map-lines
    313      grep-output
    314      #'(lambda (start end)
    315          (let* ((colon-pos (position #\: grep-output :from-end t :start start
    316                                      :end end))
    317                 (count (and colon-pos
    318                             (parse-integer grep-output :start (1+ colon-pos)
    319                                            :end end))))
    320            (when count
    321              (incf file-count)
    322              (when (> count 0)
    323                (vector-push-extend (make-search-result-file
    324                                     :name (subseq grep-output
    325                                                   (+ start dir-len)
    326                                                   colon-pos)
    327                                     :lines (make-array count :initial-element nil))
    328                                    results)
    329                (incf occurrences count))))))
    330     (values results
    331             (format nil "Found ~a occurrence~:p in ~a file~:p out of ~a ~
    332                          file~:p searched." occurrences (length results)
    333                          file-count))))
    334                    
     626                                          sender)
     627  (declare (ignore sender))
     628  (with-slots (search-data-source outline-view new-results) wc
     629    (#/setRootNode: search-data-source new-results)
     630    (#/release new-results)
     631    (#/reloadData outline-view)))
     632
    335633(defmethod expand-all-results ((wc search-files-window-controller))
    336634  (with-slots (outline-view) wc
     
    345643(defun set-results-string (wc str)
    346644  (#/setStringValue: (status-field wc) str))
    347            
     645
     646;;; For choosing the right directory
    348647(objc:defmethod (#/doBrowse: :void) ((wc search-files-window-controller) sender)
    349648  (declare (ignore sender))
     
    356655          (#/updateFolderString: wc folder-combo-box))))))
    357656
     657;;; For jumping to a search result
    358658(objc:defmethod (#/editLine: :void) ((wc search-files-window-controller) outline-view)
    359   (let* ((item (get-selected-item outline-view))
    360          (line-result (and item (nsstring-to-line-result wc item))))
    361     (unless line-result
    362       (let ((file-result (and item (nsstring-to-file-result wc item))))
    363         (when file-result
    364           (setf line-result (get-line-result wc file-result 0)))))         
    365     (when line-result
    366       (cocoa-edit-grep-line (concatenate 'string (search-dir wc) "/" (search-result-line-file line-result))
    367                       (1- (search-result-line-number line-result))
    368                       (search-str wc)))))
    369 
    370 (defun get-selected-item (outline-view)
    371   (let ((index (#/selectedRow outline-view)))
    372     (when (> index -1)
    373       (#/itemAtRow: outline-view (#/selectedRow outline-view)))))
     659  (let ((selected-row (#/selectedRow outline-view)))
     660    (when (plusp selected-row)
     661      (let* ((item (#/itemAtRow: outline-view selected-row))
     662             (node-data (#/representedObject item))
     663             (url (#/URL node-data))
     664             (line-number (#/lineNumber node-data)))
     665        (cocoa-edit-grep-line (%get-cfstring (#/path url))
     666                              (1- line-number))))))
     667
     668(defun map-lines (string fn)
     669  "For each line in string, fn is called with the start and end of the line"
     670  (loop with end = (length string)
     671    for start = 0 then (1+ pos)
     672    as pos = (or (position #\Newline string :start start :end end) end)
     673    when (< start pos) do (funcall fn start pos)
     674    while (< pos end)))
    374675
    375676(defun nsstring-to-file-result (wc nsstring)
     
    454755          #@"ERROR")))))
    455756
    456 (defun call-grep (args)
    457   ;;Calls grep with the strings as arguments, and returns a string containing the output
    458   (with-output-to-string (stream)
    459     (let* ((proc (run-program "grep" args :input nil :output stream)))
    460       (multiple-value-bind (status exit-code) (external-process-status proc)
    461         (let ((output (get-output-stream-string stream)))
    462           (if (eq :exited status)
    463             (return-from call-grep output)
    464             (error "~a returned exit status ~s" *grep-program* exit-code)))))))
    465 
    466 (defun map-lines (string fn)
    467   "For each line in string, fn is called with the start and end of the line"
    468   (loop with end = (length string)
    469     for start = 0 then (1+ pos)
    470     as pos = (or (position #\Newline string :start start :end end) end)
    471     when (< start pos) do (funcall fn start pos)
    472     while (< pos end)))
    473 
    474 
    475 #|
    476 (defun top-search ()
    477   (#/windowController
    478    (first-window-with-controller-type 'search-files-window-controller)))
    479 |#
    480 
     757
Note: See TracChangeset for help on using the changeset viewer.