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