mirror of
https://github.com/NinjaTrappeur/my-repo-pins.git
synced 2024-09-22 03:16:00 +02:00
Félix Baylac-Jacqué
bc30dfa02f
Open a fuzzy-autocomplete mini-buffer to retrieve a project contained in code-root. Once selected, open the said project folder. First project milestone reached \0/
129 lines
4.9 KiB
EmacsLisp
129 lines
4.9 KiB
EmacsLisp
;;; h.el --- Project navigation and remote checkout -*- lexical-binding: t -*-
|
||
|
||
;;; Copyright (C) 2022 Félix Baylac Jacqué
|
||
;;; Author: Félix Baylac Jacqué <felix at alternativebit.fr>
|
||
;;; Maintainer: Félix Baylac Jacqué <felix at alternativebit.fr>
|
||
;;; Version: 1.14.0
|
||
;;; Homepage: https://alternativebit.fr/TODO
|
||
;;; Package-Requires: ((emacs "25.1"))
|
||
|
||
;;; License:
|
||
|
||
;;; This program is free software; you can redistribute it and/or modify
|
||
;;; it under the terms of the GNU General Public License as published by
|
||
;;; the Free Software Foundation, either version 3 of the License, or
|
||
;;; (at your option) any later version.
|
||
|
||
;;; This program is distributed in the hope that it will be useful,
|
||
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;;; GNU General Public License for more details.
|
||
|
||
;;; You should have received a copy of the GNU General Public License
|
||
;;; along with this program. If not, see <https://www.gnu.org/licenses/>
|
||
|
||
;;;; Commentary:
|
||
|
||
;;; TODO before publish
|
||
|
||
;;; Code:
|
||
|
||
(eval-when-compile (require 'subr-x))
|
||
|
||
(defgroup h-group nil
|
||
"Variables used to setup the h.el code folder manager."
|
||
:group 'Communication)
|
||
|
||
|
||
(defcustom h-code-root nil
|
||
"Root directory containing all your projects.
|
||
h.el organise the git repos you'll checkout in a tree fashion.
|
||
|
||
All the code fetched using h.el will end up in this root directory. A
|
||
tree of subdirectories will be created mirroring the remote URI.
|
||
|
||
For instance, after checking out
|
||
https://git.savannah.gnu.org/git/emacs/org-mode.git, the source code
|
||
will live in the h-code-root/git.savannah.gnu.org/git/emacs/org-mode/
|
||
local directory"
|
||
:type 'directory
|
||
:group 'h-group)
|
||
|
||
(defun h--safe-get-code-root ()
|
||
"Ensure ‘h-code-root’ is correctly set, then canonalize the path.
|
||
Errors out if ‘h-code-root’ has not been set yet."
|
||
(progn (when (not h-code-root)
|
||
(error "h-code-root has not been set. Please point it to your code root"))
|
||
(file-name-as-directory h-code-root)))
|
||
|
||
(defcustom h-git-bin "git"
|
||
"Path pointing to the git binary.
|
||
By default, it'll look for git in the current $PATH."
|
||
:type 'file
|
||
:group 'h-group)
|
||
|
||
(defun h--git-path ()
|
||
"Find the git binary path using ‘h-git-bin’.
|
||
|
||
Errors out if we can't find it."
|
||
(if (file-executable-p h-git-bin)
|
||
h-git-bin
|
||
(let ((git-from-bin-path (locate-file h-git-bin exec-path)))
|
||
(if (file-executable-p git-from-bin-path)
|
||
git-from-bin-path
|
||
(error "Can't find git. Is h-git-bin correctly set?")))))
|
||
|
||
(defun h--call-git-in-dir (dir args)
|
||
"Call the git binary as pointed by ‘h-git-bin’ in DIR with ARGS."
|
||
(let ((default-directory dir))
|
||
(process-file (h--git-path) nil nil nil args)))
|
||
|
||
(defun h--is-git-repo (dir)
|
||
"Check if DIR is a git repo using a pretty weak heuristic."
|
||
(file-directory-p (concat (file-name-as-directory dir) ".git")))
|
||
|
||
(defun h--get-code-root-projects (code-root)
|
||
"Retrieve the projects contained in the CODE-ROOT directory.
|
||
We're going to make some hard assumptions about how the ‘h-code-root’
|
||
directory should look like. First of all, if a directory seem to be a
|
||
git repository, it'll automatically be considered as a project root.
|
||
|
||
It means that after encountering a git repository, we won't recurse
|
||
any further.
|
||
|
||
If the directory pointed by h-code-root does not exists yet, returns
|
||
an empty list."
|
||
(if (not (file-directory-p code-root))
|
||
'()
|
||
(let*
|
||
((is-not-git-repo (lambda (dir) (not (h--is-git-repo dir))))
|
||
(remove-code-root-prefix
|
||
(lambda (path) (string-remove-prefix (concat (file-name-as-directory code-root)) path)))
|
||
;; PERF: Using directory-files-recursively is pretty
|
||
;; inneficient. We have to list the dir content twice:
|
||
;; 1. when directory-files-recursively checks.
|
||
;; 2. when we filter the intermediate dirs from this list.
|
||
(recursively-found-dirs
|
||
(directory-files-recursively code-root "" t is-not-git-repo))
|
||
(projects-absolute-path (seq-filter (lambda (e) (h--is-git-repo e)) recursively-found-dirs))
|
||
(projects-relative-to-code-root
|
||
(mapcar remove-code-root-prefix projects-absolute-path)))
|
||
projects-relative-to-code-root)))
|
||
|
||
(defun h-jump-to-project ()
|
||
"Open a project contained in the ‘h-code-root’ directory.
|
||
If the project is not here yet, check it out from the available sources."
|
||
(interactive)
|
||
(let* ((selected-project-from-coderoot
|
||
(completing-read
|
||
"Available projects: "
|
||
(h--get-code-root-projects (h--safe-get-code-root))
|
||
nil t ""))
|
||
(selected-project-absolute-path (concat (h--safe-get-code-root) selected-project-from-coderoot)))
|
||
(if (file-directory-p selected-project-absolute-path)
|
||
(find-file selected-project-absolute-path)
|
||
(error "NOT IMPLEMENTED: cannot checkout a new project for now"))))
|
||
|
||
(provide 'h)
|
||
;;; h.el ends here
|