From 06914aff2b0011d41bc50447965a8d7c6ef52c9b Mon Sep 17 00:00:00 2001 From: Yuchen Pei Date: Mon, 19 Jun 2023 11:19:19 +1000 Subject: precision fixes - Adding org-jira - Also fixed getting builders in buildbot - Adding gdb-mi and gud - Adding gdb and shell configs - Also mariadb dev related stuff - A few more modes - some more updates --- emacs/.emacs.d/lisp/my/my-prog.el | 279 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 279 insertions(+) (limited to 'emacs/.emacs.d/lisp/my/my-prog.el') diff --git a/emacs/.emacs.d/lisp/my/my-prog.el b/emacs/.emacs.d/lisp/my/my-prog.el index 210d7ef..309df2e 100644 --- a/emacs/.emacs.d/lisp/my/my-prog.el +++ b/emacs/.emacs.d/lisp/my/my-prog.el @@ -86,6 +86,26 @@ "-ansi -pedantic -Wall -g") file))))) +(defun my-c-switch-between-header-and-source () + "Switch between a c/c++ header (.h) and its corresponding source (.c/.cpp/.cc)." + (interactive) + (let ((bse (file-name-sans-extension buffer-file-name)) + (ext (downcase (file-name-extension buffer-file-name))) + (new-file)) + (cond + ;; first condition - the extension is "h" + ((equal ext "h") + (cond ((file-exists-p (setq new-file (concat bse ".c"))) + (find-file new-file)) + ((file-exists-p (setq new-file (concat bse ".cpp"))) + (find-file new-file)) + ((file-exists-p (setq new-file (concat bse ".cc"))) + (find-file new-file)))) + ;; second condition - the extension is "c" or "cpp" + ((member ext '("c" "cpp" "cc")) + (when (file-exists-p (setq new-file (concat bse ".h"))) + (find-file new-file)))))) + ;;; To override `xref-query-replace-in-results'. (defun my-xref-query-replace-in-results (from to) "Perform interactive replacement of FROM with TO in all displayed xrefs. @@ -155,5 +175,264 @@ create a shell buffer using `my-shell-with-directory'" (call-interactively 'my-shell-with-directory) (my-buffer-quick-major-mode 'shell-mode))) +;;; gdb +(require 'gdb-mi) +(require 'gud) +(require 'org) +(defun my-org-backtrace-region (beg end) + "Convert selected backtrace to org links and copy the result to kill ring. + +With a prefix arg, convert from bottom to top." + (let ((bt (buffer-substring-no-properties beg end)) + (case-fold-search nil) + (results) (func-name)) + (with-temp-buffer + (insert bt) + (goto-char (point-min)) + ;; remove paging lines + (flush-lines "^--.*--$") + (goto-char (point-min)) + (while (re-search-forward "^#[0-9]+\\ +\\(?:[0-9a-fx]+ in \\)?\\([^ ]+\\) .*$" end t) + (setq func-name (match-string-no-properties 1)) + (let ((point-from) (file-location-from) + (point-at) (file-location-at) + (file-location)) + (save-excursion + (when (re-search-forward " from \\(/[^ ]+\\)$" end t) + (setq file-location-from (match-string-no-properties 1) + point-from (point)))) + (save-excursion + ;; a weak check of file:lineno + (when (re-search-forward " at \\(/[^ ]+:.*\\)$" end t) + (setq file-location-at (match-string-no-properties 1) + point-at (point)))) + (setq file-location + (cond ((not file-location-from) file-location-at) + ((not file-location-at) file-location-from) + ((< point-at point-from) file-location-at) + (t file-location-from))) + (when (and func-name file-location) + (push (concat "[[" file-location "][" func-name "]]") results)))) + (unless current-prefix-arg (setq results (reverse results))) + (kill-new (string-join results (if current-prefix-arg " < " " > ")))))) + +(defun my-stack-frame-to-org (rev) + "Convert stack frame in gdb frames buffer to org. + +Conversion is in a similar fashion to `my-org-backtrace-region'." + (let ((results)) + (with-current-buffer (gdb-stack-buffer-name) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^[0-9]+\\ +in \\(.*\\) of \\(.*\\)$" nil t) + (setq func-name (match-string-no-properties 1) + file-location (match-string-no-properties 2)) + (push (concat "[[" file-location "][" func-name "]]") results)))) + (unless rev (setq results (reverse results))) + (string-join results (if current-prefix-arg " < " " > ")))) + +(defun my-insert-stack-frame-to-org (rev) + (interactive "P") + (insert (my-stack-frame-to-org rev))) + +(defun my-kill-stack-frame-to-org (rev) + (interactive "P") + (kill-new (my-stack-frame-to-org rev))) + +(defun my-org-backtrace () + (interactive) + (if (region-active-p) + (my-org-backtrace-region (region-beginning) (region-end)) + (my-org-backtrace-region + (point) + (save-excursion (comint-next-prompt 1) (point))))) + +(defun my-gdb (&optional command) + "lock gud command buffer and restore middle and right windows. + +Assuming a three window horizontal split to start with. Assuming +the default configuration of gdb windows is all of them on the +left and the source buffer on the right. +" + (interactive) + ;; save windows + (let* ((old-window (selected-window)) + (right-buffer + (window-buffer + (progn + (while (window-in-direction 'right) + (select-window (window-in-direction 'right))) + (selected-window)))) + (middle-buffer + (window-buffer + (window-in-direction 'left)))) + (select-window old-window) + ;; call gdb + (if (called-interactively-p) + (call-interactively 'gdb) + (gdb command)) + (sleep-for 6) + ;; lock gud-comint-buffer + (my-toggle-lock-window-to-buffer (get-buffer-window gud-comint-buffer)) + ;; restore windows + (select-window (car gdb-source-window-list)) + (switch-to-buffer middle-buffer) + (split-window-horizontally) + (select-window (window-next-sibling)) + (switch-to-buffer right-buffer) + (balance-windows) + (when (window-live-p old-window) (select-window old-window)))) + +(defun my-gdb-restart () + (interactive) + (let ((old-window (selected-window))) + (select-window (get-buffer-window gud-comint-buffer)) + (gdb-delchar-or-quit 0) + (call-interactively 'my-gdb) + (when (window-live-p old-window) (select-window old-window)))) + +(defun my-gdb-kill () + (interactive) + (let ((kill-buffer-query-functions nil)) + (kill-buffer "*gud-replay*"))) + +(defun my-gdb-quit () + (interactive) + (let ((old-window (selected-window))) + (select-window (get-buffer-window gud-comint-buffer)) + (goto-char (point-max)) + (gdb-delchar-or-quit 0) + (my-toggle-lock-current-window-to-buffer) + (when (window-live-p old-window) (select-window old-window)))) + +(defun my-gdb-frames-add-breakpoint () + (interactive) + (gdb-select-frame) + (with-current-buffer (gdb-get-source-buffer) + (call-interactively 'gud-break))) + +(defun my-gdb-frames-remove-breakpoint () + (interactive) + (gdb-select-frame) + (with-current-buffer (gdb-get-source-buffer) + (call-interactively 'gud-remove))) + +(defun my-gdb-frames-select-next (n) + (interactive "p") + (next-line n) + (gdb-select-frame)) +(defun my-gdb-frames-select-previous (n) + (interactive "p") + (next-line (- n)) + (gdb-select-frame)) +(defun my-gdb-switch-to-source-buffer () + (interactive) + (select-window (display-buffer (gdb-get-source-buffer)))) + +(defun my-gud-comint-set-prompt-regexp () + (setq comint-prompt-regexp "\\((rr)|(gdb)\\) ")) + +(defun my-file-loc-to-github (file-loc &optional revision) + "Convert a file location to a github url." + (pcase-let* ((`(,file ,line-no) (split-string file-loc ":")) + (revision (or revision (vc-working-revision file))) + (repo-url (vc-git-repository-url file)) + (repo-root (vc-git-root file)) + (path (file-relative-name file repo-root))) + (format "%s/blob/%s/%s#L%s" repo-url revision path line-no))) + +(defun my-org-backtrace-to-github (bt &optional revision) + (string-join + (mapcar + (lambda (link) + (string-match "\\[\\[\\(.*\\)\\]\\[\\(.*\\)\\]\\]" link) + (let ((target (match-string 1 link)) + (label (match-string 2 link))) + (format "[[%s][%s]]" + (my-file-loc-to-github target revision) + label))) + (split-string bt " > ")) + " > ")) + +(defun my-org-backtrace-to-github-region (beg end) + (interactive "r") + (kill-new + (my-org-backtrace-to-github (buffer-substring-no-properties beg end)))) + +(defun my-org-backtrace-to-github-slack (beg end) + (interactive "r") + (let ((bt (buffer-substring-no-properties beg end)) + (revision (when current-prefix-arg + (read-string "Rrevision: "))) + ) + (with-temp-buffer + (insert "#+options: ^:nil +") + (goto-char (point-max)) + (insert (my-org-backtrace-to-github bt revision)) + (org-md-export-as-markdown)))) + +;;; which-func +(defun my-copy-which-func () + (interactive) + (kill-new (which-function)) + ) + +(defun my-set-header-line-to-which-func () + (setq header-line-format + '((which-func-mode + ("" which-func-format " ") + )))) + +;; override bookmark-make-record for easier default bookmark name. +(defun my-bookmark-make-record () + "Return a new bookmark record (NAME . ALIST) for the current location." + (let ((record (funcall bookmark-make-record-function))) + ;; Set up default name if the function does not provide one. + (unless (stringp (car record)) + (if (car record) (push nil record)) + (setcar record (or bookmark-current-bookmark (bookmark-buffer-name)))) + ;; Set up defaults. + (bookmark-prop-set + record 'defaults + (delq nil (delete-dups (append (bookmark-prop-get record 'defaults) + (list (which-function) + bookmark-current-bookmark + (car record) + (bookmark-buffer-name)))))) + record)) + +;;; bison-mode +(require 'bison-mode) +(defun my-bison-imenu-create-index () + (let ((end)) + (beginning-of-buffer) + (re-search-forward "^%%") + (forward-line 1) + (setq end (save-excursion + (when (re-search-forward "^%%" nil t) (point)))) + (loop while (re-search-forward "^\\([a-z].*?\\)\\s-*\n?\\s-*:" end t) + collect (cons (match-string 1) (point))))) +(defun my-bison-set-imenu-create-index-function () + (setq imenu-create-index-function + 'my-bison-imenu-create-index)) + +;;; json-mode +(require 'json-mode) +(defun my-json-mode-path () + (string-join + (mapcar 'prin1-to-string (plist-get (json-path-to-position (point)) :path)) + "/")) + +(defun my-json-set-header-line-to-path () + (setq header-line-format + '((:eval (my-json-mode-path))))) + +;;; eglot +(defun my-eglot-format-buffer-when-managed () + (when (eglot-managed-p) + (unless (derived-mode-p 'haskell-mode 'c-mode 'c++-mode) + (eglot-format-buffer)))) + (provide 'my-prog) ;;; my-prog.el ends here -- cgit v1.2.3