diff --git a/sample_files/conflicts.el b/sample_files/conflicts.el new file mode 100644 index 000000000..a2b31c3cb --- /dev/null +++ b/sample_files/conflicts.el @@ -0,0 +1,1711 @@ +;;; deadgrep.el --- fast, friendly searching with ripgrep -*- lexical-binding: t; -*- + +;; Copyright (C) 2018 Wilfred Hughes + +;; Author: Wilfred Hughes +;; URL: https://github.com/Wilfred/deadgrep +;; Keywords: tools +;; Version: 0.13 +;; Package-Requires: ((emacs "25.1") (dash "2.12.0") (s "1.11.0") (spinner "1.7.3")) + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Perform text searches with the speed of ripgrep and the comfort of +;; Emacs. This is a bespoke mode that does not rely on +;; compilation-mode, but tries to be a perfect fit for ripgrep. + +;; Install from MELPA, then `M-x deadgrep' will do a search! + +;;; Code: + +(require 'cl-lib) +(require 's) +(require 'dash) +(require 'spinner) +(require 'project) + +(defgroup deadgrep nil + "A powerful text search UI using ripgrep." + :group 'tools + :group 'matching) + +(defcustom deadgrep-executable + "rg" + "The rg executable used by deadgrep. +This will be looked up on `exec-path' if it isn't an absolute +path to the binary." + :type 'string + :group 'deadgrep) + +(defcustom deadgrep-max-buffers + 4 + "The maximum number of deadgrep results buffers. + +If the number of results buffers exceeds this value, deadgrep +will kill results buffers. The least recently used buffers are +killed first. + +To disable cleanup entirely, set this variable to nil." + :type '(choice + (number :tag "Maximum of buffers allowed") + (const :tag "Disable cleanup" nil)) + :group 'deadgrep) + +(defcustom deadgrep-project-root-function + #'deadgrep--project-root + "Function called by `deadgrep' to work out the root directory +to search from. + +See also `deadgrep-project-root-overrides'." + :type 'function + :group 'deadgrep) + +(defvar deadgrep-project-root-overrides nil + "An alist associating project directories with the desired +search directory. + +This is useful for large repos where you only want to search a +subdirectory. It's also handy for nested repos where you want to +search from the parent. + +This affects the behaviour of `deadgrep--project-root', so this +variable has no effect if you change +`deadgrep-project-root-function'.") + +(defvar deadgrep-history + nil + "A list of the previous search terms.") + +(defvar deadgrep-max-line-length + 500 + "Truncate lines if they are longer than this. + +Emacs performance can be really poor with long lines, so this +ensures that searching minified files does not slow down movement +in results buffers. + +In extreme cases (100KiB+ single-line files), we can get a stack +overflow on our regexp matchers if we don't apply this.") + +(defcustom deadgrep-display-buffer-function + 'switch-to-buffer-other-window + "Function used to show the deadgrep result buffer. + +This function is called with one argument, the results buffer to +display." + :type 'function + :group 'deadgrep) + +(defface deadgrep-meta-face + '((t :inherit font-lock-comment-face)) + "Face used for deadgrep UI text." + :group 'deadgrep) + +(defface deadgrep-filename-face + '((t :inherit bold)) + "Face used for filename headings in results buffers." + :group 'deadgrep) + +(defface deadgrep-search-term-face + '((t :inherit font-lock-variable-name-face)) + "Face used for the search term in results buffers." + :group 'deadgrep) + +(defface deadgrep-regexp-metachar-face + '((t :inherit + ;; TODO: I've seen a more appropriate face in some themes, + ;; find out what to use instead here. + font-lock-constant-face)) + "Face used for regexp metacharacters in search terms." + :group 'deadgrep) + +(defface deadgrep-match-face + '((t :inherit match)) + "Face used for the portion of a line that matches the search term." + :group 'deadgrep) + +(defvar-local deadgrep--search-term nil) +;; Ensure this variable is ignored by `kill-all-local-variables' when +;; switching between `deadgrep-mode' and `deadgrep-edit-mode'. +(put 'deadgrep--search-term 'permanent-local t) + +(defvar-local deadgrep--search-type 'string) +(put 'deadgrep--search-type 'permanent-local t) +(defvar-local deadgrep--search-case 'smart) +(put 'deadgrep--search-case 'permanent-local t) +(defvar-local deadgrep--file-type 'all) +(put 'deadgrep--file-type 'permanent-local t) + +(defvar-local deadgrep--context nil + "When set, also show context of results. +This is stored as a cons cell of integers (lines-before . lines-after).") +(put 'deadgrep--context 'permanent-local t) +(defvar-local deadgrep--initial-filename nil + "The filename of the buffer that deadgrep was started from. +Used to offer better default values for file options.") +(put 'deadgrep--initial-filename 'permanent-local t) + +(defvar-local deadgrep--current-file nil + "The file we're currently inserting results for.") +(defvar-local deadgrep--spinner nil) +(defvar-local deadgrep--remaining-output nil + "We can't guarantee that our process filter will always receive whole lines. +We save the last line here, in case we need to append more text to it.") +(defvar-local deadgrep--postpone-start nil + "If non-nil, don't (re)start searches.") +(defvar-local deadgrep--running nil + "If non-nil, a search is still running.") + +(defvar-local deadgrep--debug-command nil) +(put 'deadgrep--debug-command 'permanent-local t) +(defvar-local deadgrep--debug-first-output nil) +(put 'deadgrep--debug-first-output 'permanent-local t) + +(defvar-local deadgrep--imenu-alist nil + "Alist that stores filename and position for each matched files. +It is used to create `imenu' index.") + +(defconst deadgrep--position-column-width 5) + +(defconst deadgrep--color-code + (rx "\x1b[" (+ digit) "m") + "Regular expression for an ANSI color code.") + +(defvar deadgrep--incremental-active nil) + +(defun deadgrep--insert-output (output &optional finished) + "Propertize OUTPUT from rigrep and write to the current buffer." + ;; If we had an unfinished line from our last call, include that. + (when deadgrep--remaining-output + (setq output (concat deadgrep--remaining-output output)) + (setq deadgrep--remaining-output nil)) + + (let ((inhibit-read-only t) + (lines (s-lines output)) + prev-line-num) + ;; Process filters run asynchronously, and don't guarantee that + ;; OUTPUT ends with a complete line. Save the last line for + ;; later processing. + (unless finished + (setq deadgrep--remaining-output (-last-item lines)) + (setq lines (butlast lines))) + + (save-excursion + (goto-char (point-max)) + (dolist (line lines) + (cond + ;; Ignore blank lines. + ((s-blank? line)) + ;; Lines of just -- are used as a context separator when + ;; calling ripgrep with context flags. + ((string= line "--") + (let ((separator "--")) + ;; Try to make the separator length match the previous + ;; line numbers. + (when prev-line-num + (setq separator + (s-repeat (log prev-line-num 10) "-"))) + (insert + (propertize (concat separator "\n") + 'face 'deadgrep-meta-face + 'deadgrep-separator t)))) + ;; If we have a warning or don't have a color code, ripgrep + ;; must be complaining about something (e.g. zero matches for + ;; a glob, or permission denied on some directories). + ((or + (s-starts-with-p "WARNING: " line) + (not (s-matches-p deadgrep--color-code line))) + (when deadgrep--current-file + (setq deadgrep--current-file nil) + (insert "\n")) + (insert line "\n\n")) + (t + (-let* ((truncate-p (> (length line) deadgrep-max-line-length)) + (line + (if truncate-p + (substring line 0 deadgrep-max-line-length) + line)) + ((filename line-num content) (deadgrep--split-line line)) + (formatted-line-num + (s-pad-right deadgrep--position-column-width " " + (number-to-string line-num))) + (pretty-line-num + (propertize formatted-line-num + 'face 'deadgrep-meta-face + 'deadgrep-filename filename + 'deadgrep-line-number line-num + 'read-only t + 'front-sticky t + 'rear-nonsticky t)) + (pretty-filename + (propertize filename + 'face 'deadgrep-filename-face + 'deadgrep-filename filename + 'read-only t + 'front-sticky t))) + (cond + ;; This is the first file we've seen, print the heading. + ((null deadgrep--current-file) + (push (cons filename (point)) deadgrep--imenu-alist) + (insert pretty-filename "\n")) + ;; This is a new file, print the heading with a spacer. + ((not (equal deadgrep--current-file filename)) + (push (cons filename (1+ (point))) deadgrep--imenu-alist) + (insert "\n" pretty-filename "\n"))) + (setq deadgrep--current-file filename) + + ;; TODO: apply the invisible property if the user decided + ;; to hide this filename before we finished finding + ;; results in it. + (insert pretty-line-num content) + (when truncate-p + (insert + (propertize " ... (truncated)" + 'face 'deadgrep-meta-face))) + (insert "\n") + + (setq prev-line-num line-num)))))))) + +(defcustom deadgrep-finished-hook nil + "Hook run when `deadgrep' search is finished." + :type 'hook + :group 'deadgrep) + +(defun deadgrep--process-sentinel (process output) + "Update the deadgrep buffer associated with PROCESS as complete." + (let ((buffer (process-buffer process)) + (finished-p (string= output "finished\n"))) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (setq deadgrep--running nil) + ;; rg has terminated, so stop the spinner. + (spinner-stop deadgrep--spinner) + + (deadgrep--insert-output "" finished-p) + + ;; Report any errors that occurred. + (unless (member output + (list + "exited abnormally with code 1\n" + "interrupt\n" + "finished\n")) + (save-excursion + (let ((inhibit-read-only t)) + (goto-char (point-max)) + (insert output)))) + + (run-hooks 'deadgrep-finished-hook) + (unless deadgrep--incremental-active + (message "Deadgrep finished")))))) + +(defun deadgrep--process-filter (process output) + ;; Searches may see a lot of output, but it's really useful to have + ;; a snippet of output when debugging. Store the first output received. + (unless deadgrep--debug-first-output + (setq deadgrep--debug-first-output output)) + + ;; If we had an unfinished line from our last call, include that. + (when deadgrep--remaining-output + (setq output (concat deadgrep--remaining-output output)) + (setq deadgrep--remaining-output nil)) + + (when (buffer-live-p (process-buffer process)) + (with-current-buffer (process-buffer process) + (deadgrep--insert-output output)))) + +(defun deadgrep--extract-regexp (pattern s) + "Search for PATTERN in S, and return the content of the first group." + (string-match pattern s) + (match-string 1 s)) + +(defconst deadgrep--filename-regexp + (rx bos "\x1b[0m\x1b[3" (or "5" "6") "m" + (? "./") + (group (+? anything)) + "\x1b[") + "Extracts the filename from a ripgrep line with ANSI color sequences. +We use the color sequences to extract the filename exactly, even +if the path contains colons.") + +(defconst deadgrep--line-num-regexp + (rx "\x1b[32m" (group (+ digit))) + "Extracts the line number from a ripgrep line with ANSI color sequences. +Ripgrep uses a unique color for line numbers, so we use that to +extract the linue number exactly.") + +(defconst deadgrep--line-contents-regexp + (rx "\x1b[32m" (+ digit) "\x1b[0m" (or ":" "-") (group (* anything))) + "Extract the line contents from a ripgrep line with ANSI color sequences. +Use the unique color for line numbers to ensure we start at the +correct colon. + +Note that the text in the group will still contain color codes +highlighting which parts matched the user's search term.") + +(defconst deadgrep--hit-regexp + (rx-to-string + `(seq + ;; A reset color code. + "\x1b[0m" + ;; Two color codes, bold and color (any order). + (regexp ,deadgrep--color-code) + (regexp ,deadgrep--color-code) + ;; The actual text. + (group (+? anything)) + ;; A reset color code again. + "\x1b[0m")) + "Extract the portion of a line found by ripgrep that matches the user's input. +This may occur multiple times in one line.") + +(defun deadgrep--split-line (line) + "Split out the components of a raw LINE of output from rg. +Return the filename, line number, and the line content with ANSI +color codes replaced with string properties." + (list + (deadgrep--extract-regexp deadgrep--filename-regexp line) + (string-to-number + (deadgrep--extract-regexp deadgrep--line-num-regexp line)) + (deadgrep--propertize-hits + (deadgrep--extract-regexp deadgrep--line-contents-regexp line)))) + +(defun deadgrep--escape-backslash (s) + "Escape occurrences of backslashes in S. + +This differs from `regexp-quote', which outputs a regexp pattern. +Instead, we provide a string suitable for REP in +`replace-regexp-in-string'." + (s-replace "\\" "\\\\" s)) + +(defun deadgrep--propertize-hits (line-contents) + "Given LINE-CONTENTS from ripgrep, replace ANSI color codes +with a text face property `deadgrep-match-face'." + (replace-regexp-in-string + deadgrep--hit-regexp + (lambda (s) + (propertize + (deadgrep--escape-backslash (match-string 1 s)) + 'face 'deadgrep-match-face)) + line-contents)) + +(define-button-type 'deadgrep-search-term + 'action #'deadgrep--search-term + 'help-echo "Change search term") + +(defun deadgrep--search-prompt (&optional default) + "The prompt shown to the user when starting a deadgrep search." + (let ((kind (if (eq deadgrep--search-type 'regexp) + "by regexp" "for text"))) + (if default + (format "Search %s (default %s): " kind default) + (format "Search %s: " kind)))) + +(defun deadgrep--search-term (_button) + (deadgrep-search-term)) + +(defun deadgrep-search-term () + "Change the current search term and restart the search." + (interactive) + (setq deadgrep--search-term + (read-from-minibuffer + (deadgrep--search-prompt) + deadgrep--search-term)) + (rename-buffer + (deadgrep--buffer-name deadgrep--search-term default-directory) t) + (deadgrep-restart)) + +(define-button-type 'deadgrep-type + 'action #'deadgrep--search-type + 'search-type nil + 'help-echo "Change search type") + +(defun deadgrep--search-type (button) + (setq deadgrep--search-type (button-get button 'search-type)) + (deadgrep-restart)) + +(define-button-type 'deadgrep-case + 'action #'deadgrep--case + 'case nil + 'help-echo "Change case sensitivity") + +(defun deadgrep--case (button) + (setq deadgrep--search-case (button-get button 'case)) + (deadgrep-restart)) + +(define-button-type 'deadgrep-context + 'action #'deadgrep--context + 'context nil + 'help-echo "Show/hide context around match") + +(defun deadgrep--context (button) + ;; deadgrep--context takes the value of (before . after) when set. + (setq deadgrep--context + (cl-case (button-get button 'context) + ((nil) + nil) + (before + (cons + (read-number "Show N lines before: ") + (or (cdr-safe deadgrep--context) 0))) + (after + (cons + (or (car-safe deadgrep--context) 0) + (read-number "Show N lines after: "))) + (t + (error "Unknown context type")))) + + (deadgrep-restart)) + +(defun deadgrep--type-list () + "Query the rg executable for available file types." + (let* ((output (with-output-to-string + (with-current-buffer standard-output + (process-file-shell-command + (format "%s --type-list" deadgrep-executable) + nil '(t nil))))) + (lines (s-lines (s-trim output))) + (types-and-globs + (--map + (s-split (rx ": ") it) + lines))) + (-map + (-lambda ((type globs)) + (list type (s-split (rx ", ") globs))) + types-and-globs))) + +(define-button-type 'deadgrep-file-type + 'action #'deadgrep--file-type + 'case nil + 'help-echo "Change file type") + +(defun deadgrep--format-file-type (file-type extensions) + (let* ((max-exts 4) + (truncated (> (length extensions) max-exts))) + (when truncated + (setq extensions + (append (-take max-exts extensions) + (list "...")))) + (format "%s (%s)" + file-type + (s-join ", " extensions)))) + +(defun deadgrep--glob-regexp (glob) + "Convert GLOB pattern to the equivalent elisp regexp." + (let* ((i 0) + (result "^")) + (while (< i (length glob)) + (let* ((char (elt glob i))) + (cond + ;; . matches a literal . in globs. + ((eq char ?.) + (setq result (concat result "\\.")) + (cl-incf i)) + ;; ? matches a single char in globs. + ((eq char ??) + (setq result (concat result ".")) + (cl-incf i)) + ;; * matches zero or more of anything. + ((eq char ?*) + (setq result (concat result ".*")) + (cl-incf i)) + ;; [ab] matches a literal a or b. + ;; [a-z] matches characters between a and z inclusive. + ;; [?] matches a literal ?. + ((eq char ?\[) + ;; Find the matching ]. + (let ((j (1+ i))) + (while (and (< j (length glob)) + (not (eq (elt glob j) ?\]))) + (cl-incf j)) + (cl-incf j) + (setq result (concat result + (substring glob i j))) + (setq i j))) + (t + (setq result (concat result (char-to-string char))) + (cl-incf i))))) + (concat result "$"))) + +(defun deadgrep--matches-globs-p (filename globs) + "Return non-nil if FILENAME matches any glob pattern in GLOBS." + (when filename + (--any (string-match-p (deadgrep--glob-regexp it) filename) + globs))) + +(defun deadgrep--relevant-file-type (filename types-and-globs) + "Try to find the most relevant item in TYPES-AND-GLOBS for FILENAME." + (let (;; Find all the items in TYPES-AND-GLOBS whose glob match + ;; FILENAME. + (matching (-filter (-lambda ((_type globs)) + (deadgrep--matches-globs-p filename globs)) + types-and-globs))) + (->> matching + ;; Prefer longer names, so "markdown" over "md" for the type + ;; name. + (-sort (-lambda ((type1 _) (type2 _)) + (< (length type1) (length type2)))) + ;; Prefer types with more extensions, as they tend to be more + ;; common languages (e.g. 'ocaml' over 'ml'). + (-sort (-lambda ((_ globs1) (_ globs2)) + (< (length globs1) (length globs2)))) + ;; But prefer elisp over lisp for .el files. + (-sort (-lambda ((type1 _) (type2 _)) + ;; Return t if we're comparing elisp with lisp, nil + ;; otherwise. + (and (equal type1 "lisp") + (equal type2 "elisp")))) + ;; Take the highest scoring matching. + (-last-item)))) + +(defun deadgrep--read-file-type (filename) + "Read a ripgrep file type, defaulting to the type that matches FILENAME." + (let* (;; Get the list of types we can offer. + (types-and-globs (deadgrep--type-list)) + ;; Build a list mapping the formatted types to the type name. + (type-choices + (-map + (-lambda ((type globs)) + (list + (deadgrep--format-file-type type globs) + type)) + types-and-globs)) + ;; Work out the default type name based on the filename. + (default-type-and-globs + (deadgrep--relevant-file-type filename types-and-globs)) + (default + (-when-let ((default-type default-globs) default-type-and-globs) + (deadgrep--format-file-type default-type default-globs))) + ;; Prompt the user for a file type. + (chosen + (completing-read + "File type: " type-choices nil t nil nil default))) + (nth 1 (assoc chosen type-choices)))) + +(defun deadgrep--read-file-glob () + (let* + ((initial-value + (cond + ;; If we already have a glob pattern, edit it. + ((eq (car-safe deadgrep--file-type) 'glob) + (cdr deadgrep--file-type)) + ;; If the initial file had a file name of the form + ;; foo.bar, offer *.bar as the initial glob. + ((and deadgrep--initial-filename + (file-name-extension deadgrep--initial-filename)) + (format "*.%s" + (file-name-extension deadgrep--initial-filename))) + (t + "*"))) + (prompt + (if (string= initial-value "*") + ;; Show an example to avoid confusion with regexp syntax. + "Glob (e.g. *.js): " + "Glob: ")) + (glob + (read-from-minibuffer + prompt + initial-value))) + glob)) + +(defun deadgrep--file-type (button) + (let ((button-type (button-get button 'file-type))) + (cond + ((eq button-type 'all) + (setq deadgrep--file-type 'all)) + ((eq button-type 'type) + (setq deadgrep--file-type + (cons 'type (deadgrep--read-file-type deadgrep--initial-filename)))) + ((eq button-type 'glob) + (setq deadgrep--file-type (cons 'glob (deadgrep--read-file-glob)))) + (t + (error "Unknown button type: %S" button-type)))) + (deadgrep-restart)) + +(define-button-type 'deadgrep-directory + 'action #'deadgrep--directory + 'help-echo "Change base directory") + +(defun deadgrep--directory (_button) + (deadgrep-directory)) + +(defun deadgrep-directory () + "Prompt the user for a new search directory, then restart the search." + (interactive) + (setq default-directory + (expand-file-name + (read-directory-name "Search files in: "))) + (rename-buffer + (deadgrep--buffer-name deadgrep--search-term default-directory) + t) + (deadgrep-restart)) + +(defun deadgrep-parent-directory () + "Restart the search in the parent directory." + (interactive) + (setq default-directory + (file-name-directory (directory-file-name default-directory))) + (rename-buffer + (deadgrep--buffer-name deadgrep--search-term default-directory) + t) + (deadgrep-restart)) + +(defun deadgrep--button (text type &rest properties) + ;; `make-text-button' mutates the string to add properties, so copy + ;; TEXT first. + (setq text (substring-no-properties text)) + (apply #'make-text-button text nil :type type properties)) + +(defun deadgrep--arguments (search-term search-type case context) + "Return a list of command line arguments that we can execute in a shell +to obtain ripgrep results." + (let (args) + (push "--color=ansi" args) + (push "--line-number" args) + (push "--no-heading" args) + (push "--no-column" args) + (push "--with-filename" args) + (push "--no-config" args) + + (cond + ((eq search-type 'string) + (push "--fixed-strings" args)) + ((eq search-type 'words) + (push "--fixed-strings" args) + (push "--word-regexp" args)) + ((eq search-type 'regexp)) + (t + (error "Unknown search type: %s" search-type))) + + (cond + ((eq case 'smart) + (push "--smart-case" args)) + ((eq case 'sensitive) + (push "--case-sensitive" args)) + ((eq case 'ignore) + (push "--ignore-case" args)) + (t + (error "Unknown case: %s" case))) + + (cond + ((eq deadgrep--file-type 'all)) + ((eq (car-safe deadgrep--file-type) 'type) + (push (format "--type=%s" (cdr deadgrep--file-type)) args)) + ((eq (car-safe deadgrep--file-type) 'glob) + (push (format "--type-add=custom:%s" (cdr deadgrep--file-type)) args) + (push "--type=custom" args)) + (t + (error "Unknown file-type: %S" deadgrep--file-type))) + + (when context + (push (format "--before-context=%s" (car context)) args) + (push (format "--after-context=%s" (cdr context)) args)) + + (push "--" args) + (push search-term args) + (push "." args) + + (nreverse args))) + +(defun deadgrep--write-heading () + "Write the deadgrep heading with buttons reflecting the current +search settings." + (let ((start-pos (point)) + (inhibit-read-only t)) + (insert (propertize "Search term: " + 'face 'deadgrep-meta-face) + (if (eq deadgrep--search-type 'regexp) + (deadgrep--propertize-regexp deadgrep--search-term) + (propertize + deadgrep--search-term + 'face 'deadgrep-search-term-face)) + " " + (deadgrep--button "change" 'deadgrep-search-term) + "\n" + (propertize "Search type: " + 'face 'deadgrep-meta-face) + + (if (eq deadgrep--search-type 'string) + "string" + (deadgrep--button "string" 'deadgrep-type + 'search-type 'string)) + " " + (if (eq deadgrep--search-type 'words) + "words" + (deadgrep--button "words" 'deadgrep-type + 'search-type 'words)) + " " + (if (eq deadgrep--search-type 'regexp) + "regexp" + (deadgrep--button "regexp" 'deadgrep-type + 'search-type 'regexp)) + "\n" + (propertize "Case: " + 'face 'deadgrep-meta-face) + (if (eq deadgrep--search-case 'smart) + "smart" + (deadgrep--button "smart" 'deadgrep-case + 'case 'smart)) + " " + (if (eq deadgrep--search-case 'sensitive) + "sensitive" + (deadgrep--button "sensitive" 'deadgrep-case + 'case 'sensitive)) + " " + (if (eq deadgrep--search-case 'ignore) + "ignore" + (deadgrep--button "ignore" 'deadgrep-case + 'case 'ignore)) + "\n" + (propertize "Context: " + 'face 'deadgrep-meta-face) + (if deadgrep--context + (deadgrep--button "none" 'deadgrep-context + 'context nil) + "none") + " " + (deadgrep--button "before" 'deadgrep-context + 'context 'before) + (if deadgrep--context + (format ":%d" (car deadgrep--context)) + "") + " " + (deadgrep--button "after" 'deadgrep-context + 'context 'after) + (if deadgrep--context + (format ":%d" (cdr deadgrep--context)) + "") + + "\n\n" + (propertize "Directory: " + 'face 'deadgrep-meta-face) + (deadgrep--button + (abbreviate-file-name default-directory) + 'deadgrep-directory) + (if (get-text-property 0 'deadgrep-overridden default-directory) + (propertize " (from override)" 'face 'deadgrep-meta-face) + "") + "\n" + (propertize "Files: " + 'face 'deadgrep-meta-face) + (if (eq deadgrep--file-type 'all) + "all" + (deadgrep--button "all" 'deadgrep-file-type + 'file-type 'all)) + " " + (deadgrep--button "type" 'deadgrep-file-type + 'file-type 'type) + (if (eq (car-safe deadgrep--file-type) 'type) + (format ":%s" (cdr deadgrep--file-type)) + "") + " " + (deadgrep--button "glob" 'deadgrep-file-type + 'file-type 'glob) + (if (eq (car-safe deadgrep--file-type) 'glob) + (format ":%s" (cdr deadgrep--file-type)) + "") + "\n\n") + (put-text-property + start-pos (point) + 'read-only t) + (put-text-property + start-pos (point) + 'front-sticky t))) + +;; TODO: could we do this in the minibuffer too? +(defun deadgrep--propertize-regexp (regexp) + "Given a string REGEXP representing a search term with regular +expression syntax, highlight the metacharacters. +Returns a copy of REGEXP with properties set." + (setq regexp (copy-sequence regexp)) + + ;; See https://docs.rs/regex/1.0.0/regex/#syntax + (let ((metachars + ;; Characters that don't match themselves. + '(?\( ?\) ?\[ ?\] ?\{ ?\} ?| ?. ?+ ?* ?? ?^ ?$)) + ;; Characters that have special regexp meaning when preceded + ;; with a backslash. This includes things like \b but not + ;; things like \n. + (escape-metachars + '(?A ?b ?B ?d ?D ?p ?s ?S ?w ?W ?z)) + (prev-char nil)) + ;; Put the standard search term face on every character + ;; individually. + (dotimes (i (length regexp)) + (put-text-property + i (1+ i) + 'face 'deadgrep-search-term-face + regexp)) + ;; Put the metacharacter face on any character that isn't treated + ;; literally. + (--each-indexed (string-to-list regexp) + (cond + ;; Highlight everything between { and }. + ((and (eq it ?\{) (not (equal prev-char ?\\))) + (let ((closing-pos it-index)) + ;; TODO: we have loops like this in several places, factor + ;; out. + (while (and (< closing-pos (length regexp)) + (not (eq (elt regexp closing-pos) + ?\}))) + (cl-incf closing-pos)) + ;; Step over the closing }, if we found one. + (unless (= closing-pos (length regexp)) + (cl-incf closing-pos)) + (put-text-property + it-index closing-pos + 'face + 'deadgrep-regexp-metachar-face + regexp))) + ;; Highlight individual metachars. + ((and (memq it metachars) (not (equal prev-char ?\\))) + (put-text-property + it-index (1+ it-index) + 'face + 'deadgrep-regexp-metachar-face + regexp)) + ((and (memq it escape-metachars) (equal prev-char ?\\)) + (put-text-property + (1- it-index) (1+ it-index) + 'face 'deadgrep-regexp-metachar-face + regexp))) + + (setq prev-char it))) + regexp) + +(defun deadgrep--buffer-name (search-term directory) + (format "*deadgrep %s %s*" + (s-truncate 30 search-term) + (abbreviate-file-name directory))) + +(defun deadgrep--buffers () + "All the current deadgrep results buffers. +Returns a list ordered by the most recently accessed." + (--filter (with-current-buffer it + (eq major-mode 'deadgrep-mode)) + ;; `buffer-list' seems to be ordered by most recently + ;; visited first. + (buffer-list))) + +(defun deadgrep--buffer (search-term directory initial-filename) + "Create and initialise a search results buffer." + (let* ((buf-name (deadgrep--buffer-name search-term directory)) + (buf (get-buffer buf-name))) + (if buf + ;; There was already a buffer with this name. Reset its search + ;; state. + (with-current-buffer buf + (deadgrep--stop-and-reset)) + ;; We need to create the buffer, ensure we don't exceed + ;; `deadgrep-max-buffers' by killing the least recently used. + (progn + (when (numberp deadgrep-max-buffers) + (let* ((excess-buffers (-drop (1- deadgrep-max-buffers) + (deadgrep--buffers)))) + ;; Kill buffers so we have one buffer less than the maximum + ;; before we create a new one. + (-each excess-buffers #'kill-buffer))) + + (setq buf (get-buffer-create buf-name)))) + + (with-current-buffer buf + (setq default-directory directory) + (let ((inhibit-read-only t)) + ;; This needs to happen first, as it clobbers all buffer-local + ;; variables. + (deadgrep-mode) + (erase-buffer) + + (setq deadgrep--search-term search-term) + (setq deadgrep--current-file nil) + (setq deadgrep--initial-filename initial-filename)) + (setq buffer-read-only t)) + buf)) + +(defun deadgrep-cycle-files () + "Cycle which files are searched (all / type / glob) and restart the search." + (interactive) + (cond + ((eq deadgrep--file-type 'all) + (setq deadgrep--file-type + (cons 'type (deadgrep--read-file-type deadgrep--initial-filename)))) + ((eq (car-safe deadgrep--file-type) 'type) + (setq deadgrep--file-type (cons 'glob (deadgrep--read-file-glob)))) + ((eq (car-safe deadgrep--file-type) 'glob) + (setq deadgrep--file-type 'all))) + (deadgrep-restart)) + +(defun deadgrep-cycle-search-type () + "Cycle the search type (string / words / regexp) and restart the search." + (interactive) + (cond + ((eq deadgrep--search-type 'string) (setq deadgrep--search-type 'words)) + ((eq deadgrep--search-type 'words) (setq deadgrep--search-type 'regexp)) + ((eq deadgrep--search-type 'regexp) (setq deadgrep--search-type 'string))) + (deadgrep-restart)) + +(defun deadgrep-cycle-search-case () + "Cycle the search case (smart / sensitive / ignore) and restart the search." + (interactive) + (cond + ((eq deadgrep--search-case 'smart) (setq deadgrep--search-case 'sensitive)) + ((eq deadgrep--search-case 'sensitive) (setq deadgrep--search-case 'ignore)) + ((eq deadgrep--search-case 'ignore) (setq deadgrep--search-case 'smart))) + (deadgrep-restart)) + +(defvar deadgrep-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") #'deadgrep-visit-result) + (define-key map (kbd "o") #'deadgrep-visit-result-other-window) + ;; TODO: we should still be able to click on buttons. + + (define-key map (kbd "S") #'deadgrep-search-term) + (define-key map (kbd "T") #'deadgrep-cycle-search-type) + (define-key map (kbd "C") #'deadgrep-cycle-search-case) + (define-key map (kbd "F") #'deadgrep-cycle-files) + (define-key map (kbd "D") #'deadgrep-directory) + (define-key map (kbd "^") #'deadgrep-parent-directory) + (define-key map (kbd "g") #'deadgrep-restart) + (define-key map (kbd "I") #'deadgrep-incremental) + + ;; TODO: this should work when point is anywhere in the file, not + ;; just on its heading. + (define-key map (kbd "TAB") #'deadgrep-toggle-file-results) + + ;; Keybinding chosen to match `kill-compilation'. + (define-key map (kbd "C-c C-k") #'deadgrep-kill-process) + + (define-key map (kbd "n") #'deadgrep-forward-match) + (define-key map (kbd "p") #'deadgrep-backward-match) + (define-key map (kbd "M-n") #'deadgrep-forward-filename) + (define-key map (kbd "M-p") #'deadgrep-backward-filename) + + map) + "Keymap for `deadgrep-mode'.") + +(defvar deadgrep-edit-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") #'deadgrep-visit-result) + map) + "Keymap for `deadgrep-edit-mode'.") + +(define-derived-mode deadgrep-mode special-mode + '("Deadgrep" (:eval (spinner-print deadgrep--spinner))) + "Major mode for deadgrep results buffers." + (remove-hook 'after-change-functions #'deadgrep--propagate-change t)) + +(defun deadgrep--find-file (path) + "Open PATH in a buffer, and return a cons cell +\(BUF . OPENED). OPENED is nil if there was already a buffer for +this path." + (let* ((initial-buffers (buffer-list)) + (opened nil) + ;; Skip running find-file-hook since it may prompt the user. + (find-file-hook nil) + ;; If we end up opening a buffer, don't bother with file + ;; variables. It prompts the user, and we discard the buffer + ;; afterwards anyway. + (enable-local-variables nil) + ;; Bind `auto-mode-alist' to nil, so we open the buffer in + ;; `fundamental-mode' if it isn't already open. + (auto-mode-alist nil) + ;; Use `find-file-noselect' so we still decode bytes from the + ;; underlying file. + (buf (find-file-noselect path))) + (unless (-contains-p initial-buffers buf) + (setq opened t)) + (cons buf opened))) + +(defun deadgrep--propagate-change (beg end length) + "Repeat the last modification to the results buffer in the +underlying file." + ;; We should never be called outside an edit buffer, but be + ;; defensive. Buggy functions in change hooks are painful. + (when (eq major-mode 'deadgrep-edit-mode) + (save-mark-and-excursion + (goto-char beg) + (-let* ((column (+ (deadgrep--current-column) length)) + (filename (deadgrep--filename)) + (line-number (deadgrep--line-number)) + ((buf . opened) (deadgrep--find-file filename)) + (inserted (buffer-substring beg end))) + (with-current-buffer buf + (save-mark-and-excursion + (save-restriction + (widen) + (goto-char + (deadgrep--buffer-position line-number column)) +<<<<<<< Updated upstream + (delete-char (- length)) + (insert inserted))) +||||||| Stash base + (if (> length 0) + ;; We removed chars in the results buffer, so remove. + (delete-char (- length)) + ;; We inserted something, so insert the same chars. + (insert inserted)))) +======= + (if (> length 0) + ;; We removed chars in the results buffer, so remove. + (delete-char (- length)) + ;; We inserted something, so insert the same chars. + ;; BUG: errors when file is freshly opened. + ) + (insert inserted))) +>>>>>>> Stashed changes + ;; If we weren't visiting this file before, just save it and + ;; close it. + (when opened + (basic-save-buffer) + (kill-buffer buf))))))) + +(defcustom deadgrep-edit-mode-hook nil + "Called after `deadgrep-edit-mode' is turned on." + :type 'hook + :group 'deadgrep) + +(defun deadgrep-edit-mode () + "Major mode for editing the results files directly from a +deadgrep results buffer. + +\\{deadgrep-edit-mode-map}" + (interactive) + (unless (eq major-mode 'deadgrep-mode) + (user-error "deadgrep-edit-mode only works in deadgrep result buffers")) + (when deadgrep--running + (user-error "Can't edit a results buffer until the search is finished")) + ;; We deliberately don't use `define-derived-mode' here because we + ;; want to check the previous value of `major-mode'. Initialise the + ;; major mode manually. + (delay-mode-hooks + (kill-all-local-variables) + (setq major-mode 'deadgrep-edit-mode) + (setq mode-name + '(:propertize "Deadgrep:Edit" face mode-line-emphasis)) + (use-local-map deadgrep-edit-mode-map) + ;; Done major mode manual initialise (copied from `define-derived-mode'). + + ;; Allow editing, and propagate changes. + (setq buffer-read-only nil) + (add-hook 'after-change-functions #'deadgrep--propagate-change nil t) + + (message "Now editing, use `M-x deadgrep-mode' when finished")) + + (run-mode-hooks 'deadgrep-edit-mode-hook)) + +(defun deadgrep--current-column () + "Get the current column position in char terms. +This treats tabs as 1 and ignores the line numbers in the results +buffer." + (let* ((line-start (line-beginning-position)) + (line-number + (get-text-property line-start 'deadgrep-line-number)) + (line-number-width + (max deadgrep--position-column-width + (length (number-to-string line-number)))) + (char-count 0)) + (save-excursion + (while (not (equal (point) line-start)) + (cl-incf char-count) + (backward-char 1))) + (max + (- char-count line-number-width) + 0))) + +(defun deadgrep--flash-column-offsets (start end) + "Temporarily highlight column offset from START to END." + (let* ((line-start (line-beginning-position)) + (overlay (make-overlay + (+ line-start start) + (+ line-start end)))) + (overlay-put overlay 'face 'highlight) + (run-with-timer 1.0 nil 'delete-overlay overlay))) + +(defun deadgrep--match-face-p (pos) + "Is there a match face at POS?" + (eq (get-text-property pos 'face) 'deadgrep-match-face)) + +(defun deadgrep--match-positions () + "Return a list of indexes of the current line's matches." + (let (positions) + (save-excursion + (beginning-of-line) + + (let* ((line-number + (get-text-property (point) 'deadgrep-line-number)) + (line-number-width + (max deadgrep--position-column-width + (length (number-to-string line-number)))) + (i 0) + (start-pos 0) + (line-end-pos (line-end-position))) + + (forward-char line-number-width) + + (while (<= (point) line-end-pos) + ;; If we've just entered a match, record the start position. + (when (and (deadgrep--match-face-p (point)) + (not (deadgrep--match-face-p (1- (point))))) + (setq start-pos i)) + ;; If we've just left a match, record the match range. + (when (and (not (deadgrep--match-face-p (point))) + (deadgrep--match-face-p (1- (point)))) + (push (list start-pos i) positions)) + + (setq i (1+ i)) + (forward-char 1)))) + + (nreverse positions))) + +(defun deadgrep--buffer-position (line-number column-offset) + "Return the position equivalent to LINE-NUMBER at COLUMN-OFFSET +in the current buffer." + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (forward-line (1- line-number)) + (forward-char column-offset) + + (point)))) + +(defun deadgrep--filename (&optional pos) + "Get the filename of the result at point POS. +If POS is nil, use the beginning position of the current line." + (get-text-property (or pos (line-beginning-position)) 'deadgrep-filename)) + +(defun deadgrep--line-number () + "Get the filename of the result at point." + (get-text-property (line-beginning-position) 'deadgrep-line-number)) + +(defun deadgrep--visit-result (open-fn) + "Goto the search result at point." + (interactive) + (let* ((pos (line-beginning-position)) + (file-name (deadgrep--filename)) + (line-number (deadgrep--line-number)) + (column-offset (when line-number (deadgrep--current-column))) + (match-positions (when line-number (deadgrep--match-positions)))) + (when file-name + (when overlay-arrow-position + (set-marker overlay-arrow-position nil)) + ;; Show an arrow next to the last result viewed. This is + ;; consistent with `compilation-next-error-function' and also + ;; useful with `deadgrep-visit-result-other-window'. + (setq overlay-arrow-position (copy-marker pos)) + (setq next-error-last-buffer (current-buffer)) + + (funcall open-fn file-name) + (goto-char (point-min)) + + (when line-number + (-let [destination-pos (deadgrep--buffer-position + line-number column-offset)] + ;; Put point on the position of the match, widening the + ;; buffer if necessary. + (when (or (< destination-pos (point-min)) + (> destination-pos (point-max))) + (widen)) + (goto-char destination-pos) + + ;; Temporarily highlight the parts of the line that matched + ;; the search term. + (-each match-positions + (-lambda ((start end)) + (deadgrep--flash-column-offsets start end)))))))) + +(defun deadgrep-visit-result-other-window () + "Goto the search result at point, opening in another window." + (interactive) + (deadgrep--visit-result #'find-file-other-window)) + +(defun deadgrep-visit-result () + "Goto the search result at point." + (interactive) + (deadgrep--visit-result #'find-file)) + +(defvar-local deadgrep--hidden-files nil + "An alist recording which files currently have their lines +hidden in this deadgrep results buffer. + +Keys are interned filenames, so they compare with `eq'.") + +(defun deadgrep-toggle-file-results () + "Show/hide the results of the file at point." + (interactive) + (let* ((file-name (deadgrep--filename)) + (line-number (deadgrep--line-number))) + (when (and file-name (not line-number)) + ;; We're on a file heading. + (if (alist-get (intern file-name) deadgrep--hidden-files) + (deadgrep--show) + (deadgrep--hide))))) + +(defun deadgrep--show () + (-let* ((file-name (deadgrep--filename)) + ((start-pos end-pos) (alist-get (intern file-name) deadgrep--hidden-files))) + (remove-overlays start-pos end-pos 'invisible t) + (setf (alist-get (intern file-name) deadgrep--hidden-files) + nil))) + +(defun deadgrep--hide () + "Hide the file results immediately after point." + (save-excursion + (let* ((file-name (deadgrep--filename)) + (start-pos + (progn + (forward-line) + (point))) + (end-pos + (progn + (while (and + (or (get-text-property (point) 'deadgrep-line-number) + (get-text-property (point) 'deadgrep-separator)) + (not (bobp))) + (forward-line)) + ;; Step over the newline. + (1+ (point)))) + (o (make-overlay start-pos end-pos))) + (overlay-put o 'invisible t) + (setf (alist-get (intern file-name) deadgrep--hidden-files) + (list start-pos end-pos))))) + +(defun deadgrep--interrupt-process () + "Gracefully stop the rg process, synchronously." + (-when-let (proc (get-buffer-process (current-buffer))) + ;; Ensure that our process filter is not called again. + (set-process-filter proc #'ignore) + + (interrupt-process proc) + ;; Wait for the process to terminate, so we know that + ;; `deadgrep--process-sentinel' has been called. + (while (process-live-p proc) + ;; `redisplay' can trigger process filters or sentinels. + (redisplay) + (sleep-for 0.1)))) + +(defun deadgrep-kill-process () + "Kill the deadgrep process associated with the current buffer." + (interactive) + (if (get-buffer-process (current-buffer)) + (deadgrep--interrupt-process) + (message "No process running."))) + +(defun deadgrep--item-p (pos) + "Is there something at POS that we can interact with?" + (or (button-at pos) + (deadgrep--filename pos))) + +(defun deadgrep--filename-p (pos) + "Is there a filename at POS that we can interact with?" + (eq (get-text-property pos 'face) 'deadgrep-filename-face)) + +(defun deadgrep--move (forward-p) + "Move to the next item. +This will either be a button, a filename, or a search result." + (interactive) + (let ((pos (point))) + ;; If point is initially on an item, move past it. + (while (and (deadgrep--item-p pos) + (if forward-p + (< pos (point-max)) + (> pos (point-min)))) + (if forward-p + (cl-incf pos) + (cl-decf pos))) + ;; Find the next item. + (while (and (not (deadgrep--item-p pos)) + (if forward-p + (< pos (point-max)) + (> pos (point-min)))) + (if forward-p + (cl-incf pos) + (cl-decf pos))) + ;; Regardless of direction, ensure point is at the beginning of + ;; the item. + (while (and (if forward-p + (< pos (point-max)) + (> pos (point-min))) + (deadgrep--item-p (1- pos))) + (cl-decf pos)) + ;; If we reached an item (we aren't at the first/last item), then + ;; go to it. + (when (deadgrep--item-p pos) + (goto-char pos)))) + +(defun deadgrep-forward () + "Move forward to the next item. +This will either be a button, a filename, or a search result. See +also `deadgrep-forward-match'." + (interactive) + (deadgrep--move t)) + +(defun deadgrep-backward () + "Move backward to the previous item. +This will either be a button, a filename, or a search result. See +also `deadgrep-backward-match'." + (interactive) + (deadgrep--move nil)) + +(defun deadgrep-forward-filename () + "Move forward to the next filename." + (interactive) + (deadgrep--move-match t 'deadgrep-filename-face)) + +(defun deadgrep-backward-filename () + "Move backward to the previous filename." + (interactive) + (deadgrep--move-match nil 'deadgrep-filename-face)) + +(defun deadgrep--move-match (forward-p face) + "Move point to the beginning of the next/previous match." + (interactive) + (let ((start-pos (point))) + ;; Move over the current match, if we were already on one. + (while (eq (get-text-property (point) 'face) + face) + (if forward-p (forward-char) (backward-char))) + (condition-case nil + (progn + ;; Move point to the next match, which may be on the same line. + (while (not (eq (get-text-property (point) 'face) + face)) + (if forward-p (forward-char) (backward-char))) + ;; Ensure point is at the beginning of the match. + (unless forward-p + (while (eq (get-text-property (point) 'face) + face) + (backward-char)) + (forward-char))) + ;; Don't move point beyond the last match. However, it's still + ;; useful to signal that we're at the end, so users can use this + ;; command with macros and terminate when it's done. + (beginning-of-buffer + (goto-char start-pos) + (signal 'beginning-of-buffer nil)) + (end-of-buffer + (goto-char start-pos) + (signal 'end-of-buffer nil))))) + +(defun deadgrep-forward-match () + "Move point forward to the beginning of next match. +Note that a result line may contain more than one match, or zero +matches (if the result line has been truncated)." + (interactive) + (deadgrep--move-match t 'deadgrep-match-face)) + +(defun deadgrep-backward-match () + "Move point backward to the beginning of previous match." + (interactive) + (deadgrep--move-match nil 'deadgrep-match-face)) + +(defun deadgrep--start (search-term search-type case) + "Start a ripgrep search." + (setq deadgrep--spinner (spinner-create 'progress-bar t)) + (setq deadgrep--running t) + (spinner-start deadgrep--spinner) + (let* ((args (deadgrep--arguments + search-term search-type case + deadgrep--context)) + (process + (apply #'start-file-process + (format "rg %s" search-term) + (current-buffer) + deadgrep-executable + args))) + (setq deadgrep--debug-command + (format "%s %s" deadgrep-executable (s-join " " args))) + (set-process-filter process #'deadgrep--process-filter) + (set-process-sentinel process #'deadgrep--process-sentinel))) + +(defun deadgrep--stop-and-reset () + "Terminate the current search and reset any search state." + ;; Stop the old search, so we don't carry on inserting results from + ;; the last thing we searched for. + (deadgrep--interrupt-process) + + (let ((inhibit-read-only t)) + ;; Reset UI: remove results, reset items hidden by TAB, and arrow + ;; position. + (erase-buffer) + (setq deadgrep--hidden-files nil) + (when overlay-arrow-position + (set-marker overlay-arrow-position nil)) + + ;; Reset intermediate search state. + (setq deadgrep--current-file nil) + (setq deadgrep--spinner nil) + (setq deadgrep--remaining-output nil) + (setq deadgrep--current-file nil) + (setq deadgrep--debug-first-output nil) + (setq deadgrep--imenu-alist nil))) + +(defun deadgrep-restart () + "Re-run ripgrep with the current search settings." + (interactive) + ;; If we haven't started yet, start the search if we've been called + ;; by the user. + (when (and deadgrep--postpone-start + (called-interactively-p 'interactive)) + (setq deadgrep--postpone-start nil)) + + (deadgrep--stop-and-reset) + + (let ((start-point (point)) + (inhibit-read-only t)) + (deadgrep--write-heading) + ;; If the point was in the heading, ensure that we restore its + ;; position. + (goto-char (min (point-max) start-point)) + + (if deadgrep--postpone-start + (deadgrep--write-postponed) + (deadgrep--start + deadgrep--search-term + deadgrep--search-type + deadgrep--search-case)))) + +(defun deadgrep--read-search-term () + "Read a search term from the minibuffer. +If region is active, return that immediately. Otherwise, prompt +for a string, offering the current word as a default." + (let (search-term) + (if (use-region-p) + (progn + (setq search-term + (buffer-substring-no-properties (region-beginning) (region-end))) + (deactivate-mark)) + (let* ((sym (symbol-at-point)) + (sym-name (when sym + (substring-no-properties (symbol-name sym)))) + ;; TODO: prompt should say search string or search regexp + ;; as appropriate. + (prompt + (deadgrep--search-prompt sym-name))) + (setq search-term + (read-from-minibuffer + prompt nil nil nil 'deadgrep-history sym-name)) + (when (equal search-term "") + (setq search-term sym-name)))) + (unless (equal (car deadgrep-history) search-term) + (push search-term deadgrep-history)) + search-term)) + +(defun deadgrep-incremental () + (interactive) + (catch 'break + (let ((deadgrep--incremental-active t) + (search-term (or deadgrep--search-term ""))) + (while t + (let ((next-char + (read-char + ;; TODO: Use the same prompt format as other search options. + (format "%s %s" + (apply #'propertize "Incremental Search (RET when done):" minibuffer-prompt-properties) + search-term)))) + (cond + ((eq next-char ?\C-m) + (throw 'break nil)) + ((eq next-char ?\C-?) + (setq search-term (s-left -1 search-term))) + (t + (setq search-term (concat search-term (list next-char)))))) + (when (> (length search-term) 2) + (setq deadgrep--search-term search-term) + (deadgrep-restart)))))) + + +(defun deadgrep--normalise-dirname (path) + "Expand PATH and ensure that it doesn't end with a slash. +If PATH is remote path, it is not expanded." + (directory-file-name (if (file-remote-p path) + path + (let (file-name-handler-alist) + (expand-file-name path))))) + +(defun deadgrep--lookup-override (path) + "If PATH is present in `deadgrep-project-root-overrides', +return the overridden value. +Otherwise, return PATH as is." + (let* ((normalised-path (deadgrep--normalise-dirname path)) + (override + (-first + (-lambda ((original . _)) + (equal (deadgrep--normalise-dirname original) normalised-path)) + deadgrep-project-root-overrides))) + (when override + (setq path (cdr override)) + (unless (stringp path) + (user-error "Bad override: expected a path string, but got: %S" path)) + (setq path (propertize path 'deadgrep-overridden t))) + path)) + +(defun deadgrep--project-root () + "Guess the project root of the given FILE-PATH." + (let ((root default-directory) + (project (project-current))) + (when project + (cond ((and (fboundp 'project-root) + (>= emacs-major-version 28)) + ;; `project-root' was added in Emacs 28, but projectile + ;; defines it unconditionally. + (setq root (project-root project))) + (t + ;; Older Emacsen. + (-when-let (roots (project-roots project)) + (setq root (car roots)))))) + (when root + (deadgrep--lookup-override root)))) + +(defun deadgrep--write-postponed () + "Write a message to the current buffer informing the user that +deadgrep is ready but not yet searching." + (let* ((inhibit-read-only t) + (restart-key + (where-is-internal #'deadgrep-restart deadgrep-mode-map t))) + (save-excursion + (goto-char (point-max)) + (insert + (format "Press %s to start the search." + (key-description restart-key)))))) + +(defun deadgrep--create-imenu-index () + "Create `imenu' index for matched files." + (when deadgrep--imenu-alist + (list (cons "Files" (reverse deadgrep--imenu-alist))))) + +;;;###autoload +(defun deadgrep (search-term &optional directory) + "Start a ripgrep search for SEARCH-TERM in DIRECTORY. + +If not provided, DIR defaults to the directory as determined by +`deadgrep-project-root-function'. + +See also `deadgrep-project-root-overrides'. + +If called with a prefix argument, create the results buffer but +don't actually start the search." + (interactive (list (deadgrep--read-search-term))) + (let* ((dir (or directory + (funcall deadgrep-project-root-function))) + (buf (deadgrep--buffer + search-term + dir + (or deadgrep--initial-filename + (buffer-file-name)))) + (last-results-buf (car-safe (deadgrep--buffers))) + prev-search-type + prev-search-case) + ;; Find out what search settings were used last time. + (when last-results-buf + (with-current-buffer last-results-buf + (setq prev-search-type deadgrep--search-type) + (setq prev-search-case deadgrep--search-case))) + + (funcall deadgrep-display-buffer-function buf) + + (with-current-buffer buf + (setq imenu-create-index-function #'deadgrep--create-imenu-index) + (setq next-error-function #'deadgrep-next-error) + + ;; If we have previous search settings, apply them to our new + ;; search results buffer. + (when last-results-buf + (setq deadgrep--search-type prev-search-type) + (setq deadgrep--search-case prev-search-case)) + + (deadgrep--write-heading) + + (if current-prefix-arg + ;; Don't start the search, just create the buffer and inform + ;; the user how to start when they're ready. + (progn + (setq deadgrep--postpone-start t) + (deadgrep--write-postponed)) + ;; Start the search immediately. + (deadgrep--start + search-term + deadgrep--search-type + deadgrep--search-case))))) + +(defun deadgrep-next-error (arg reset) + "Move to the next error. +If ARG is given, move by that many errors. + +This is intended for use with `next-error-function', which see." + (when reset + (goto-char (point-min))) + (beginning-of-line) + (let ((direction (> arg 0))) + (setq arg (abs arg)) + + (while (and + (not (zerop arg)) + (not (eobp))) + (if direction + (forward-line 1) + (forward-line -1)) + ;; If we are on a specific result (not a heading), we have a line + ;; number. + (when (get-text-property (point) 'deadgrep-line-number) + (cl-decf arg)))) + (deadgrep-visit-result-other-window)) + +(defun deadgrep-debug () + "Show a buffer with some debug information about the current search." + (interactive) + (unless (eq major-mode 'deadgrep-mode) + (user-error "deadgrep-debug should be run in a deadgrep results buffer")) + + (let ((command deadgrep--debug-command) + (output deadgrep--debug-first-output) + (buf (get-buffer-create "*deadgrep debug*")) + (inhibit-read-only t)) + (pop-to-buffer buf) + (erase-buffer) + (special-mode) + (setq buffer-read-only t) + + (insert + (propertize + "About your environment:\n" + 'face 'deadgrep-filename-face) + (format "Platform: %s\n" system-type) + (format "Emacs version: %s\n" emacs-version) + (format "Command: %s\n" command) + (format "default-directory: %S\n" default-directory) + (format "exec-path: %S\n" exec-path) + (if (boundp 'tramp-remote-path) + (format "tramp-remote-path: %S\n" tramp-remote-path) + "") + (propertize + "\nInitial output from ripgrep:\n" + 'face 'deadgrep-filename-face) + (format "%S" output) + (propertize + "\n\nPlease file bugs at https://github.com/Wilfred/deadgrep/issues/new" + 'face 'deadgrep-filename-face)))) + +(defun deadgrep-kill-all-buffers () + "Kill all open deadgrep buffers." + (interactive) + (dolist (buffer (deadgrep--buffers)) + (kill-buffer buffer))) + +(provide 'deadgrep) +;;; deadgrep.el ends here + +;; Local Variables: +;; byte-compile-warnings: (not obsolete) +;; End: