2018-08-05 16:19:52 +02:00
|
|
|
|
;;; db-projects.el -- Simple Directory-Based Project Management -*- lexical-binding: t -*-
|
|
|
|
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
2022-10-16 21:09:57 +02:00
|
|
|
|
;; A project is simply a directory under `db/projects-main-project-directory'
|
2020-09-20 14:48:59 +02:00
|
|
|
|
;; containing either .git or .projectile. This little collection of functions
|
2022-10-16 21:01:59 +02:00
|
|
|
|
;; helps to manage these project directories and integrate them consistently
|
|
|
|
|
;; with the projectile package.
|
2020-09-20 14:48:59 +02:00
|
|
|
|
|
2022-10-16 21:09:57 +02:00
|
|
|
|
;; To start, first customize `db/projects-main-project-directory' and
|
|
|
|
|
;; `db/projects-archive-directory' as needed. Then use
|
|
|
|
|
;; `db/projects-add-project' to add new projects and
|
|
|
|
|
;; `db/projects-archive-project' to archive them (i.e., move them to
|
|
|
|
|
;; `db/projects-archive-directory'). This package does not offer to remove
|
2020-09-20 14:48:59 +02:00
|
|
|
|
;; projects; this has to be done manually.
|
|
|
|
|
|
2018-08-05 16:19:52 +02:00
|
|
|
|
;;; Code:
|
|
|
|
|
|
2018-08-18 10:15:05 +02:00
|
|
|
|
(require 'subr-x)
|
2018-08-18 10:50:55 +02:00
|
|
|
|
(require 'cl-lib)
|
|
|
|
|
(require 'dash)
|
2020-06-26 21:53:05 +02:00
|
|
|
|
(require 'bookmark)
|
2020-09-20 14:10:46 +02:00
|
|
|
|
(require 'projectile)
|
2018-08-18 10:15:05 +02:00
|
|
|
|
|
2022-10-16 20:59:02 +02:00
|
|
|
|
|
|
|
|
|
|
2022-10-16 21:09:57 +02:00
|
|
|
|
(defgroup db/projects nil
|
2022-10-16 20:59:02 +02:00
|
|
|
|
"Simple directory-based project management."
|
2018-08-05 16:19:52 +02:00
|
|
|
|
:tag "Project Management"
|
2022-10-16 21:09:57 +02:00
|
|
|
|
:group 'db/projects)
|
2018-08-05 16:19:52 +02:00
|
|
|
|
|
2022-10-16 21:09:57 +02:00
|
|
|
|
(defcustom db/projects-main-project-directory "~/Documents/projects/"
|
2018-08-05 16:19:52 +02:00
|
|
|
|
"Main directory to host projects."
|
2022-10-16 21:09:57 +02:00
|
|
|
|
:group 'db/projects
|
2020-06-26 21:53:05 +02:00
|
|
|
|
:type 'directory)
|
2018-08-05 16:19:52 +02:00
|
|
|
|
|
2022-10-16 21:09:57 +02:00
|
|
|
|
(defcustom db/projects-archive-directory "~/Documents/projects/.archive/"
|
2020-09-20 14:12:50 +02:00
|
|
|
|
"Directory to archive projects into."
|
2022-10-16 21:09:57 +02:00
|
|
|
|
:group 'db/projects
|
2020-06-26 21:53:05 +02:00
|
|
|
|
:type 'directory)
|
2018-08-05 16:19:52 +02:00
|
|
|
|
|
2022-10-16 20:59:02 +02:00
|
|
|
|
|
|
|
|
|
|
2022-10-16 21:09:57 +02:00
|
|
|
|
(defun db/projects-project-exists-p (short-name)
|
2020-09-20 14:12:50 +02:00
|
|
|
|
"Check whether a project named SHORT-NAME already exists."
|
2018-08-18 10:49:59 +02:00
|
|
|
|
(or
|
|
|
|
|
(file-exists-p (expand-file-name (concat (file-name-as-directory short-name)
|
|
|
|
|
".git")
|
2022-10-16 21:09:57 +02:00
|
|
|
|
db/projects-main-project-directory))
|
2018-08-18 10:49:59 +02:00
|
|
|
|
(file-exists-p (expand-file-name (concat (file-name-as-directory short-name)
|
|
|
|
|
".projectile")
|
2022-10-16 21:09:57 +02:00
|
|
|
|
db/projects-main-project-directory))))
|
2018-08-05 16:19:52 +02:00
|
|
|
|
|
2022-10-16 21:09:57 +02:00
|
|
|
|
(defun db/projects-existing-projects ()
|
2020-09-20 14:12:50 +02:00
|
|
|
|
"Return list of all short-names of existing projects."
|
2022-10-16 21:09:57 +02:00
|
|
|
|
(cl-remove-if-not #'db/projects-project-exists-p
|
|
|
|
|
(directory-files db/projects-main-project-directory
|
2020-09-20 16:39:02 +02:00
|
|
|
|
nil "^[^.]")))
|
2018-08-05 16:19:52 +02:00
|
|
|
|
|
2020-09-20 14:24:38 +02:00
|
|
|
|
;;;###autoload
|
2022-10-16 21:09:57 +02:00
|
|
|
|
(defun db/projects-add-project (short-name)
|
2022-10-16 20:58:11 +02:00
|
|
|
|
"Add new project with SHORT-NAME.
|
2020-09-20 14:12:50 +02:00
|
|
|
|
The project directory will be located under
|
|
|
|
|
`projects-main-project-directory' within a directory named
|
2022-10-16 20:50:26 +02:00
|
|
|
|
SHORT-NAME."
|
2022-10-16 20:58:11 +02:00
|
|
|
|
(interactive "sShort Name: ")
|
2022-10-16 21:09:57 +02:00
|
|
|
|
(when (db/projects-project-exists-p short-name)
|
2018-08-05 16:35:44 +02:00
|
|
|
|
(user-error "Project %s already exists, exiting" short-name))
|
2020-09-20 14:23:52 +02:00
|
|
|
|
(when (file-exists-p (expand-file-name short-name
|
2022-10-16 21:09:57 +02:00
|
|
|
|
db/projects-archive-directory))
|
2020-09-20 14:23:52 +02:00
|
|
|
|
(user-error "Project %s already exists as archived project, exiting" short-name))
|
2018-08-18 10:15:05 +02:00
|
|
|
|
(let* ((project-directory (expand-file-name short-name
|
2022-10-16 21:09:57 +02:00
|
|
|
|
db/projects-main-project-directory))
|
2018-08-18 10:15:05 +02:00
|
|
|
|
(default-directory project-directory))
|
2018-08-05 16:19:52 +02:00
|
|
|
|
(make-directory project-directory)
|
2018-08-18 10:15:05 +02:00
|
|
|
|
(if-let ((git-executable (executable-find "git")))
|
|
|
|
|
(call-process git-executable nil nil nil "init")
|
|
|
|
|
(write-region "" nil (expand-file-name ".projectile")))
|
2020-09-20 16:20:23 +02:00
|
|
|
|
(projectile-add-known-project project-directory)))
|
2018-08-05 16:19:52 +02:00
|
|
|
|
|
2020-09-20 14:24:38 +02:00
|
|
|
|
;;;###autoload
|
2022-10-16 21:09:57 +02:00
|
|
|
|
(defun db/projects-archive-project (short-name)
|
2020-09-20 14:12:50 +02:00
|
|
|
|
"Archive existing project identified by SHORT-NAME.
|
|
|
|
|
This amounts to moving the project directory SHORT-NAME under
|
|
|
|
|
`projects-main-project-directory' to
|
2020-09-20 15:03:14 +02:00
|
|
|
|
`projects-archive-directory', deleting all bookmarks into the
|
|
|
|
|
project, and updating projectile's cache."
|
2018-08-18 10:15:21 +02:00
|
|
|
|
(interactive
|
2022-10-16 21:09:57 +02:00
|
|
|
|
(list (completing-read "Short Name: " (db/projects-existing-projects) nil t)))
|
|
|
|
|
(unless (db/projects-project-exists-p short-name)
|
2018-08-05 16:19:52 +02:00
|
|
|
|
(user-error "Project %s does not exist, exiting" short-name))
|
2018-08-18 10:50:55 +02:00
|
|
|
|
|
2022-10-16 21:09:57 +02:00
|
|
|
|
(let ((project-path (expand-file-name short-name db/projects-main-project-directory))
|
|
|
|
|
(archive-path (expand-file-name short-name db/projects-archive-directory)))
|
2018-08-18 10:50:55 +02:00
|
|
|
|
|
2020-09-20 16:20:23 +02:00
|
|
|
|
(when (file-exists-p archive-path)
|
|
|
|
|
(user-error "Archived project named %s already exists, aborting" short-name))
|
2018-08-18 10:50:55 +02:00
|
|
|
|
|
2020-09-20 16:20:23 +02:00
|
|
|
|
;; Move project directory into archive
|
2022-10-16 21:09:57 +02:00
|
|
|
|
(unless (file-exists-p db/projects-archive-directory)
|
|
|
|
|
(make-directory db/projects-archive-directory))
|
2020-09-20 16:20:23 +02:00
|
|
|
|
(rename-file project-path archive-path nil)
|
|
|
|
|
|
|
|
|
|
;; Update projectile’s cache
|
|
|
|
|
(projectile-cleanup-known-projects)))
|
2018-08-05 16:19:52 +02:00
|
|
|
|
|
2022-10-16 21:09:57 +02:00
|
|
|
|
(defun db/projects--org-files ()
|
2020-09-20 16:20:23 +02:00
|
|
|
|
"Return all Org Mode files in all known projects, recursively.
|
|
|
|
|
Paths returned are absolute, but may not be canonical."
|
2020-09-20 14:48:18 +02:00
|
|
|
|
(mapcan #'(lambda (dir)
|
2022-10-16 21:09:57 +02:00
|
|
|
|
(directory-files-recursively (expand-file-name dir db/projects-main-project-directory)
|
2020-09-20 14:48:18 +02:00
|
|
|
|
".*\\.org" nil))
|
2022-10-16 21:09:57 +02:00
|
|
|
|
(db/projects-existing-projects)))
|
2020-09-20 14:48:18 +02:00
|
|
|
|
|
2020-09-20 16:35:33 +02:00
|
|
|
|
;; Let's keep the byte compiler happy
|
|
|
|
|
(defvar org-agenda-text-search-extra-files)
|
|
|
|
|
(defvar org-agenda-files)
|
2020-09-20 14:48:18 +02:00
|
|
|
|
|
2022-10-16 21:09:57 +02:00
|
|
|
|
(defun db/projects-find-unsearched-org-files ()
|
2020-09-20 14:48:18 +02:00
|
|
|
|
"Find Org Mode files in known projects that are not searched by default.
|
|
|
|
|
This is done by checking all org Mode files in every project
|
2020-09-20 16:35:33 +02:00
|
|
|
|
whether it is included in `org-agenda-text-search-extra-files' or
|
|
|
|
|
in `org-agenda-files'."
|
2020-09-20 14:48:18 +02:00
|
|
|
|
(require 'org)
|
|
|
|
|
(let ((extra-files (make-hash-table :test #'equal)))
|
|
|
|
|
(mapc #'(lambda (entry)
|
|
|
|
|
(when (stringp entry)
|
|
|
|
|
(puthash (file-truename entry) t extra-files)))
|
2020-09-20 16:35:33 +02:00
|
|
|
|
(append org-agenda-files org-agenda-text-search-extra-files))
|
2020-09-20 14:48:18 +02:00
|
|
|
|
(cl-remove-if #'(lambda (org-file)
|
|
|
|
|
(gethash (file-truename org-file) extra-files nil))
|
2022-10-16 21:09:57 +02:00
|
|
|
|
(db/projects--org-files))))
|
2018-08-18 10:49:30 +02:00
|
|
|
|
|
2020-09-20 16:33:24 +02:00
|
|
|
|
;;;###autoload
|
2022-10-16 21:09:57 +02:00
|
|
|
|
(defun db/projects-lint-projects ()
|
2020-09-20 16:33:24 +02:00
|
|
|
|
"Check all known projects for proper configuration.
|
|
|
|
|
This includes checking whether all bookmarks are in place and
|
|
|
|
|
whether `org-agenda-text-search-extra-files' is set up to search
|
|
|
|
|
through all included Org Mode files."
|
|
|
|
|
(interactive)
|
|
|
|
|
(with-current-buffer (get-buffer-create " *projects lint results*")
|
|
|
|
|
|
|
|
|
|
(erase-buffer)
|
|
|
|
|
|
2022-10-16 21:09:57 +02:00
|
|
|
|
(when-let ((unsearched-org-files (db/projects-find-unsearched-org-files)))
|
2020-09-20 16:33:24 +02:00
|
|
|
|
(insert "The following Org Mode files are not included in `org-agenda-text-search-extra-files'; you may want to add them.")
|
|
|
|
|
(dolist (file unsearched-org-files)
|
|
|
|
|
(insert "\n " file))
|
|
|
|
|
(insert "\n\n"))
|
|
|
|
|
|
|
|
|
|
(display-buffer (current-buffer))))
|
|
|
|
|
|
2018-08-05 16:19:52 +02:00
|
|
|
|
(provide 'db-projects)
|
|
|
|
|
|
|
|
|
|
;;; db-projects.el ends here
|