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