aboutsummaryrefslogtreecommitdiff
path: root/emacs/.emacs.d/lisp/my/my-prog.el
diff options
context:
space:
mode:
authorYuchen Pei <id@ypei.org>2023-06-19 11:19:19 +1000
committerYuchen Pei <id@ypei.org>2023-06-19 22:41:03 +1000
commit06914aff2b0011d41bc50447965a8d7c6ef52c9b (patch)
tree278047a8c1c02347d5cf7a0119ac4cc373e3e191 /emacs/.emacs.d/lisp/my/my-prog.el
parentf06c1c12456a598b7007a6ef08306051d0d49064 (diff)
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
Diffstat (limited to 'emacs/.emacs.d/lisp/my/my-prog.el')
-rw-r--r--emacs/.emacs.d/lisp/my/my-prog.el279
1 files changed, 279 insertions, 0 deletions
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