source: trunk/ccl/cocoa-ide/cocoa-grep.lisp @ 7355

Last change on this file since 7355 was 7355, checked in by gz, 14 years ago

Account for grep's line numbers being 1-based.

Add Hemlock variable "Grep Search Comments" to allow ignoring comments, but for now the only comments that are recognized are whole-line semi-colon comments. Pathetic but more useful than nothing at all...

File size: 5.5 KB
Line 
1; -*- Mode: Lisp; Package: CCL; -*-
2
3(in-package "CCL")
4
5(defvar *grep-program* "grep")
6
7(defclass cocoa-edit-grep-line-request (ns:ns-object)
8  ((file-id :foreign-type :int)
9   (line-num :foreign-type :int))
10  (:metaclass ns:+ns-object))
11
12(objc:defmethod #/initWithFile:line:
13                ((self cocoa-edit-grep-line-request) (file :int) (line :int))
14  (#/init self)
15  (setf (slot-value self 'file-id) file
16        (slot-value self 'line-num) line)
17  self)
18
19(objc:defmethod (#/editGrepLine: :void)
20    ((self hemlock-document-controller) request)
21  (let* ((file (id-map-free-object *edit-definition-id-map* (slot-value request 'file-id)))
22         (line-num (slot-value request 'line-num))
23         (namestring (native-translated-namestring file))
24         (url (#/initFileURLWithPath:
25               (#/alloc ns:ns-url)
26               (%make-nsstring namestring)))
27         (document (#/openDocumentWithContentsOfURL:display:error:
28                    self
29                    url
30                    nil
31                    +null-ptr+)))
32    (unless (%null-ptr-p document)
33      (when (= (#/count (#/windowControllers document)) 0)
34        (#/makeWindowControllers document))
35      (let* ((buffer (hemlock-document-buffer document))
36             (hi::*current-buffer* buffer)
37             (hi::*buffer-gap-context* (hi::buffer-gap-context buffer)))
38        (edit-grep-line-in-buffer line-num))
39      (#/updateHemlockSelection (slot-value document 'textstorage))
40      (#/showWindows document))))
41
42(defun edit-grep-line-in-buffer (line-num)
43  (let ((point (hi::current-point-collapsing-selection)))
44    (hi::buffer-start point)
45    (unless (hi::line-offset point line-num)
46      (hi::buffer-end point))))
47
48(defun parse-grep-line (line)
49  (let* ((pos1 (position #\: line))
50         (pos2 (and pos1 (position #\: line :start (1+ pos1))))
51         (num (and pos2 (ignore-errors
52                         (parse-integer line :start (1+ pos1) :end pos2
53                                        :junk-allowed nil))))
54         (file (and num (subseq line 0 pos1))))
55    (when file
56      (values file (1- num)))))
57 
58(defun request-edit-grep-line (line)
59  (multiple-value-bind (file line-num) (parse-grep-line line)
60    (when file
61      (let* ((request (make-instance 'cocoa-edit-grep-line-request
62                                     :with-file (assign-id-map-id *edit-definition-id-map* file)
63                                     :line line-num)))
64        (#/performSelectorOnMainThread:withObject:waitUntilDone:
65         (#/sharedDocumentController ns:ns-document-controller)
66         (@selector #/editGrepLine:)
67         request
68         t)))))
69
70(defun grep-comment-line-p (line)
71  (multiple-value-bind (file line-num) (parse-grep-line line)
72    (with-open-file (stream file)
73      (loop while (> line-num 0)
74        for ch = (read-char stream nil nil)
75        when (null ch) do (return nil)
76        do (when (member ch '(#\Return #\Linefeed))
77             (decf line-num)
78             (when (and (eql ch #\Return)
79                        (eql (peek-char nil stream nil nil) #\Linefeed))
80               (read-char stream))))
81      (when (eql line-num 0)
82        (loop as ch = (read-char stream nil nil)
83          while (and ch (whitespacep ch) (not (member ch '(#\Return #\Linefeed))))
84          finally (return (eql ch #\;)))))))
85
86(defun grep-remove-comment-lines (lines)
87  (remove-if #'grep-comment-line-p lines))
88
89(defun split-grep-lines (output)
90  (loop with end = (length output)
91    for start = 0 then (1+ pos)
92    as pos = (or (position #\Newline output :start start :end end) end)
93    when (< start pos) collect (subseq output start pos)
94    while (< pos end)))
95
96
97(defun grep (pattern directory &key ignore-case (include "*.lisp") (exclude "*~.lisp"))
98  (with-output-to-string (stream)
99    (let* ((proc (run-program *grep-program*
100                              (nconc (and include (list "--include" include))
101                                     (and exclude (list "--exclude" exclude))
102                                     (and ignore-case (list "--ignore-case"))
103                                     (list "--recursive"
104                                           "--with-filename"
105                                           "--line-number"
106                                           "--no-messages"
107                                           "-e" pattern
108                                           (native-untranslated-namestring directory)))
109                              :input nil
110                              :output stream)))
111      (multiple-value-bind (status exit-code) (external-process-status proc)
112        (let ((output (get-output-stream-string stream)))
113          (if (and (eq :exited status) (or (= exit-code 0) (= exit-code 2)))
114              (let ((lines (split-grep-lines output)))
115                (unless (hi:value hemlock::grep-search-comments)
116                  (setq lines (grep-remove-comment-lines lines)))
117                (make-instance 'sequence-window-controller
118                               :sequence lines
119                               :result-callback #'request-edit-grep-line
120                               :display #'princ
121                               :title (format nil "~a in ~a" pattern directory)))
122              (hi:editor-error "Error in grep status ~s code ~s: ~a" status exit-code output)))))))
123
124
125(hi:defhvar "Grep Directory"
126  "The directory searched by \"Grep\".  NIL means to use the directory of the buffer."
127  :value nil)
128
129(hi:defhvar "Grep Search Comments"
130  "If true (the default) grep will find results anywhere.  NIL means to ignore results
131   within comments.  For now only recognizes as comments lines which start with semi-colon."
132  :value t)
133
134(hi:defcommand "Grep" (p)
135  "Prompts for a pattern and invokes grep, searching recursively through .lisp
136   files in \"Grep Directory\".
137   With an argument, prompts for a directory to search, and sets \"Grep Directory\"
138   for the next time."
139  ""
140  (let* ((default (make-pathname :name :unspecific
141                                 :type :unspecific
142                                 :defaults (or (hi:value hemlock::grep-directory)
143                                               (hi:buffer-pathname hi::*current-buffer*)
144                                               "ccl:")))
145         (directory (if p
146                        (setf (hi:value hemlock::grep-directory)
147                              (hi:prompt-for-file :must-exist t
148                                                  :default default
149                                                  :default-string (namestring default)
150                                                  :prompt "Directory: "))
151                        default))
152         (pattern (hi:prompt-for-string
153                   :prompt "Pattern: "
154                   :help "Pattern to search for")))
155    (grep pattern directory)))
Note: See TracBrowser for help on using the repository browser.