[emacs] mtr and gud

compilation in mtr; convenience function in gud that inserts function
name and current source line of the source buffer

2 files changed, 74 insertions, 1 deletions

diff --git a/emacs/.emacs.d/lisp/my/my-mariadb.el b/emacs/.emacs.d/lisp/my/my-mariadb.el
index bdb1c60..d790944 100644
--- a/emacs/.emacs.d/lisp/my/my-mariadb.el
+++ b/emacs/.emacs.d/lisp/my/my-mariadb.el
@@ -288,5 +288,30 @@ switches to the buffer."
          (file-name (format "/tmp/%s.wiki" term)))
     (my-save-text-and-switch-to-buffer source file-name)))
 
+(defvar my-mtr-compilation-error-re
+  '(mtr "^mysqltest: At line \\([0-9]+\\)" nil 1))
+
+;; (defun my-mtr-find-test-file (test-name &optional dir)
+;;   (unless dir (setq dir default-directory))
+;;   ())
+
+(defun my-mtr-set-compile-command ()
+  (when (and buffer-file-name
+             (equal "test" (file-name-extension buffer-file-name)))
+    (when-let*
+        ((source-dir (expand-file-name (project-root (project-current))))
+         (build-dir (replace-regexp-in-string "/src/$" "/build/" source-dir))
+         (test-name
+          (progn
+            (when (string-match
+                   "^.*/mysql-test/\\(.+?\\)/\\(t/\\)?\\([^/]+\\)\\.test$"
+                   buffer-file-name)
+              (format "%s.%s"
+                      (match-string 1 buffer-file-name)
+                      (match-string 3 buffer-file-name))))))
+      (setq-local
+       compile-command
+       (format "%smysql-test/mtr %s" build-dir test-name)))))
+
 (provide 'my-mariadb)
 ;;; my-mariadb.el ends here
diff --git a/emacs/.emacs.d/lisp/my/my-prog.el b/emacs/.emacs.d/lisp/my/my-prog.el
index a81d36d..d93c745 100644
--- a/emacs/.emacs.d/lisp/my/my-prog.el
+++ b/emacs/.emacs.d/lisp/my/my-prog.el
@@ -365,8 +365,28 @@ left and the source buffer on the right.
   (select-window (display-buffer (gdb-get-source-buffer))))
 
 (defun my-gud-comint-set-prompt-regexp ()
-  (setq comint-prompt-regexp "\\((rr)|(gdb)\\) "))
+  (setq comint-prompt-regexp "\\((rr)\\|(gdb)\\) *"))
 
+(defun my-gud-source-line ()
+  (with-current-buffer (gdb-get-source-buffer)
+    (buffer-substring (progn (beginning-of-line) (point))
+                      (progn (end-of-line) (point)))))
+
+(defun my-gud-function-name ()
+  (with-current-buffer (gdb-get-source-buffer)
+    (which-function)))
+
+(defun my-gud-insert-source-line ()
+  (interactive)
+  (insert (my-gud-source-line)))
+
+(defun my-gud-insert-function-name ()
+  (interactive)
+  (insert (my-gud-function-name)))
+
+(defun my-gud-insert-source-line-and-function-name ()
+  (interactive)
+  (insert (format "%s IN %s" (my-gud-source-line) (my-gud-function-name))))
 
 ;;; used to override `gdb-frame-handler': do not re-display frame on
 ;;; completion.
@@ -489,6 +509,34 @@ overlay arrow in source buffer."
     (unless (derived-mode-p 'haskell-mode 'c-mode 'c++-mode)
       (eglot-format-buffer))))
 
+;;; https://github.com/joaotavora/eglot/issues/88
+(defun my-eglot-ccls-inheritance-hierarchy (&optional derived)
+  "Show inheritance hierarchy for the thing at point.
+If DERIVED is non-nil (interactively, with prefix argument), show
+the children of class at point."
+  (interactive "P")
+  (if-let* ((res (jsonrpc-request
+                  (eglot--current-server-or-lose)
+                  :$ccls/inheritance
+                  (append (eglot--TextDocumentPositionParams)
+                          `(:derived ,(if derived t :json-false))
+                          '(:levels 100) '(:hierarchy t))))
+            (tree (list (cons 0 res))))
+      (with-help-window "*ccls inheritance*"
+        (with-current-buffer standard-output
+          (while tree
+            (pcase-let ((`(,depth . ,node) (pop tree)))
+              (cl-destructuring-bind (&key uri range) (plist-get node :location)
+                (insert (make-string depth ?\ ) (plist-get node :name) "\n")
+                (make-text-button (+ (point-at-bol 0) depth) (point-at-eol 0)
+                                  'action (lambda (_arg)
+                                            (interactive)
+                                            (find-file (eglot--uri-to-path uri))
+                                            (goto-char (car (eglot--range-region range)))))
+                (cl-loop for child across (plist-get node :children)
+                         do (push (cons (1+ depth) child) tree)))))))
+    (eglot--error "Hierarchy unavailable")))
+
 ;;; lisp
 (defun my-eval-defun-or-region (&optional arg)
   "Call `eval-region' if region is active, otherwise call `eval-defun'"