Changeset 11960


Ignore:
Timestamp:
Apr 21, 2009, 10:12:09 PM (10 years ago)
Author:
rme
Message:

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.

Location:
trunk/source/cocoa-ide
Files:
1 deleted
3 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/cocoa-ide/app-delegate.lisp

    r11898 r11960  
    8888            (null (setf w (first-window-with-controller-type 'search-files-window-controller))))
    8989      (let* ((wc (make-instance 'search-files-window-controller)))
    90         (setf w (#/window wc))
    91         (#/setWindowController: w wc))
     90        (setf w (#/window wc)))
    9291      (#/makeKeyAndOrderFront: w self))))
    9392
  • trunk/source/cocoa-ide/search-files.lisp

    r9247 r11960  
    2020            (search-result-line-nsstr srl))))
    2121
     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
    2228(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
     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)
    3946   (search-dir :initform "" :accessor search-dir) ;the expanded search directory
    40    (search-str :initform "")) ;a lisp string
     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))
    4151  (:metaclass ns:+ns-object))
    4252
    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)))
     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
     69;;; Enable and disable the Search button according to the state of the
     70;;; search files dialog.
     71
     72(defun can-search-p (wc)
     73  (and (plusp (#/length (find-string-value wc)))
     74       (folder-valid-p wc)
     75       (plusp (#/length (file-name-string-value wc)))))
     76
     77(defmethod folder-valid-p ((wc search-files-window-controller))
     78  (let* ((fm (#/defaultManager ns:ns-file-manager))
     79         (path (folder-string-value wc)))
     80    (rlet ((dir-p #>BOOL))
     81      (and
     82       (#/fileExistsAtPath:isDirectory: fm path dir-p)
     83       (plusp (%get-byte dir-p))))))
     84
     85(objc:defmethod (#/controlTextDidChange: :void) ((wc search-files-window-controller) notification)
     86  (let* ((object (#/object notification))
     87         (info (#/userInfo notification))
     88         (field-editor (#/valueForKey: info #@"NSFieldEditor"))
     89         (string-ok (plusp (#/length (find-string-value wc))))
     90         (folder-ok (folder-valid-p wc))
     91         (file-ok (plusp (#/length (file-name-string-value wc)))))
     92    (cond ((eql object (find-combo-box wc))
     93           (setf string-ok (plusp (#/length (#/string field-editor)))))
     94          ((eql object (folder-combo-box wc))
     95           (setf (folder-string-value wc) (#/string field-editor))
     96           (setf folder-ok (folder-valid-p wc)))
     97          ((eql object (file-name-combo-box wc))
     98           (setf file-ok (#/length (#/string field-editor)))))
     99    (#/setEnabled: (search-button wc) (and string-ok folder-ok file-ok))))
     100
     101(objc:defmethod (#/comboBoxSelectionDidChange: :void) ((wc search-files-window-controller) notification)
     102  (declare (ignore notification))
     103  (#/setEnabled: (search-button wc) (can-search-p wc)))
     104
     105(objc:defmethod (#/toggleCheckbox: :void) ((wc search-files-window-controller) checkbox)
     106  (with-slots (recursive-checkbox case-sensitive-checkbox expand-results-checkbox
     107               recursive-p case-sensitive-p expand-results-p) wc
     108    (cond ((eql checkbox recursive-checkbox)
     109           (setf recursive-p (not recursive-p)))
     110          ((eql checkbox case-sensitive-checkbox)
     111           (setf case-sensitive-p (not case-sensitive-p)))
     112          ((eql checkbox expand-results-checkbox)
     113           (setf expand-results-p (not expand-results-p))
     114           (if expand-results-p
     115             (expand-all-results wc)
     116             (collapse-all-results wc))
     117           (#/reloadData (outline-view wc)))
     118          (t
     119           (error "Unknown checkbox ~s" checkbox)))))
     120
     121;;; For simple strings, it's easier to use the combo box's built-in
     122;;; list than it is to mess around with a data source.
     123
     124(defun update-combo-box (combo-box string)
     125  (check-type string ns:ns-string)
     126  (unless (#/isEqualToString: string #@"")
     127    (#/removeItemWithObjectValue: combo-box string)
     128    (#/insertItemWithObjectValue:atIndex: combo-box string 0)
     129    (when (> (#/numberOfItems combo-box) *search-files-history-limit*)
     130      (#/removeItemAtIndex: combo-box *search-files-history-limit*))))
     131
     132(objc:defmethod (#/updateFindString: :void) ((wc search-files-window-controller)
     133                                             sender)
     134  (setf (find-string-value wc) (#/stringValue sender))
     135  (update-combo-box sender (find-string-value wc)))
     136
     137(objc:defmethod (#/updateFolderString: :void) ((wc search-files-window-controller) sender)
     138  (setf (folder-string-value wc) (#/stringValue sender))
     139  (update-combo-box sender (folder-string-value wc)))
     140
     141(objc:defmethod (#/updateFileNameString: :void) ((wc search-files-window-controller) sender)
     142  (setf (file-name-string-value wc) (#/stringValue sender))
     143  (update-combo-box sender (file-name-string-value wc)))
     144
     145
     146
    60147
    61148(objc:defmethod #/init ((self search-files-window-controller))
    62149  (#/initWithWindowNibName: self #@"SearchFiles"))
    63150
    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 
    70151(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)
     152  (#/setStringValue: (status-field wc) #@"")
     153  (with-slots (outline-view) wc
    90154    (#/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))))
     155    (#/setDoubleAction: outline-view (@selector #/editLine:)))
     156  (setf (find-string-value wc) #@"")
     157  (with-slots (file-name-combo-box) wc
     158    (#/setStringValue: file-name-combo-box #@"*.lisp")
     159    (#/updateFileNameString: wc file-name-combo-box))
     160  (with-slots (folder-combo-box) wc
     161    (let ((dir (ccl::native-translated-namestring (ccl:current-directory))))
     162    (#/setStringValue: folder-combo-box
     163                       (#/autorelease (%make-nsstring dir)))
     164    (#/updateFolderString: wc folder-combo-box))))
    124165
    125166(defun ns-string-equal (ns1 ns2)
     
    127168       (typep ns2 'ns:ns-string)
    128169       (#/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))
    156170
    157171(defmethod get-full-dir-string ((str string))
     
    165179  (get-full-dir-string (lisp-string-from-nsstring nsstring)))
    166180
    167 (objc:defmethod (#/doSearch :void) ((wc search-files-window-controller) sender)
     181(objc:defmethod (#/doSearch: :void) ((wc search-files-window-controller) sender)
    168182  (declare (ignore sender))
    169183  (queue-for-gui #'(lambda ()
     
    171185                       (setf (fill-pointer results) 0)
    172186                       (set-results-string wc #@"Searching...")
     187                       (#/startAnimation: (progress-indicator wc) nil)
    173188                       (#/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 
     189
     190  (let* ((find-str (lisp-string-from-nsstring (find-string-value wc)))
     191         (folder-str (lisp-string-from-nsstring (folder-string-value wc)))
     192         (file-str (lisp-string-from-nsstring (file-name-string-value wc)))
     193         (grep-args (list (when (recursive-p wc) "-r")
     194                          (unless (case-sensitive-p wc) "-i")
     195                          "-I" "-s" "-c" "-e" find-str "--include" file-str
     196                          (get-full-dir-string folder-str))))
     197    (setf (search-dir wc) folder-str
     198          (search-str wc) find-str)
     199    (#/setEnabled: (search-button wc) nil)
     200    (process-run-function "grep" 'run-grep grep-args wc)
     201    (#/setTitle: (#/window wc) (#/autorelease
     202                                (%make-nsstring (format nil "Search Files: ~a"
     203                                                        find-str))))))
     204
     205(defun auto-expandable-p (results)
     206  (let ((n 0))
     207    (dotimes (f (length results) t)
     208      (dotimes (l (length (search-result-file-lines (aref results f))))
     209        (incf n)
     210        (when (> n 20)
     211          (return-from auto-expandable-p nil))))))
     212
     213(objc:defmethod (#/updateResults: :void) ((wc search-files-window-controller)
     214                                          msg)
     215  (let* ((old-results (search-results wc)))
     216    (setf (search-results wc) (new-results wc))
     217    ;; release NSString instances.  sigh.
     218    (dotimes (f (length old-results))
     219      (dotimes (l (length (search-result-file-lines f)))
     220        (and (search-result-line-nsstr l)
     221             (#/release (search-result-line-nsstr l))))
     222      (and (search-result-file-nsstr f)
     223           (#/release (search-result-file-nsstr f))))
     224    (set-results-string wc msg)
     225    (when (or (auto-expandable-p (search-results wc))
     226              (expand-results-p wc))
     227      (expand-all-results wc))
     228    (#/reloadData (outline-view wc))
     229    (#/setEnabled: (search-button wc) t)))
     230   
     231;;; This is run in a secondary thread.
     232(defun run-grep (grep-arglist wc)
     233  (with-autorelease-pool
     234      (#/performSelectorOnMainThread:withObject:waitUntilDone:
     235       (progress-indicator wc) (@selector #/startAnimation:) nil nil)
     236    (unwind-protect
     237         (let* ((grep-output (call-grep grep-arglist)))
     238           (multiple-value-bind (results message)
     239               (results-and-message grep-output wc)
     240             ;; This assumes that only one grep can be running at
     241             ;; a time.
     242             (setf (new-results wc) results)
     243             (#/performSelectorOnMainThread:withObject:waitUntilDone:
     244              wc
     245              (@selector #/updateResults:)
     246              (#/autorelease (%make-nsstring message))
     247              nil)))
     248      (#/performSelectorOnMainThread:withObject:waitUntilDone:
     249       (progress-indicator wc) (@selector #/stopAnimation:) nil nil))))
     250
     251(defun results-and-message (grep-output wc)
     252  (let* ((results (make-array 10 :fill-pointer 0 :adjustable t))
     253         (occurrences 0)
     254         (file-count 0)
     255         (dir-len (length (search-dir wc))))
     256    (map-lines
     257     grep-output
     258     #'(lambda (start end)
     259         (let* ((colon-pos (position #\: grep-output :from-end t :start start
     260                                     :end end))
     261                (count (parse-integer grep-output :start (1+ colon-pos)
     262                                      :end end)))
     263           (incf file-count)
     264           (when (> count 0)
     265             (vector-push-extend (make-search-result-file
     266                                  :name (subseq grep-output
     267                                                (+ start dir-len)
     268                                                colon-pos)
     269                                  :lines (make-array count :initial-element nil))
     270                                 results)
     271             (incf occurrences count)))))
     272    (values results
     273            (format nil "Found ~a occurrence~:p in ~a file~:p out of ~a ~
     274                         file~:p searched." occurrences (length results)
     275                         file-count))))
     276                   
    210277(defmethod expand-all-results ((wc search-files-window-controller))
    211278  (with-slots (outline-view) wc
     
    219286
    220287(defun set-results-string (wc str)
    221   (#/setStringValue: (#/headerCell (#/objectAtIndex: (#/tableColumns (outline-view wc)) 0)) str))
     288  (#/setStringValue: (status-field wc) str))
    222289           
    223 (objc:defmethod (#/doBrowse :void) ((wc search-files-window-controller) sender)
     290(objc:defmethod (#/doBrowse: :void) ((wc search-files-window-controller) sender)
    224291  (declare (ignore sender))
    225292  (let ((dir (choose-directory-dialog)))
    226293    (when dir
    227294      (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)
     295        (#/setStringValue: folder-combo-box dir)
     296        (#/updateFolderString: wc folder-combo-box)))))
     297
     298(objc:defmethod (#/editLine: :void) ((wc search-files-window-controller) outline-view)
    232299  (let* ((item (get-selected-item outline-view))
    233300         (line-result (and item (nsstring-to-line-result wc item))))
     
    330397      (multiple-value-bind (status exit-code) (external-process-status proc)
    331398        (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)))))))
     399          (if (eq :exited status)
     400            (return-from call-grep output)
     401            (error "~a returned exit status ~s" *grep-program* exit-code)))))))
    335402
    336403(defun map-lines (string fn)
     
    348415   (first-window-with-controller-type 'search-files-window-controller)))
    349416|#
     417
Note: See TracChangeset for help on using the changeset viewer.