deadgrep.el (57581B)
1 ;;; deadgrep.el --- fast, friendly searching with ripgrep -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2018 Wilfred Hughes 4 5 ;; Author: Wilfred Hughes <me@wilfred.me.uk> 6 ;; URL: https://github.com/Wilfred/deadgrep 7 ;; Package-Version: 20220209.719 8 ;; Package-Commit: 0a3ba239c458ffc4f63a180b43d0e70b81742a3e 9 ;; Keywords: tools 10 ;; Version: 0.11 11 ;; Package-Requires: ((emacs "25.1") (dash "2.12.0") (s "1.11.0") (spinner "1.7.3")) 12 13 ;; This program is free software; you can redistribute it and/or modify 14 ;; it under the terms of the GNU General Public License as published by 15 ;; the Free Software Foundation, either version 3 of the License, or 16 ;; (at your option) any later version. 17 18 ;; This program is distributed in the hope that it will be useful, 19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21 ;; GNU General Public License for more details. 22 23 ;; You should have received a copy of the GNU General Public License 24 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 25 26 ;;; Commentary: 27 28 ;; Perform text searches with the speed of ripgrep and the comfort of 29 ;; Emacs. This is a bespoke mode that does not rely on 30 ;; compilation-mode, but tries to be a perfect fit for ripgrep. 31 32 ;; Install from MELPA, then `M-x deadgrep' will do a search! 33 34 ;;; Code: 35 36 (require 'cl-lib) 37 (require 's) 38 (require 'dash) 39 (require 'spinner) 40 41 (defgroup deadgrep nil 42 "A powerful text search UI using ripgrep." 43 :group 'tools 44 :group 'matching) 45 46 (defcustom deadgrep-executable 47 "rg" 48 "The rg executable used by deadgrep. 49 This will be looked up on `exec-path' if it isn't an absolute 50 path to the binary." 51 :type 'string 52 :group 'deadgrep) 53 54 (defcustom deadgrep-max-buffers 55 4 56 "Deadgrep will kill the least recently used results buffer 57 if there are more than this many. 58 59 To disable cleanup entirely, set this variable to nil." 60 :type '(choice 61 (number :tag "Maximum of buffers allowed") 62 (const :tag "Disable cleanup" nil)) 63 :group 'deadgrep) 64 65 (defcustom deadgrep-project-root-function 66 #'deadgrep--project-root 67 "Function called by `deadgrep' to work out the root directory 68 to search from. 69 70 See also `deadgrep-project-root-overrides'." 71 :type 'function 72 :group 'deadgrep) 73 74 (defvar deadgrep-project-root-overrides nil 75 "An alist associating project directories with the desired 76 search directory. 77 78 This is useful for large repos where you only want to search a 79 subdirectory. It's also handy for nested repos where you want to 80 search from the parent. 81 82 This affects the behaviour of `deadgrep--project-root', so this 83 variable has no effect if you change 84 `deadgrep-project-root-function'.") 85 86 (defvar deadgrep-history 87 nil 88 "A list of the previous search terms.") 89 90 (defvar deadgrep-max-line-length 91 500 92 "Truncate lines if they are longer than this. 93 94 Emacs performance can be really poor with long lines, so this 95 ensures that searching minified files does not slow down movement 96 in results buffers. 97 98 In extreme cases (100KiB+ single-line files), we can get a stack 99 overflow on our regexp matchers if we don't apply this.") 100 101 (defcustom deadgrep-display-buffer-function 102 'switch-to-buffer-other-window 103 "Function used to show the deadgrep result buffer. 104 105 This function is called with one argument, the results buffer to 106 display." 107 :type 'function 108 :group 'deadgrep) 109 110 (defface deadgrep-meta-face 111 '((t :inherit font-lock-comment-face)) 112 "Face used for deadgrep UI text." 113 :group 'deadgrep) 114 115 (defface deadgrep-filename-face 116 '((t :inherit bold)) 117 "Face used for filename headings in results buffers." 118 :group 'deadgrep) 119 120 (defface deadgrep-search-term-face 121 '((t :inherit font-lock-variable-name-face)) 122 "Face used for the search term in results buffers." 123 :group 'deadgrep) 124 125 (defface deadgrep-regexp-metachar-face 126 '((t :inherit 127 ;; TODO: I've seen a more appropriate face in some themes, 128 ;; find out what to use instead here. 129 font-lock-constant-face)) 130 "Face used for regexp metacharacters in search terms." 131 :group 'deadgrep) 132 133 (defface deadgrep-match-face 134 '((t :inherit match)) 135 "Face used for the portion of a line that matches the search term." 136 :group 'deadgrep) 137 138 (defvar-local deadgrep--search-term nil) 139 ;; Ensure this variable is ignored by `kill-all-local-variables' when 140 ;; switching between `deadgrep-mode' and `deadgrep-edit-mode'. 141 (put 'deadgrep--search-term 'permanent-local t) 142 143 (defvar-local deadgrep--search-type 'string) 144 (put 'deadgrep--search-type 'permanent-local t) 145 (defvar-local deadgrep--search-case 'smart) 146 (put 'deadgrep--search-case 'permanent-local t) 147 (defvar-local deadgrep--file-type 'all) 148 (put 'deadgrep--file-type 'permanent-local t) 149 150 (defvar-local deadgrep--context nil 151 "When set, also show context of results. 152 This is stored as a cons cell of integers (lines-before . lines-after).") 153 (put 'deadgrep--context 'permanent-local t) 154 (defvar-local deadgrep--initial-filename nil 155 "The filename of the buffer that deadgrep was started from. 156 Used to offer better default values for file options.") 157 (put 'deadgrep--initial-filename 'permanent-local t) 158 159 (defvar-local deadgrep--current-file nil 160 "The file we're currently inserting results for.") 161 (defvar-local deadgrep--spinner nil) 162 (defvar-local deadgrep--remaining-output nil 163 "We can't guarantee that our process filter will always receive whole lines. 164 We save the last line here, in case we need to append more text to it.") 165 (defvar-local deadgrep--postpone-start nil 166 "If non-nil, don't (re)start searches.") 167 (defvar-local deadgrep--running nil 168 "If non-nil, a search is still running.") 169 170 (defvar-local deadgrep--debug-command nil) 171 (put 'deadgrep--debug-command 'permanent-local t) 172 (defvar-local deadgrep--debug-first-output nil) 173 (put 'deadgrep--debug-first-output 'permanent-local t) 174 175 (defvar-local deadgrep--imenu-alist nil 176 "Alist that stores filename and position for each matched files. 177 It is used to create `imenu' index.") 178 179 (defconst deadgrep--position-column-width 5) 180 181 (defconst deadgrep--color-code 182 (rx "\x1b[" (+ digit) "m") 183 "Regular expression for an ANSI color code.") 184 185 (defun deadgrep--insert-output (output &optional finished) 186 "Propertize OUTPUT from rigrep and write to the current buffer." 187 ;; If we had an unfinished line from our last call, include that. 188 (when deadgrep--remaining-output 189 (setq output (concat deadgrep--remaining-output output)) 190 (setq deadgrep--remaining-output nil)) 191 192 (let ((inhibit-read-only t) 193 (lines (s-lines output)) 194 prev-line-num) 195 ;; Process filters run asynchronously, and don't guarantee that 196 ;; OUTPUT ends with a complete line. Save the last line for 197 ;; later processing. 198 (unless finished 199 (setq deadgrep--remaining-output (-last-item lines)) 200 (setq lines (butlast lines))) 201 202 (save-excursion 203 (goto-char (point-max)) 204 (dolist (line lines) 205 (cond 206 ;; Ignore blank lines. 207 ((s-blank? line)) 208 ;; Lines of just -- are used as a context separator when 209 ;; calling ripgrep with context flags. 210 ((string= line "--") 211 (let ((separator "--")) 212 ;; Try to make the separator length match the previous 213 ;; line numbers. 214 (when prev-line-num 215 (setq separator 216 (s-repeat (log prev-line-num 10) "-"))) 217 (insert 218 (propertize (concat separator "\n") 219 'face 'deadgrep-meta-face)))) 220 ;; If we have a warning or don't have a color code, ripgrep 221 ;; must be complaining about something (e.g. zero matches for 222 ;; a glob, or permission denied on some directories). 223 ((or 224 (s-starts-with-p "WARNING: " line) 225 (not (s-matches-p deadgrep--color-code line))) 226 (when deadgrep--current-file 227 (setq deadgrep--current-file nil) 228 (insert "\n")) 229 (insert line "\n\n")) 230 (t 231 (-let* ((truncate-p (> (length line) deadgrep-max-line-length)) 232 (line 233 (if truncate-p 234 (substring line 0 deadgrep-max-line-length) 235 line)) 236 ((filename line-num content) (deadgrep--split-line line)) 237 (formatted-line-num 238 (s-pad-right deadgrep--position-column-width " " 239 (number-to-string line-num))) 240 (pretty-line-num 241 (propertize formatted-line-num 242 'face 'deadgrep-meta-face 243 'deadgrep-filename filename 244 'deadgrep-line-number line-num 245 'read-only t 246 'front-sticky t 247 'rear-nonsticky t)) 248 (pretty-filename 249 (propertize filename 250 'face 'deadgrep-filename-face 251 'deadgrep-filename filename 252 'read-only t 253 'front-sticky t))) 254 (cond 255 ;; This is the first file we've seen, print the heading. 256 ((null deadgrep--current-file) 257 (push (cons filename (point)) deadgrep--imenu-alist) 258 (insert pretty-filename "\n")) 259 ;; This is a new file, print the heading with a spacer. 260 ((not (equal deadgrep--current-file filename)) 261 (push (cons filename (1+ (point))) deadgrep--imenu-alist) 262 (insert "\n" pretty-filename "\n"))) 263 (setq deadgrep--current-file filename) 264 265 ;; TODO: apply the invisible property if the user decided 266 ;; to hide this filename before we finished finding 267 ;; results in it. 268 (insert pretty-line-num content) 269 (when truncate-p 270 (insert 271 (propertize " ... (truncated)" 272 'face 'deadgrep-meta-face))) 273 (insert "\n") 274 275 (setq prev-line-num line-num)))))))) 276 277 (defcustom deadgrep-finished-hook nil 278 "Hook run when `deadgrep' search is finished." 279 :type 'hook 280 :group 'deadgrep) 281 282 (defun deadgrep--process-sentinel (process output) 283 "Update the deadgrep buffer associated with PROCESS as complete." 284 (let ((buffer (process-buffer process)) 285 (finished-p (string= output "finished\n"))) 286 (when (buffer-live-p buffer) 287 (with-current-buffer buffer 288 (setq deadgrep--running nil) 289 ;; rg has terminated, so stop the spinner. 290 (spinner-stop deadgrep--spinner) 291 292 (deadgrep--insert-output "" finished-p) 293 294 ;; Report any errors that occurred. 295 (unless (member output 296 (list 297 "exited abnormally with code 1\n" 298 "interrupt\n" 299 "finished\n")) 300 (save-excursion 301 (let ((inhibit-read-only t)) 302 (goto-char (point-max)) 303 (insert output)))) 304 305 (run-hooks 'deadgrep-finished-hook) 306 (message "Deadgrep finished"))))) 307 308 (defun deadgrep--process-filter (process output) 309 ;; Searches may see a lot of output, but it's really useful to have 310 ;; a snippet of output when debugging. Store the first output received. 311 (unless deadgrep--debug-first-output 312 (setq deadgrep--debug-first-output output)) 313 314 ;; If we had an unfinished line from our last call, include that. 315 (when deadgrep--remaining-output 316 (setq output (concat deadgrep--remaining-output output)) 317 (setq deadgrep--remaining-output nil)) 318 319 (when (buffer-live-p (process-buffer process)) 320 (with-current-buffer (process-buffer process) 321 (deadgrep--insert-output output)))) 322 323 (defun deadgrep--extract-regexp (pattern s) 324 "Search for PATTERN in S, and return the content of the first group." 325 (string-match pattern s) 326 (match-string 1 s)) 327 328 (defconst deadgrep--filename-regexp 329 (rx bos "\x1b[0m\x1b[3" (or "5" "6") "m" 330 (? "./") 331 (group (+? anything)) 332 "\x1b[") 333 "Extracts the filename from a ripgrep line with ANSI color sequences. 334 We use the color sequences to extract the filename exactly, even 335 if the path contains colons.") 336 337 (defconst deadgrep--line-num-regexp 338 (rx "\x1b[32m" (group (+ digit))) 339 "Extracts the line number from a ripgrep line with ANSI color sequences. 340 Ripgrep uses a unique color for line numbers, so we use that to 341 extract the linue number exactly.") 342 343 (defconst deadgrep--line-contents-regexp 344 (rx "\x1b[32m" (+ digit) "\x1b[0m" (or ":" "-") (group (* anything))) 345 "Extract the line contents from a ripgrep line with ANSI color sequences. 346 Use the unique color for line numbers to ensure we start at the 347 correct colon. 348 349 Note that the text in the group will still contain color codes 350 highlighting which parts matched the user's search term.") 351 352 (defconst deadgrep--hit-regexp 353 (rx-to-string 354 `(seq 355 ;; A reset color code. 356 "\x1b[0m" 357 ;; Two color codes, bold and color (any order). 358 (regexp ,deadgrep--color-code) 359 (regexp ,deadgrep--color-code) 360 ;; The actual text. 361 (group (+? anything)) 362 ;; A reset color code again. 363 "\x1b[0m")) 364 "Extract the portion of a line found by ripgrep that matches the user's input. 365 This may occur multiple times in one line.") 366 367 (defun deadgrep--split-line (line) 368 "Split out the components of a raw LINE of output from rg. 369 Return the filename, line number, and the line content with ANSI 370 color codes replaced with string properties." 371 (list 372 (deadgrep--extract-regexp deadgrep--filename-regexp line) 373 (string-to-number 374 (deadgrep--extract-regexp deadgrep--line-num-regexp line)) 375 (deadgrep--propertize-hits 376 (deadgrep--extract-regexp deadgrep--line-contents-regexp line)))) 377 378 (defun deadgrep--escape-backslash (s) 379 "Escape occurrences of backslashes in S. 380 381 This differs from `regexp-quote', which outputs a regexp pattern. 382 Instead, we provide a string suitable for REP in 383 `replace-regexp-in-string'." 384 (s-replace "\\" "\\\\" s)) 385 386 (defun deadgrep--propertize-hits (line-contents) 387 "Given LINE-CONTENTS from ripgrep, replace ANSI color codes 388 with a text face property `deadgrep-match-face'." 389 (replace-regexp-in-string 390 deadgrep--hit-regexp 391 (lambda (s) 392 (propertize 393 (deadgrep--escape-backslash (match-string 1 s)) 394 'face 'deadgrep-match-face)) 395 line-contents)) 396 397 (define-button-type 'deadgrep-search-term 398 'action #'deadgrep--search-term 399 'help-echo "Change search term") 400 401 (defun deadgrep--search-prompt (&optional default) 402 "The prompt shown to the user when starting a deadgrep search." 403 (let ((kind (if (eq deadgrep--search-type 'regexp) 404 "by regexp" "for text"))) 405 (if default 406 (format "Search %s (default %s): " kind default) 407 (format "Search %s: " kind)))) 408 409 (defun deadgrep--search-term (_button) 410 (deadgrep-search-term)) 411 412 (defun deadgrep-search-term () 413 "Change the current search term and restart the search." 414 (interactive) 415 (setq deadgrep--search-term 416 (read-from-minibuffer 417 (deadgrep--search-prompt) 418 deadgrep--search-term)) 419 (rename-buffer 420 (deadgrep--buffer-name deadgrep--search-term default-directory) t) 421 (deadgrep-restart)) 422 423 (define-button-type 'deadgrep-type 424 'action #'deadgrep--search-type 425 'search-type nil 426 'help-echo "Change search type") 427 428 (defun deadgrep--search-type (button) 429 (setq deadgrep--search-type (button-get button 'search-type)) 430 (deadgrep-restart)) 431 432 (define-button-type 'deadgrep-case 433 'action #'deadgrep--case 434 'case nil 435 'help-echo "Change case sensitivity") 436 437 (defun deadgrep--case (button) 438 (setq deadgrep--search-case (button-get button 'case)) 439 (deadgrep-restart)) 440 441 (define-button-type 'deadgrep-context 442 'action #'deadgrep--context 443 'context nil 444 'help-echo "Show/hide context around match") 445 446 (defun deadgrep--context (button) 447 ;; deadgrep--context takes the value of (before . after) when set. 448 (setq deadgrep--context 449 (cl-case (button-get button 'context) 450 ((nil) 451 nil) 452 (before 453 (cons 454 (read-number "Show N lines before: ") 455 (or (cdr-safe deadgrep--context) 0))) 456 (after 457 (cons 458 (or (car-safe deadgrep--context) 0) 459 (read-number "Show N lines after: "))) 460 (t 461 (error "Unknown context type")))) 462 463 (deadgrep-restart)) 464 465 (defun deadgrep--type-list () 466 "Query the rg executable for available file types." 467 (let* ((output (with-output-to-string 468 (with-current-buffer standard-output 469 (process-file-shell-command 470 (format "%s --type-list" deadgrep-executable) 471 nil '(t nil))))) 472 (lines (s-lines (s-trim output))) 473 (types-and-globs 474 (--map 475 (s-split (rx ": ") it) 476 lines))) 477 (-map 478 (-lambda ((type globs)) 479 (list type (s-split (rx ", ") globs))) 480 types-and-globs))) 481 482 (define-button-type 'deadgrep-file-type 483 'action #'deadgrep--file-type 484 'case nil 485 'help-echo "Change file type") 486 487 (defun deadgrep--format-file-type (file-type extensions) 488 (let* ((max-exts 4) 489 (truncated (> (length extensions) max-exts))) 490 (when truncated 491 (setq extensions 492 (append (-take max-exts extensions) 493 (list "...")))) 494 (format "%s (%s)" 495 file-type 496 (s-join ", " extensions)))) 497 498 (defun deadgrep--glob-regexp (glob) 499 "Convert GLOB pattern to the equivalent elisp regexp." 500 (let* ((i 0) 501 (result "^")) 502 (while (< i (length glob)) 503 (let* ((char (elt glob i))) 504 (cond 505 ;; . matches a literal . in globs. 506 ((eq char ?.) 507 (setq result (concat result "\\.")) 508 (cl-incf i)) 509 ;; ? matches a single char in globs. 510 ((eq char ??) 511 (setq result (concat result ".")) 512 (cl-incf i)) 513 ;; * matches zero or more of anything. 514 ((eq char ?*) 515 (setq result (concat result ".*")) 516 (cl-incf i)) 517 ;; [ab] matches a literal a or b. 518 ;; [a-z] matches characters between a and z inclusive. 519 ;; [?] matches a literal ?. 520 ((eq char ?\[) 521 ;; Find the matching ]. 522 (let ((j (1+ i))) 523 (while (and (< j (length glob)) 524 (not (eq (elt glob j) ?\]))) 525 (cl-incf j)) 526 (cl-incf j) 527 (setq result (concat result 528 (substring glob i j))) 529 (setq i j))) 530 (t 531 (setq result (concat result (char-to-string char))) 532 (cl-incf i))))) 533 (concat result "$"))) 534 535 (defun deadgrep--matches-globs-p (filename globs) 536 "Return non-nil if FILENAME matches any glob pattern in GLOBS." 537 (when filename 538 (--any (string-match-p (deadgrep--glob-regexp it) filename) 539 globs))) 540 541 (defun deadgrep--relevant-file-type (filename types-and-globs) 542 "Try to find the most relevant item in TYPES-AND-GLOBS for FILENAME." 543 (let (;; Find all the items in TYPES-AND-GLOBS whose glob match 544 ;; FILENAME. 545 (matching (-filter (-lambda ((_type globs)) 546 (deadgrep--matches-globs-p filename globs)) 547 types-and-globs))) 548 (->> matching 549 ;; Prefer longer names, so "markdown" over "md" for the type 550 ;; name. 551 (-sort (-lambda ((type1 _) (type2 _)) 552 (< (length type1) (length type2)))) 553 ;; Prefer types with more extensions, as they tend to be more 554 ;; common languages (e.g. 'ocaml' over 'ml'). 555 (-sort (-lambda ((_ globs1) (_ globs2)) 556 (< (length globs1) (length globs2)))) 557 ;; But prefer elisp over lisp for .el files. 558 (-sort (-lambda ((type1 _) (type2 _)) 559 ;; Return t if we're comparing elisp with lisp, nil 560 ;; otherwise. 561 (and (equal type1 "lisp") 562 (equal type2 "elisp")))) 563 ;; Take the highest scoring matching. 564 (-last-item)))) 565 566 (defun deadgrep--read-file-type (filename) 567 "Read a ripgrep file type, defaulting to the type that matches FILENAME." 568 (let* (;; Get the list of types we can offer. 569 (types-and-globs (deadgrep--type-list)) 570 ;; Build a list mapping the formatted types to the type name. 571 (type-choices 572 (-map 573 (-lambda ((type globs)) 574 (list 575 (deadgrep--format-file-type type globs) 576 type)) 577 types-and-globs)) 578 ;; Work out the default type name based on the filename. 579 (default-type-and-globs 580 (deadgrep--relevant-file-type filename types-and-globs)) 581 (default 582 (-when-let ((default-type default-globs) default-type-and-globs) 583 (deadgrep--format-file-type default-type default-globs))) 584 ;; Prompt the user for a file type. 585 (chosen 586 (completing-read 587 "File type: " type-choices nil t nil nil default))) 588 (nth 1 (assoc chosen type-choices)))) 589 590 (defun deadgrep--file-type (button) 591 (let ((button-type (button-get button 'file-type))) 592 (cond 593 ((eq button-type 'all) 594 (setq deadgrep--file-type 'all)) 595 ((eq button-type 'type) 596 (let ((new-file-type 597 (deadgrep--read-file-type deadgrep--initial-filename))) 598 (setq deadgrep--file-type (cons 'type new-file-type)))) 599 ((eq button-type 'glob) 600 (let* ((initial-value 601 (cond 602 ;; If we already have a glob pattern, edit it. 603 ((eq (car-safe deadgrep--file-type) 'glob) 604 (cdr deadgrep--file-type)) 605 ;; If the initial file had a file name of the form 606 ;; foo.bar, offer *.bar as the initial glob. 607 ((and deadgrep--initial-filename 608 (file-name-extension deadgrep--initial-filename)) 609 (format "*.%s" 610 (file-name-extension deadgrep--initial-filename))) 611 (t 612 "*"))) 613 (prompt 614 (if (string= initial-value "*") 615 ;; Show an example to avoid confusion with regexp syntax. 616 "Glob (e.g. *.js): " 617 "Glob: ")) 618 (glob 619 (read-from-minibuffer 620 prompt 621 initial-value))) 622 (setq deadgrep--file-type (cons 'glob glob)))) 623 (t 624 (error "Unknown button type: %S" button-type)))) 625 (deadgrep-restart)) 626 627 (define-button-type 'deadgrep-directory 628 'action #'deadgrep--directory 629 'help-echo "Change base directory") 630 631 (defun deadgrep--directory (_button) 632 (deadgrep-directory)) 633 634 (defun deadgrep-directory () 635 "Prompt the user for a new search directory, then restart the search." 636 (interactive) 637 (setq default-directory 638 (expand-file-name 639 (read-directory-name "Search files in: "))) 640 (rename-buffer 641 (deadgrep--buffer-name deadgrep--search-term default-directory)) 642 (deadgrep-restart)) 643 644 (defun deadgrep--button (text type &rest properties) 645 ;; `make-text-button' mutates the string to add properties, so copy 646 ;; TEXT first. 647 (setq text (substring-no-properties text)) 648 (apply #'make-text-button text nil :type type properties)) 649 650 (defun deadgrep--arguments (search-term search-type case context) 651 "Return a list of command line arguments that we can execute in a shell 652 to obtain ripgrep results." 653 (let (args) 654 (push "--color=ansi" args) 655 (push "--line-number" args) 656 (push "--no-heading" args) 657 (push "--no-column" args) 658 (push "--with-filename" args) 659 660 (cond 661 ((eq search-type 'string) 662 (push "--fixed-strings" args)) 663 ((eq search-type 'words) 664 (push "--fixed-strings" args) 665 (push "--word-regexp" args)) 666 ((eq search-type 'regexp)) 667 (t 668 (error "Unknown search type: %s" search-type))) 669 670 (cond 671 ((eq case 'smart) 672 (push "--smart-case" args)) 673 ((eq case 'sensitive) 674 (push "--case-sensitive" args)) 675 ((eq case 'ignore) 676 (push "--ignore-case" args)) 677 (t 678 (error "Unknown case: %s" case))) 679 680 (cond 681 ((eq deadgrep--file-type 'all)) 682 ((eq (car-safe deadgrep--file-type) 'type) 683 (push (format "--type=%s" (cdr deadgrep--file-type)) args)) 684 ((eq (car-safe deadgrep--file-type) 'glob) 685 (push (format "--type-add=custom:%s" (cdr deadgrep--file-type)) args) 686 (push "--type=custom" args)) 687 (t 688 (error "Unknown file-type: %S" deadgrep--file-type))) 689 690 (when context 691 (push (format "--before-context=%s" (car context)) args) 692 (push (format "--after-context=%s" (cdr context)) args)) 693 694 (push "--" args) 695 (push search-term args) 696 (push "." args) 697 698 (nreverse args))) 699 700 (defun deadgrep--write-heading () 701 "Write the deadgrep heading with buttons reflecting the current 702 search settings." 703 (let ((start-pos (point)) 704 (inhibit-read-only t)) 705 (insert (propertize "Search term: " 706 'face 'deadgrep-meta-face) 707 (if (eq deadgrep--search-type 'regexp) 708 (deadgrep--propertize-regexp deadgrep--search-term) 709 (propertize 710 deadgrep--search-term 711 'face 'deadgrep-search-term-face)) 712 " " 713 (deadgrep--button "change" 'deadgrep-search-term) 714 "\n" 715 (propertize "Search type: " 716 'face 'deadgrep-meta-face) 717 718 (if (eq deadgrep--search-type 'string) 719 "string" 720 (deadgrep--button "string" 'deadgrep-type 721 'search-type 'string)) 722 " " 723 (if (eq deadgrep--search-type 'words) 724 "words" 725 (deadgrep--button "words" 'deadgrep-type 726 'search-type 'words)) 727 " " 728 (if (eq deadgrep--search-type 'regexp) 729 "regexp" 730 (deadgrep--button "regexp" 'deadgrep-type 731 'search-type 'regexp)) 732 "\n" 733 (propertize "Case: " 734 'face 'deadgrep-meta-face) 735 (if (eq deadgrep--search-case 'smart) 736 "smart" 737 (deadgrep--button "smart" 'deadgrep-case 738 'case 'smart)) 739 " " 740 (if (eq deadgrep--search-case 'sensitive) 741 "sensitive" 742 (deadgrep--button "sensitive" 'deadgrep-case 743 'case 'sensitive)) 744 " " 745 (if (eq deadgrep--search-case 'ignore) 746 "ignore" 747 (deadgrep--button "ignore" 'deadgrep-case 748 'case 'ignore)) 749 "\n" 750 (propertize "Context: " 751 'face 'deadgrep-meta-face) 752 (if deadgrep--context 753 (deadgrep--button "none" 'deadgrep-context 754 'context nil) 755 "none") 756 " " 757 (deadgrep--button "before" 'deadgrep-context 758 'context 'before) 759 (if deadgrep--context 760 (format ":%d" (car deadgrep--context)) 761 "") 762 " " 763 (deadgrep--button "after" 'deadgrep-context 764 'context 'after) 765 (if deadgrep--context 766 (format ":%d" (cdr deadgrep--context)) 767 "") 768 769 "\n\n" 770 (propertize "Directory: " 771 'face 'deadgrep-meta-face) 772 (deadgrep--button 773 (abbreviate-file-name default-directory) 774 'deadgrep-directory) 775 (if (get-text-property 0 'deadgrep-overridden default-directory) 776 (propertize " (from override)" 'face 'deadgrep-meta-face) 777 "") 778 "\n" 779 (propertize "Files: " 780 'face 'deadgrep-meta-face) 781 (if (eq deadgrep--file-type 'all) 782 "all" 783 (deadgrep--button "all" 'deadgrep-file-type 784 'file-type 'all)) 785 " " 786 (deadgrep--button "type" 'deadgrep-file-type 787 'file-type 'type) 788 (if (eq (car-safe deadgrep--file-type) 'type) 789 (format ":%s" (cdr deadgrep--file-type)) 790 "") 791 " " 792 (deadgrep--button "glob" 'deadgrep-file-type 793 'file-type 'glob) 794 (if (eq (car-safe deadgrep--file-type) 'glob) 795 (format ":%s" (cdr deadgrep--file-type)) 796 "") 797 "\n\n") 798 (put-text-property 799 start-pos (point) 800 'read-only t) 801 (put-text-property 802 start-pos (point) 803 'front-sticky t))) 804 805 ;; TODO: could we do this in the minibuffer too? 806 (defun deadgrep--propertize-regexp (regexp) 807 "Given a string REGEXP representing a search term with regular 808 expression syntax, highlight the metacharacters. 809 Returns a copy of REGEXP with properties set." 810 (setq regexp (copy-sequence regexp)) 811 812 ;; See https://docs.rs/regex/1.0.0/regex/#syntax 813 (let ((metachars 814 ;; Characters that don't match themselves. 815 '(?\( ?\) ?\[ ?\] ?\{ ?\} ?| ?. ?+ ?* ?? ?^ ?$)) 816 ;; Characters that have special regexp meaning when preceded 817 ;; with a backslash. This includes things like \b but not 818 ;; things like \n. 819 (escape-metachars 820 '(?A ?b ?B ?d ?D ?p ?s ?S ?w ?W ?z)) 821 (prev-char nil)) 822 ;; Put the standard search term face on every character 823 ;; individually. 824 (dotimes (i (length regexp)) 825 (put-text-property 826 i (1+ i) 827 'face 'deadgrep-search-term-face 828 regexp)) 829 ;; Put the metacharacter face on any character that isn't treated 830 ;; literally. 831 (--each-indexed (string-to-list regexp) 832 (cond 833 ;; Highlight everything between { and }. 834 ((and (eq it ?\{) (not (equal prev-char ?\\))) 835 (let ((closing-pos it-index)) 836 ;; TODO: we have loops like this in several places, factor 837 ;; out. 838 (while (and (< closing-pos (length regexp)) 839 (not (eq (elt regexp closing-pos) 840 ?\}))) 841 (cl-incf closing-pos)) 842 ;; Step over the closing }, if we found one. 843 (unless (= closing-pos (length regexp)) 844 (cl-incf closing-pos)) 845 (put-text-property 846 it-index closing-pos 847 'face 848 'deadgrep-regexp-metachar-face 849 regexp))) 850 ;; Highlight individual metachars. 851 ((and (memq it metachars) (not (equal prev-char ?\\))) 852 (put-text-property 853 it-index (1+ it-index) 854 'face 855 'deadgrep-regexp-metachar-face 856 regexp)) 857 ((and (memq it escape-metachars) (equal prev-char ?\\)) 858 (put-text-property 859 (1- it-index) (1+ it-index) 860 'face 'deadgrep-regexp-metachar-face 861 regexp))) 862 863 (setq prev-char it))) 864 regexp) 865 866 (defun deadgrep--buffer-name (search-term directory) 867 ;; TODO: Handle buffers already existing with this name. 868 (format "*deadgrep %s %s*" 869 (s-truncate 30 search-term) 870 (abbreviate-file-name directory))) 871 872 (defun deadgrep--buffers () 873 "All the current deadgrep results buffers. 874 Returns a list ordered by the most recently accessed." 875 (--filter (with-current-buffer it 876 (eq major-mode 'deadgrep-mode)) 877 ;; `buffer-list' seems to be ordered by most recently 878 ;; visited first. 879 (buffer-list))) 880 881 (defun deadgrep--buffer (search-term directory initial-filename) 882 "Create and initialise a search results buffer." 883 (let* ((buf-name (deadgrep--buffer-name search-term directory)) 884 (buf (get-buffer buf-name))) 885 (if buf 886 ;; There was already a buffer with this name. Reset its search 887 ;; state. 888 (with-current-buffer buf 889 (deadgrep--stop-and-reset)) 890 ;; We need to create the buffer, ensure we don't exceed 891 ;; `deadgrep-max-buffers' by killing the least recently used. 892 (progn 893 (when (numberp deadgrep-max-buffers) 894 (let* ((excess-buffers (-drop (1- deadgrep-max-buffers) 895 (deadgrep--buffers)))) 896 ;; Kill buffers so we have one buffer less than the maximum 897 ;; before we create a new one. 898 (-each excess-buffers #'kill-buffer))) 899 900 (setq buf (get-buffer-create buf-name)))) 901 902 (with-current-buffer buf 903 (setq default-directory directory) 904 (let ((inhibit-read-only t)) 905 ;; This needs to happen first, as it clobbers all buffer-local 906 ;; variables. 907 (deadgrep-mode) 908 (erase-buffer) 909 910 (setq deadgrep--search-term search-term) 911 (setq deadgrep--current-file nil) 912 (setq deadgrep--initial-filename initial-filename)) 913 (setq buffer-read-only t)) 914 buf)) 915 916 (defvar deadgrep-mode-map 917 (let ((map (make-sparse-keymap))) 918 (define-key map (kbd "RET") #'deadgrep-visit-result) 919 (define-key map (kbd "o") #'deadgrep-visit-result-other-window) 920 ;; TODO: we should still be able to click on buttons. 921 922 (define-key map (kbd "S") #'deadgrep-search-term) 923 (define-key map (kbd "D") #'deadgrep-directory) 924 (define-key map (kbd "g") #'deadgrep-restart) 925 926 ;; TODO: this should work when point is anywhere in the file, not 927 ;; just on its heading. 928 (define-key map (kbd "TAB") #'deadgrep-toggle-file-results) 929 930 ;; Keybinding chosen to match `kill-compilation'. 931 (define-key map (kbd "C-c C-k") #'deadgrep-kill-process) 932 933 (define-key map (kbd "n") #'deadgrep-forward) 934 (define-key map (kbd "p") #'deadgrep-backward) 935 (define-key map (kbd "N") #'deadgrep-forward-match) 936 (define-key map (kbd "P") #'deadgrep-backward-match) 937 (define-key map (kbd "M-n") #'deadgrep-forward-filename) 938 (define-key map (kbd "M-p") #'deadgrep-backward-filename) 939 940 map) 941 "Keymap for `deadgrep-mode'.") 942 943 (defvar deadgrep-edit-mode-map 944 (let ((map (make-sparse-keymap))) 945 (define-key map (kbd "RET") #'deadgrep-visit-result) 946 map) 947 "Keymap for `deadgrep-edit-mode'.") 948 949 (define-derived-mode deadgrep-mode special-mode 950 '("Deadgrep" (:eval (spinner-print deadgrep--spinner))) 951 "Major mode for deadgrep results buffers." 952 (remove-hook 'after-change-functions #'deadgrep--propagate-change t)) 953 954 (defun deadgrep--find-file (path) 955 "Open PATH in a buffer, and return a cons cell 956 \(BUF . OPENED). OPENED is nil if there was aleady a buffer for 957 this path." 958 (let* ((initial-buffers (buffer-list)) 959 (opened nil) 960 ;; Skip running find-file-hook since it may prompt the user. 961 (find-file-hook nil) 962 ;; If we end up opening a buffer, don't bother with file 963 ;; variables. It prompts the user, and we discard the buffer 964 ;; afterwards anyway. 965 (enable-local-variables nil) 966 ;; Bind `auto-mode-alist' to nil, so we open the buffer in 967 ;; `fundamental-mode' if it isn't already open. 968 (auto-mode-alist nil) 969 ;; Use `find-file-noselect' so we still decode bytes from the 970 ;; underlying file. 971 (buf (find-file-noselect path))) 972 (unless (-contains-p initial-buffers buf) 973 (setq opened t)) 974 (cons buf opened))) 975 976 (defun deadgrep--propagate-change (beg end length) 977 "Repeat the last modification to the results buffer in the 978 underlying file." 979 ;; We should never be called outside an edit buffer, but be 980 ;; defensive. Buggy functions in change hooks are painful. 981 (when (eq major-mode 'deadgrep-edit-mode) 982 (save-mark-and-excursion 983 (goto-char beg) 984 (-let* ((column (+ (deadgrep--current-column) length)) 985 (filename (deadgrep--filename)) 986 (line-number (deadgrep--line-number)) 987 ((buf . opened) (deadgrep--find-file filename)) 988 (inserted (buffer-substring beg end))) 989 (with-current-buffer buf 990 (save-mark-and-excursion 991 (save-restriction 992 (widen) 993 (goto-char 994 (deadgrep--buffer-position line-number column)) 995 (delete-char (- length)) 996 (insert inserted))) 997 ;; If we weren't visiting this file before, just save it and 998 ;; close it. 999 (when opened 1000 (basic-save-buffer) 1001 (kill-buffer buf))))))) 1002 1003 (defcustom deadgrep-edit-mode-hook nil 1004 "Called after `deadgrep-edit-mode' is turned on." 1005 :type 'hook 1006 :group 'deadgrep) 1007 1008 (defun deadgrep-edit-mode () 1009 "Major mode for editing the results files directly from a 1010 deadgrep results buffer. 1011 1012 \\{deadgrep-edit-mode-map}" 1013 (interactive) 1014 (unless (eq major-mode 'deadgrep-mode) 1015 (user-error "deadgrep-edit-mode only works in deadgrep result buffers")) 1016 (when deadgrep--running 1017 (user-error "Can't edit a results buffer until the search is finished")) 1018 ;; We deliberately don't use `define-derived-mode' here because we 1019 ;; want to check the previous value of `major-mode'. Initialise the 1020 ;; major mode manually. 1021 (delay-mode-hooks 1022 (kill-all-local-variables) 1023 (setq major-mode 'deadgrep-edit-mode) 1024 (setq mode-name 1025 '(:propertize "Deadgrep:Edit" face mode-line-emphasis)) 1026 (use-local-map deadgrep-edit-mode-map) 1027 ;; Done major mode manual initialise (copied from `define-derived-mode'). 1028 1029 ;; Allow editing, and propagate changes. 1030 (setq buffer-read-only nil) 1031 (add-hook 'after-change-functions #'deadgrep--propagate-change nil t) 1032 1033 (message "Now editing, use `M-x deadgrep-mode' when finished")) 1034 1035 (run-mode-hooks 'deadgrep-edit-mode-hook)) 1036 1037 (defun deadgrep--current-column () 1038 "Get the current column position in char terms. 1039 This treats tabs as 1 and ignores the line numbers in the results 1040 buffer." 1041 (let* ((line-start (line-beginning-position)) 1042 (line-number 1043 (get-text-property line-start 'deadgrep-line-number)) 1044 (line-number-width 1045 (max deadgrep--position-column-width 1046 (length (number-to-string line-number)))) 1047 (char-count 0)) 1048 (save-excursion 1049 (while (not (equal (point) line-start)) 1050 (cl-incf char-count) 1051 (backward-char 1))) 1052 (max 1053 (- char-count line-number-width) 1054 0))) 1055 1056 (defun deadgrep--flash-column-offsets (start end) 1057 "Temporarily highlight column offset from START to END." 1058 (let* ((line-start (line-beginning-position)) 1059 (overlay (make-overlay 1060 (+ line-start start) 1061 (+ line-start end)))) 1062 (overlay-put overlay 'face 'highlight) 1063 (run-with-timer 1.0 nil 'delete-overlay overlay))) 1064 1065 (defun deadgrep--match-face-p (pos) 1066 "Is there a match face at POS?" 1067 (eq (get-text-property pos 'face) 'deadgrep-match-face)) 1068 1069 (defun deadgrep--match-positions () 1070 "Return a list of indexes of the current line's matches." 1071 (let (positions) 1072 (save-excursion 1073 (beginning-of-line) 1074 1075 (let* ((line-number 1076 (get-text-property (point) 'deadgrep-line-number)) 1077 (line-number-width 1078 (max deadgrep--position-column-width 1079 (length (number-to-string line-number)))) 1080 (i 0) 1081 (start-pos 0) 1082 (line-end-pos (line-end-position))) 1083 1084 (forward-char line-number-width) 1085 1086 (while (<= (point) line-end-pos) 1087 ;; If we've just entered a match, record the start position. 1088 (when (and (deadgrep--match-face-p (point)) 1089 (not (deadgrep--match-face-p (1- (point))))) 1090 (setq start-pos i)) 1091 ;; If we've just left a match, record the match range. 1092 (when (and (not (deadgrep--match-face-p (point))) 1093 (deadgrep--match-face-p (1- (point)))) 1094 (push (list start-pos i) positions)) 1095 1096 (setq i (1+ i)) 1097 (forward-char 1)))) 1098 1099 (nreverse positions))) 1100 1101 (defun deadgrep--buffer-position (line-number column-offset) 1102 "Return the position equivalent to LINE-NUMBER at COLUMN-OFFSET 1103 in the current buffer." 1104 (save-excursion 1105 (save-restriction 1106 (widen) 1107 (goto-char (point-min)) 1108 (forward-line (1- line-number)) 1109 (forward-char column-offset) 1110 1111 (point)))) 1112 1113 (defun deadgrep--filename (&optional pos) 1114 "Get the filename of the result at point POS. 1115 If POS is nil, use the beginning position of the current line." 1116 (get-text-property (or pos (line-beginning-position)) 'deadgrep-filename)) 1117 1118 (defun deadgrep--line-number () 1119 "Get the filename of the result at point." 1120 (get-text-property (line-beginning-position) 'deadgrep-line-number)) 1121 1122 (defun deadgrep--visit-result (open-fn) 1123 "Goto the search result at point." 1124 (interactive) 1125 (let* ((pos (line-beginning-position)) 1126 (file-name (deadgrep--filename)) 1127 (line-number (deadgrep--line-number)) 1128 (column-offset (when line-number (deadgrep--current-column))) 1129 (match-positions (when line-number (deadgrep--match-positions)))) 1130 (when file-name 1131 (when overlay-arrow-position 1132 (set-marker overlay-arrow-position nil)) 1133 ;; Show an arrow next to the last result viewed. This is 1134 ;; consistent with `compilation-next-error-function' and also 1135 ;; useful with `deadgrep-visit-result-other-window'. 1136 (setq overlay-arrow-position (copy-marker pos)) 1137 1138 (funcall open-fn file-name) 1139 (goto-char (point-min)) 1140 1141 (when line-number 1142 (-let [destination-pos (deadgrep--buffer-position 1143 line-number column-offset)] 1144 ;; Put point on the position of the match, widening the 1145 ;; buffer if necessary. 1146 (when (or (< destination-pos (point-min)) 1147 (> destination-pos (point-max))) 1148 (widen)) 1149 (goto-char destination-pos) 1150 1151 ;; Temporarily highlight the parts of the line that matched 1152 ;; the search term. 1153 (-each match-positions 1154 (-lambda ((start end)) 1155 (deadgrep--flash-column-offsets start end)))))))) 1156 1157 (defun deadgrep-visit-result-other-window () 1158 "Goto the search result at point, opening in another window." 1159 (interactive) 1160 (deadgrep--visit-result #'find-file-other-window)) 1161 1162 (defun deadgrep-visit-result () 1163 "Goto the search result at point." 1164 (interactive) 1165 (deadgrep--visit-result #'find-file)) 1166 1167 (defvar-local deadgrep--hidden-files nil 1168 "An alist recording which files currently have their lines 1169 hidden in this deadgrep results buffer. 1170 1171 Keys are interned filenames, so they compare with `eq'.") 1172 1173 (defun deadgrep-toggle-file-results () 1174 "Show/hide the results of the file at point." 1175 (interactive) 1176 (let* ((file-name (deadgrep--filename)) 1177 (line-number (deadgrep--line-number))) 1178 (when (and file-name (not line-number)) 1179 ;; We're on a file heading. 1180 (if (alist-get (intern file-name) deadgrep--hidden-files) 1181 (deadgrep--show) 1182 (deadgrep--hide))))) 1183 1184 (defun deadgrep--show () 1185 (-let* ((file-name (deadgrep--filename)) 1186 ((start-pos end-pos) (alist-get (intern file-name) deadgrep--hidden-files))) 1187 (remove-overlays start-pos end-pos 'invisible t) 1188 (setf (alist-get (intern file-name) deadgrep--hidden-files) 1189 nil))) 1190 1191 (defun deadgrep--hide () 1192 "Hide the file results immediately after point." 1193 (save-excursion 1194 (let* ((file-name (deadgrep--filename)) 1195 (start-pos 1196 (progn 1197 (forward-line) 1198 (point))) 1199 (end-pos 1200 (progn 1201 (while (and 1202 (get-text-property (point) 'deadgrep-line-number) 1203 (not (bobp))) 1204 (forward-line)) 1205 ;; Step over the newline. 1206 (1+ (point)))) 1207 (o (make-overlay start-pos end-pos))) 1208 (overlay-put o 'invisible t) 1209 (setf (alist-get (intern file-name) deadgrep--hidden-files) 1210 (list start-pos end-pos))))) 1211 1212 (defun deadgrep--interrupt-process () 1213 "Gracefully stop the rg process, synchronously." 1214 (-when-let (proc (get-buffer-process (current-buffer))) 1215 ;; Ensure that our process filter is not called again. 1216 (set-process-filter proc #'ignore) 1217 1218 (interrupt-process proc) 1219 ;; Wait for the process to terminate, so we know that 1220 ;; `deadgrep--process-sentinel' has been called. 1221 (while (process-live-p proc) 1222 ;; `redisplay' can trigger process filters or sentinels. 1223 (redisplay) 1224 (sleep-for 0.1)))) 1225 1226 (defun deadgrep-kill-process () 1227 "Kill the deadgrep process associated with the current buffer." 1228 (interactive) 1229 (if (get-buffer-process (current-buffer)) 1230 (deadgrep--interrupt-process) 1231 (message "No process running."))) 1232 1233 (defun deadgrep--item-p (pos) 1234 "Is there something at POS that we can interact with?" 1235 (or (button-at pos) 1236 (deadgrep--filename pos))) 1237 1238 (defun deadgrep--filename-p (pos) 1239 "Is there a filename at POS that we can interact with?" 1240 (eq (get-text-property pos 'face) 'deadgrep-filename-face)) 1241 1242 (defun deadgrep--move (forward-p) 1243 "Move to the next item. 1244 This will either be a button, a filename, or a search result." 1245 (interactive) 1246 (let ((pos (point))) 1247 ;; If point is initially on an item, move past it. 1248 (while (and (deadgrep--item-p pos) 1249 (if forward-p 1250 (< pos (point-max)) 1251 (> pos (point-min)))) 1252 (if forward-p 1253 (cl-incf pos) 1254 (cl-decf pos))) 1255 ;; Find the next item. 1256 (while (and (not (deadgrep--item-p pos)) 1257 (if forward-p 1258 (< pos (point-max)) 1259 (> pos (point-min)))) 1260 (if forward-p 1261 (cl-incf pos) 1262 (cl-decf pos))) 1263 ;; Regardless of direction, ensure point is at the beginning of 1264 ;; the item. 1265 (while (and (if forward-p 1266 (< pos (point-max)) 1267 (> pos (point-min))) 1268 (deadgrep--item-p (1- pos))) 1269 (cl-decf pos)) 1270 ;; If we reached an item (we aren't at the first/last item), then 1271 ;; go to it. 1272 (when (deadgrep--item-p pos) 1273 (goto-char pos)))) 1274 1275 (defun deadgrep-forward () 1276 "Move forward to the next item. 1277 This will either be a button, a filename, or a search result. See 1278 also `deadgrep-forward-match'." 1279 (interactive) 1280 (deadgrep--move t)) 1281 1282 (defun deadgrep-backward () 1283 "Move backward to the previous item. 1284 This will either be a button, a filename, or a search result. See 1285 also `deadgrep-backward-match'." 1286 (interactive) 1287 (deadgrep--move nil)) 1288 1289 (defun deadgrep-forward-filename () 1290 "Move forward to the next filename." 1291 (interactive) 1292 (deadgrep--move-match t 'deadgrep-filename-face)) 1293 1294 (defun deadgrep-backward-filename () 1295 "Move backward to the previous filename." 1296 (interactive) 1297 (deadgrep--move-match nil 'deadgrep-filename-face)) 1298 1299 (defun deadgrep--move-match (forward-p face) 1300 "Move point to the beginning of the next/previous match." 1301 (interactive) 1302 (let ((start-pos (point))) 1303 ;; Move over the current match, if we were already on one. 1304 (while (eq (get-text-property (point) 'face) 1305 face) 1306 (if forward-p (forward-char) (backward-char))) 1307 (condition-case nil 1308 (progn 1309 ;; Move point to the next match, which may be on the same line. 1310 (while (not (eq (get-text-property (point) 'face) 1311 face)) 1312 (if forward-p (forward-char) (backward-char))) 1313 ;; Ensure point is at the beginning of the match. 1314 (unless forward-p 1315 (while (eq (get-text-property (point) 'face) 1316 face) 1317 (backward-char)) 1318 (forward-char))) 1319 ;; Don't move point beyond the last match. However, it's still 1320 ;; useful to signal that we're at the end, so users can use this 1321 ;; command with macros and terminate when it's done. 1322 (beginning-of-buffer 1323 (goto-char start-pos) 1324 (signal 'beginning-of-buffer nil)) 1325 (end-of-buffer 1326 (goto-char start-pos) 1327 (signal 'end-of-buffer nil))))) 1328 1329 (defun deadgrep-forward-match () 1330 "Move point forward to the beginning of next match. 1331 Note that a result line may contain more than one match, or zero 1332 matches (if the result line has been truncated)." 1333 (interactive) 1334 (deadgrep--move-match t 'deadgrep-match-face)) 1335 1336 (defun deadgrep-backward-match () 1337 "Move point backward to the beginning of previous match." 1338 (interactive) 1339 (deadgrep--move-match nil 'deadgrep-match-face)) 1340 1341 (defun deadgrep--start (search-term search-type case) 1342 "Start a ripgrep search." 1343 (setq deadgrep--spinner (spinner-create 'progress-bar t)) 1344 (setq deadgrep--running t) 1345 (spinner-start deadgrep--spinner) 1346 (let* ((args (deadgrep--arguments 1347 search-term search-type case 1348 deadgrep--context)) 1349 (process 1350 (apply #'start-file-process 1351 (format "rg %s" search-term) 1352 (current-buffer) 1353 deadgrep-executable 1354 args))) 1355 (setq deadgrep--debug-command 1356 (format "%s %s" deadgrep-executable (s-join " " args))) 1357 (set-process-filter process #'deadgrep--process-filter) 1358 (set-process-sentinel process #'deadgrep--process-sentinel))) 1359 1360 (defun deadgrep--stop-and-reset () 1361 "Terminate the current search and reset any search state." 1362 ;; Stop the old search, so we don't carry on inserting results from 1363 ;; the last thing we searched for. 1364 (deadgrep--interrupt-process) 1365 1366 (let ((inhibit-read-only t)) 1367 ;; Reset UI: remove results, reset items hidden by TAB, and arrow 1368 ;; position. 1369 (erase-buffer) 1370 (setq deadgrep--hidden-files nil) 1371 (when overlay-arrow-position 1372 (set-marker overlay-arrow-position nil)) 1373 1374 ;; Reset intermediate search state. 1375 (setq deadgrep--current-file nil) 1376 (setq deadgrep--spinner nil) 1377 (setq deadgrep--remaining-output nil) 1378 (setq deadgrep--current-file nil) 1379 (setq deadgrep--debug-first-output nil) 1380 (setq deadgrep--imenu-alist nil))) 1381 1382 (defun deadgrep-restart () 1383 "Re-run ripgrep with the current search settings." 1384 (interactive) 1385 ;; If we haven't started yet, start the search if we've been called 1386 ;; by the user. 1387 (when (and deadgrep--postpone-start 1388 (called-interactively-p 'interactive)) 1389 (setq deadgrep--postpone-start nil)) 1390 1391 (deadgrep--stop-and-reset) 1392 1393 (let ((start-point (point)) 1394 (inhibit-read-only t)) 1395 (deadgrep--write-heading) 1396 ;; If the point was in the heading, ensure that we restore its 1397 ;; position. 1398 (goto-char (min (point-max) start-point)) 1399 1400 (if deadgrep--postpone-start 1401 (deadgrep--write-postponed) 1402 (deadgrep--start 1403 deadgrep--search-term 1404 deadgrep--search-type 1405 deadgrep--search-case)))) 1406 1407 (defun deadgrep--read-search-term () 1408 "Read a search term from the minibuffer. 1409 If region is active, return that immediately. Otherwise, prompt 1410 for a string, offering the current word as a default." 1411 (let (search-term) 1412 (if (use-region-p) 1413 (progn 1414 (setq search-term 1415 (buffer-substring-no-properties (region-beginning) (region-end))) 1416 (deactivate-mark)) 1417 (let* ((sym (symbol-at-point)) 1418 (sym-name (when sym 1419 (substring-no-properties (symbol-name sym)))) 1420 ;; TODO: prompt should say search string or search regexp 1421 ;; as appropriate. 1422 (prompt 1423 (deadgrep--search-prompt sym-name))) 1424 (setq search-term 1425 (read-from-minibuffer 1426 prompt nil nil nil 'deadgrep-history sym-name)) 1427 (when (equal search-term "") 1428 (setq search-term sym-name)))) 1429 (unless (equal (car deadgrep-history) search-term) 1430 (push search-term deadgrep-history)) 1431 search-term)) 1432 1433 (defun deadgrep--normalise-dirname (path) 1434 "Expand PATH and ensure that it doesn't end with a slash. 1435 If PATH is remote path, it is not expanded." 1436 (directory-file-name (if (file-remote-p path) 1437 path 1438 (let (file-name-handler-alist) 1439 (expand-file-name path))))) 1440 1441 (defun deadgrep--lookup-override (path) 1442 "If PATH is present in `deadgrep-project-root-overrides', 1443 return the overridden value. 1444 Otherwise, return PATH as is." 1445 (let* ((normalised-path (deadgrep--normalise-dirname path)) 1446 (override 1447 (-first 1448 (-lambda ((original . _)) 1449 (equal (deadgrep--normalise-dirname original) normalised-path)) 1450 deadgrep-project-root-overrides))) 1451 (when override 1452 (setq path (cdr override)) 1453 (unless (stringp path) 1454 (user-error "Bad override: expected a path string, but got: %S" path)) 1455 (setq path (propertize path 'deadgrep-overridden t))) 1456 path)) 1457 1458 (defun deadgrep--project-root () 1459 "Guess the project root of the given FILE-PATH." 1460 (let ((root default-directory) 1461 (project (project-current))) 1462 (when project 1463 (-when-let (roots (project-roots project)) 1464 (setq root (car roots)))) 1465 (when root 1466 (deadgrep--lookup-override root)))) 1467 1468 (defun deadgrep--write-postponed () 1469 (let* ((inhibit-read-only t) 1470 (restart-key 1471 (where-is-internal #'deadgrep-restart deadgrep-mode-map t))) 1472 (save-excursion 1473 (goto-char (point-max)) 1474 (insert 1475 (format "Press %s to start the search." 1476 (key-description restart-key)))))) 1477 1478 (defun deadgrep--create-imenu-index () 1479 "Create `imenu' index for matched files." 1480 (when deadgrep--imenu-alist 1481 (list (cons "Files" (reverse deadgrep--imenu-alist))))) 1482 1483 ;;;###autoload 1484 (defun deadgrep (search-term &optional directory) 1485 "Start a ripgrep search for SEARCH-TERM in DIRECTORY. 1486 1487 If not provided, DIR defaults to the directory as determined by 1488 `deadgrep-project-root-function'. 1489 1490 See also `deadgrep-project-root-overrides'. 1491 1492 If called with a prefix argument, create the results buffer but 1493 don't actually start the search." 1494 (interactive (list (deadgrep--read-search-term))) 1495 (let* ((dir (or directory 1496 (funcall deadgrep-project-root-function))) 1497 (buf (deadgrep--buffer 1498 search-term 1499 dir 1500 (or deadgrep--initial-filename 1501 (buffer-file-name)))) 1502 (last-results-buf (car-safe (deadgrep--buffers))) 1503 prev-search-type 1504 prev-search-case) 1505 ;; Find out what search settings were used last time. 1506 (when last-results-buf 1507 (with-current-buffer last-results-buf 1508 (setq prev-search-type deadgrep--search-type) 1509 (setq prev-search-case deadgrep--search-case))) 1510 1511 (funcall deadgrep-display-buffer-function buf) 1512 1513 (with-current-buffer buf 1514 (setq imenu-create-index-function #'deadgrep--create-imenu-index) 1515 (setq next-error-function #'deadgrep-next-error) 1516 1517 ;; If we have previous search settings, apply them to our new 1518 ;; search results buffer. 1519 (when last-results-buf 1520 (setq deadgrep--search-type prev-search-type) 1521 (setq deadgrep--search-case prev-search-case)) 1522 1523 (deadgrep--write-heading) 1524 1525 (if current-prefix-arg 1526 ;; Don't start the search, just create the buffer and inform 1527 ;; the user how to start when they're ready. 1528 (progn 1529 (setq deadgrep--postpone-start t) 1530 (deadgrep--write-postponed)) 1531 ;; Start the search immediately. 1532 (deadgrep--start 1533 search-term 1534 deadgrep--search-type 1535 deadgrep--search-case))))) 1536 1537 (defun deadgrep-next-error (arg reset) 1538 "Move to the next error. 1539 If ARG is given, move by that many errors. 1540 1541 This is intended for use with `next-error-function', which see." 1542 (when reset 1543 (goto-char (point-min))) 1544 (beginning-of-line) 1545 (let ((direction (> arg 0))) 1546 (setq arg (abs arg)) 1547 1548 (while (and 1549 (not (zerop arg)) 1550 (not (eobp))) 1551 (if direction 1552 (forward-line 1) 1553 (forward-line -1)) 1554 ;; If we are on a specific result (not a heading), we have a line 1555 ;; number. 1556 (when (get-text-property (point) 'deadgrep-line-number) 1557 (cl-decf arg)))) 1558 (deadgrep-visit-result-other-window)) 1559 1560 (defun deadgrep-debug () 1561 "Show a buffer with some debug information about the current search." 1562 (interactive) 1563 (unless (eq major-mode 'deadgrep-mode) 1564 (user-error "deadgrep-debug should be run in a deadgrep results buffer")) 1565 1566 (let ((command deadgrep--debug-command) 1567 (output deadgrep--debug-first-output) 1568 (buf (get-buffer-create "*deadgrep debug*")) 1569 (inhibit-read-only t)) 1570 (pop-to-buffer buf) 1571 (erase-buffer) 1572 (special-mode) 1573 (setq buffer-read-only t) 1574 1575 (insert 1576 (propertize 1577 "About your environment:\n" 1578 'face 'deadgrep-filename-face) 1579 (format "Platform: %s\n" system-type) 1580 (format "Emacs version: %s\n" emacs-version) 1581 (format "Command: %s\n" command) 1582 (format "default-directory: %S\n" default-directory) 1583 (format "exec-path: %S\n" exec-path) 1584 (if (boundp 'tramp-remote-path) 1585 (format "tramp-remote-path: %S\n" tramp-remote-path) 1586 "") 1587 (propertize 1588 "\nInitial output from ripgrep:\n" 1589 'face 'deadgrep-filename-face) 1590 (format "%S" output) 1591 (propertize 1592 "\n\nPlease file bugs at https://github.com/Wilfred/deadgrep/issues/new" 1593 'face 'deadgrep-filename-face)))) 1594 1595 (defun deadgrep-kill-all-buffers () 1596 "Kill all open deadgrep buffers." 1597 (interactive) 1598 (dolist (buffer (deadgrep--buffers)) 1599 (kill-buffer buffer))) 1600 1601 (provide 'deadgrep) 1602 ;;; deadgrep.el ends here