Merge branch 'master' of github.com:Mango0x45/dotfilesHEADmaster

1 files changed, 211 insertions, 0 deletions

diff --git a/.config/emacs/site-lisp/grab.el b/.config/emacs/site-lisp/grab.el
new file mode 100644
index 0000000..830d976
--- /dev/null
+++ b/.config/emacs/site-lisp/grab.el
@@ -0,0 +1,211 @@
+;;; grab.el --- Emacs integration for grab -*- lexical-binding: t; -*-
+
+;; Author: Thomas Voss <mail@thomasvoss.com>
+;; Description: TODO
+;; Keywords: matching, tools
+
+;;; Commentary:
+;; TODO
+
+;;; Code:
+
+(require 'ansi-color)
+(require 'compile)
+(require 'project)
+
+(defgroup grab nil
+  "Settings for `grab'."
+  :group 'tools)
+
+(defcustom grab-command "grab"
+  "The base executable for the grab tool."
+  :type 'string)
+
+(defcustom git-grab-command "git-grab"
+  "The base executable for the git-grab tool."
+  :type 'string)
+
+(defcustom grab-command-arguments '("-c" "-Halways")
+  "TODO"
+  :type '(repeat string))
+
+(defcustom git-grab-command-arguments grab-command-arguments
+  "TODO"
+  :type '(repeat string))
+
+(defcustom grab-default-pattern '("x// h//" . 3)
+  "TODO"
+  :type '(choice (cons string natnum)
+                 (string)))
+
+(defvar grab--header-regexp
+  "^\\([^:\n]+\\):\\([0-9]+\\):")
+
+(defvar grab-results-mode-map
+  (let ((map (make-sparse-keymap)))
+    (keymap-set map "RET" #'grab-goto-match)
+    (keymap-set map "n"   #'grab-next-match)
+    (keymap-set map "p"   #'grab-prev-match)
+    map)
+  "Keymap for navigating grab matches.")
+
+(define-derived-mode grab-results-mode compilation-mode "Grab"
+  "TODO"
+  (setq-local compilation-error-regexp-alist nil
+              compilation-error-regexp-alist-alist nil
+              next-error-function #'grab-next-error)
+  (add-hook 'compilation-filter-hook #'ansi-color-compilation-filter nil :local)
+  (font-lock-add-keywords nil
+    `((,grab--header-regexp
+       (1 'compilation-info)
+       (2 'compilation-line-number)))))
+
+
+;;; Process Management
+
+(defun grab--run-process (command-args buffer-name)
+  (let ((cmd-string (mapconcat #'shell-quote-argument command-args " ")))
+    (compilation-start cmd-string
+                       #'grab-results-mode
+                       (lambda (_) buffer-name))))
+
+
+;;; Navigation & Core Logic
+
+(defun grab--valid-match-p ()
+  "Return non-nil if the current line is a match."
+  (save-excursion
+    (beginning-of-line)
+    (and (looking-at grab--header-regexp)
+         (not (string-prefix-p "Grab started"  (match-string 1)))
+         (not (string-prefix-p "Grab finished" (match-string 1))))))
+
+(defun grab-display-match (&optional select-window-p)
+  "Parse current line and display the match in the source buffer."
+  (interactive "P")
+  (save-excursion
+    (beginning-of-line)
+    (if (grab--valid-match-p)
+        (let* ((file (match-string-no-properties 1))
+               (offset (string-to-number (match-string-no-properties 2)))
+               (full-path (expand-file-name file default-directory)))
+          (if (not (file-exists-p full-path))
+              (error "File `%s' does not exist" full-path)
+            (let* ((buffer (find-file-noselect full-path))
+                   (window (display-buffer
+                            buffer '(display-buffer-reuse-window
+                                     display-buffer-pop-up-window))))
+              (with-selected-window window
+                (let ((pos (or (byte-to-position (1+ offset)) (1+ offset))))
+                  (goto-char pos)
+                  (when (fboundp 'pulse-momentary-highlight-one-line)
+                    (pulse-momentary-highlight-one-line pos))))
+              (when select-window-p
+                (select-window window)))))
+      (user-error "No match found on the current line"))))
+
+(defun grab-goto-match ()
+  "Go to match on current line and select its window."
+  (interactive)
+  (grab-display-match :select-window-p))
+
+(defun grab--search-forward ()
+  (catch 'found
+    (while (re-search-forward grab--header-regexp nil :noerror)
+      (when (grab--valid-match-p)
+        (throw 'found t)))
+    nil))
+
+(defun grab--search-backward ()
+  (catch 'found
+    (while (re-search-backward grab--header-regexp nil :noerror)
+      (when (grab--valid-match-p)
+        (throw 'found t)))
+    nil))
+
+(defun grab-next-match ()
+  "Move to the next match and display it."
+  (interactive)
+  (forward-line 1)
+  (if (grab--search-forward)
+      (progn
+        (beginning-of-line)
+        (grab-display-match))
+    (forward-line -1)
+    (message "No more matches")))
+
+(defun grab-prev-match ()
+  "Move to the previous match and display it."
+  (interactive)
+  (forward-line -1)
+  (if (grab--search-backward)
+      (progn
+        (beginning-of-line)
+        (grab-display-match))
+    (forward-line 1)
+    (message "No previous matches")))
+
+(defun grab-next-error (&optional arg reset)
+  "TODO"
+  (interactive "p")
+  (when reset
+    (goto-char (point-min)))
+  (let ((direction (if (< arg 0) -1 +1))
+        (count (abs arg)))
+    (dotimes (_ count)
+      (if (> direction 0)
+          (progn
+            (end-of-line)
+            (unless (grab--search-forward)
+              (error "No more matches")))
+        (beginning-of-line)
+        (unless (grab--search-backward)
+          (error "No previous matches"))))
+    (beginning-of-line)
+    (grab-goto-match)))
+
+
+;;; Interactive Commands
+
+;;;###autoload
+(defun grab (pattern)
+  "Run grab with PATTERN in the current directory."
+  (interactive
+   (list (read-string (format-prompt "Grab Pattern" nil) grab-default-pattern)))
+  (grab--run-process
+   (flatten-tree (list grab-command grab-command-arguments pattern))
+   "*grab*"))
+
+;;;###autoload
+(defun git-grab (pattern)
+  "Run git grab with PATTERN in the current directory."
+  (interactive
+   (list (read-string (format-prompt "Grab Pattern" nil) grab-default-pattern)))
+  (grab--run-process
+   (flatten-tree (list git-grab-command git-grab-command-arguments pattern))
+   "*grab*"))
+
+;;;###autoload
+(defun project-grab (pattern)
+  "Run grab with PATTERN at the project root."
+  (interactive
+   (list (read-string (format-prompt "Grab Pattern" nil) grab-default-pattern)))
+  (let* ((project (project-current t))
+         (default-directory (project-root project)))
+    (grab--run-process
+     (flatten-tree (list grab-command grab-command-arguments pattern))
+     "*grab*")))
+
+;;;###autoload
+(defun project-git-grab (pattern)
+  "Run git grab with PATTERN at the project root."
+  (interactive
+   (list (read-string (format-prompt "Grab Pattern" nil) grab-default-pattern)))
+  (let* ((project (project-current t))
+         (default-directory (project-root project)))
+    (grab--run-process
+     (flatten-tree (list git-grab-command git-grab-command-arguments pattern))
+     "*grab*")))
+
+(provide 'grab)
+;;; grab.el ends here