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