system-manager-wakasu
1;;; project-func.el --- -*- lexical-binding: t -*-
2;;; Commentary:
3;;; Code:
4(require 'project)
5(require 'vterm)
6(require 'json)
7(require 'vc)
8
9(defun in-git-repo-p ()
10 "Check if current directory is in a git repository."
11 (eq (vc-backend (or buffer-file-name default-directory))
12 'Git))
13
14(defun is-github-repo-p ()
15 "Check if current git repository has a GitHub remote."
16 (when (in-git-repo-p)
17 (string-match-p "github\\.com"
18 (shell-command-to-string "git remote -v"))))
19
20(defun fetch-github-prs ()
21 "Fetch GitHub PRs synchronously."
22 (let* ((output (shell-command-to-string "gh pr list --limit=5000 --json number,title,author,url,baseRefName,labels,isDraft"))
23 (prs (json-read-from-string output)))
24 prs))
25
26(defun format-pr-draft (isDraft)
27 "Return (draft) if `pr' is a draft, otherwise returns an empty string"
28 (cond ((eq isDraft :json-false) "")
29 (t "🚧 draft")))
30
31(defun format-pr-candidates (prs)
32 "Format PR data into candidates for completion."
33 (mapcar (lambda (pr)
34 (let-alist pr
35 (cons (format "#%d %s (by @%s) on %s %s" .number .title .author.login .baseRefName (format-pr-draft .isDraft))
36 .number)))
37 prs))
38
39
40
41;;;###autoload
42(defun checkout-github-pr ()
43 "Interactive function to select and checkout a GitHub PR."
44 (interactive)
45 (cond
46 ((not (in-git-repo-p))
47 (message "Not in a Git repository"))
48 ((not (is-github-repo-p))
49 (message "Not a GitHub repository"))
50 (t
51 (let* ((prs (fetch-github-prs))
52 (candidates (format-pr-candidates prs))
53 (selected (if candidates
54 (cdr (assoc (completing-read "Checkout PR: " candidates)
55 candidates))
56 nil)))
57 (if selected
58 (shell-command (format "gh pr checkout %d" selected))
59 (message "No pull requests found"))))))
60
61;;;###autoload
62(defun vde-project--project-current ()
63 "Return directory from `project-current' based on Emacs version."
64 (if (>= emacs-major-version 29)
65 (project-root (project-current))
66 (cdr (project-current))))
67
68;;;###autoload
69(defun vde-project--project-root-or-default-directory ()
70 "Return path to the project root *or* the default-directory."
71 (cond
72 ((and (featurep 'project) (project-current))
73 (project-root (project-current)))
74 (t default-directory)))
75
76;;;##autoload
77(defun vde/project-run-in-vterm (command &optional directory)
78 "Run the given `COMMAND' in a new vterm buffer in `project-root' or the
79given `DIRECTORY'.
80
81This is similar to `compile' but with vterm.
82One reason for this is to be able to run commands that needs a TTY."
83 (interactive "sCommand: ")
84 (let* ((cwd (or directory (vde-project--project-root-or-default-directory)))
85 (default-directory cwd)
86 (buffer-name (format "*vterm %s: %s*" cwd command))
87 (buffer (get-buffer buffer-name))
88 (vterm-kill-buffer-on-exit nil)
89 (vterm-shell (concat "bash -c '" command ";exit'")))
90 (when buffer
91 (kill-buffer buffer))
92 (let ((buffer (generate-new-buffer buffer-name)))
93 (pop-to-buffer buffer)
94 (with-current-buffer buffer
95 (vterm-mode)))))
96
97;;;###autoload
98(defun vde/open-readme ()
99 "Open a README file in the current project.
100It will search for README.org, README.md or README in that order"
101 (interactive)
102 (let* ((default-directory (vde-project--project-current)))
103 (cond ((file-exists-p (expand-file-name "README.org" default-directory))
104 (find-file "README.org"))
105 ((file-exists-p (expand-file-name "README.md" default-directory))
106 (find-file "README.md"))
107 ((file-exists-p (expand-file-name "README" default-directory))
108 (find-file "README")))))
109
110;;;###autoload
111(defun vde/project-try-local (dir)
112 "Determine if DIR is a non-VC project."
113 (if-let ((root (if (listp vde/project-local-identifier)
114 (seq-some (lambda (n)
115 (locate-dominating-file dir n))
116 vde/project-local-identifier)
117 (locate-dominating-file dir vde/project-local-identifier))))
118 (cons 'local root)))
119
120;;;###autoload
121(defun vde/project-vterm (&optional command)
122 "Run `vterm' on project.
123If a buffer already exists for running a vterm shell in the project's root,
124switch to it. Otherwise, create a new vterm shell."
125 (interactive)
126 (let* ((default-directory (vde-project--project-current))
127 (default-project-vterm-name (project-prefixed-buffer-name "vterm"))
128 (vterm-buffer (get-buffer default-project-vterm-name)))
129 (if (and vterm-buffer (not current-prefix-arg))
130 (pop-to-buffer-same-window vterm-buffer)
131 (let* ((cd-cmd (concat " cd " (shell-quote-argument default-directory))))
132 (vterm default-project-vterm-name)
133 (with-current-buffer vterm-buffer
134 (vterm-send-string cd-cmd)
135 (vterm-send-return))))
136 (when command
137 (vterm-send-string command)
138 (vterm-send-return))))
139
140;;;###autoload
141(defun vde/project-eat ()
142 "Run Eat term in the current project's root directory.
143If a buffer already exists for running Eshell in the project's root,
144switch to it. Otherwise, create a new Eshell buffer.
145With \\[universal-argument] prefix arg, create a new Eshell buffer even
146if one already exists."
147 (interactive)
148 (defvar eat-buffer-name)
149 (let* ((default-directory (project-root (project-current t)))
150 (eat-buffer-name (project-prefixed-buffer-name "eat"))
151 (eat-buffer (get-buffer eat-buffer-name)))
152 (if (and eat-buffer (not current-prefix-arg))
153 (pop-to-buffer eat-buffer (bound-and-true-p display-comint-buffer-action))
154 (eat shell-file-name))))
155
156;;;###autoload
157(defun vde/project-magit-status ()
158 "Run `magit-status' on project."
159 (interactive)
160 (magit-status (vde-project--project-current)))
161
162(provide 'project-func)
163;;; project-func.el ends here