projectorg/projectorg.el

;;; projectorg.el ---

;; Copyright (C) 2019 Maxime Wack

;; Author: Maxime Wack <maximewack@free.fr>
;; Version: 0.1

;; This file is not part of GNU Emacs.

;; 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 <http://www.gnu.org/licenses/>.

;;; Commentary:

;; Project management using org, projectile and skeletor

;;; Code:

;;;; Variables

(defvar projectorg/projects-root ""
  "Where all projects are rooted.

This is the directory where projects are stored.
Can contain subdirectories.
The projectorg/org-dir subdirectory contains the notes file for each project, as well as the general notes files and the projects list file.")

(defvar projectorg/org-dir "org/"
  "Directory inside projectorg/projects-root containing the org files.

Defaults to \"org\"
Contains the general notes files, the projects list files and each project notes file.")

(defvar projectorg/counsel-org-capture-templates-contexts nil)

(defvar projectorg/counsel-org-capture-templates nil)

;;;; Functions

(defun projectorg/project-name ()
  "Return the full project name.

It is the result of substracting the projectorg/projects-root string from the beginning of the path of the project, as returned by projectile-project-p."
  (when (projectile-project-p)
    (let ((project-path (projectile-project-p)))
      (and
       (string= (substring project-path 0 (length projectorg/projects-root))
                projectorg/projects-root)
       (substring project-path (length projectorg/projects-root) -1)))))

(defun projectorg/notes-file ()
  "Returns the notes-file location.

It is an org file, with the same name as the project (including subdirectories), located in the *org* directory in projectorg/projects-root."
  (let ((project-name (projectorg/project-name)))
    (when project-name
      (concat projectorg/projects-root "org/" project-name ".org"))))

(defun projectorg/go-to-inbox ()
  "Go to org-default-notes-file."
  (interactive)
  (find-file-other-window org-default-notes-file))

(defun projectorg/go-to-notes ()
  "Go to the projects' notes file if it exists in the *org* directory, or go to default notes file."
  (interactive)
  (let ((notes-file (projectorg/notes-file)))
    (if (and (eq projectile-require-project-root 'prompt)
                 (not (projectile-project-p)))
        (projectorg/go-to-inbox)
      (find-file-other-window notes-file))))

(defun projectorg/add-to-project-list (FILENAME &optional WILDCARDS)
  "Add the currently visited project to the projectile list.

And switch to a perspective for the project."

  (when (projectile-project-p FILENAME)
      (persp-switch (projectile-project-name (projectile-project-root FILENAME)))
        (projectile-add-known-project (projectile-project-root FILENAME))))

(defun tree-alist-get-all (key list acc)
  (cond ((or (not list) (not (listp list))) nil)
        ((eq key (car list)) (cons (cadr list) acc))
        (t (append (tree-alist-get-all key (car list) acc) (tree-alist-get-all key (cdr list) acc)))))

(defun persp-kill-all-buffers (persp-name)
  (mapc '(lambda (buffer) (when (get-buffer buffer) (kill-buffer buffer)))
          (tree-alist-get-all 'buffer (persp-window-conf (persp-get-by-name persp-name)) nil)))

(defun projectorg/remove-from-project-list ()
  (interactive)
  (let ((proj (projectile-project-name)))
    (projectile-remove-current-project-from-known-projects)
    (projectile-kill-buffers)
    (persp-kill-all-buffers proj)
    (persp-kill proj)))

(defun projectorg/counsel-org-capture (&optional from-buffer)
  "Capture into the current project.

This command is a replacement for `org-capture' (or
`counsel-org-capture') offering project-specific capture
templates, in addition to the regular templates available from
`org-capture'. These project templates, which are \"expanded\"
relatively to the current project, are determined by the
variables `projectorg/counsel-org-capture-templates' and
`projectorg/counsel-org-capture-templates-contexts'. See the
former variable in particular for details.

Optional argument FROM-BUFFER specifies the buffer from which to
capture."
  (interactive)
  (require 'org-capture)
  (require 'counsel-projectile)
  (setq counsel-projectile--org-capture-templates-backup org-capture-templates)
  (let* ((ivy--actions-list (copy-sequence ivy--actions-list))
         (root (ignore-errors (projectile-project-root)))
         (name (projectorg/project-name))
         (org-capture-templates-contexts
          (append (when root
                    projectorg/counsel-org-capture-templates-contexts)
                  org-capture-templates-contexts))
         (org-capture-templates
          (append
           (unless counsel-projectile-org-capture-templates-first-p
             org-capture-templates)
           (when root
             (cl-loop
              with replace-fun = `(lambda (string)
                                    (replace-regexp-in-string
                                     "\\${[^}]+}"
                                     (lambda (s)
                                       (pcase s
                                         ("${root}" ,root)
                                         ("${name}" ,name)))
                                     string))
              for template in projectorg/counsel-org-capture-templates
              collect (cl-loop
                       for item in template
                       if (= (cl-position item template) 1) ;; template's name
                       collect (funcall replace-fun item)
                       else if (= (cl-position item template) 3) ;; template's target
                       collect (cl-loop
                                for x in item
                                if (stringp x)
                                collect (funcall replace-fun x)
                                else
                                collect x)
                       else
                       collect item)))
           (when counsel-projectile-org-capture-templates-first-p
             org-capture-templates))))
    (ivy-add-actions
     'counsel-org-capture
     counsel-projectile-org-capture-extra-actions)
    (with-current-buffer (or from-buffer (current-buffer))
      (counsel-org-capture))))

(advice-add 'find-file :before 'projectorg/add-to-project-list)                 ; For every file opened, check if belongs to a project and add that project to the list of projects
(advice-add 'find-file-other-window :before 'projectorg/add-to-project-list)

(provide 'projectorg)

;;; projectorg.el ends here