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