;;; my-project.el -- Project related extensions for emacs core -*- lexical-binding: t -*-

;; Copyright (C) 2023 Free Software Foundation.

;; Author: Yuchen Pei <id@ypei.org>
;; Package-Requires: ((emacs "28.2"))

;; This file is part of dotfiles.

;; dotfiles is free software: you can redistribute it and/or modify it under
;; the terms of the GNU Affero General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; dotfiles 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 Affero General
;; Public License for more details.

;; You should have received a copy of the GNU Affero General Public
;; License along with dotfiles.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; Project related extensions for emacs core.

;;; Code:



(defvar my-projects-root-dirs nil
  "List of directories to look for projects. Each element in the form
  of (tag . path). One of the tags should be \"3p\" which is a default
  target for cloning a project")
(defun my-get-list-of-projects ()
  (flatten-list
   (mapcar (lambda (pair)
             (mapcar
              (lambda (dir-name) (format "%s(%s)" dir-name (car pair)))
              (directory-files
               (cdr pair) nil directory-files-no-dot-files-regexp)))
           my-projects-root-dirs)))

(defun my-project-guess-project-name ()
  (file-name-nondirectory (directory-file-name
                           (project-root (project-current)))))

(defvar my-licenses nil
  "List of licenses in the form of (licence-id . license-text-file)")

(defun my-project-copy-license-file-to-project (license)
  (interactive (list (completing-read "License to copy to project root: "
                                      (mapcar 'car my-licenses))))
  (let ((from (alist-get (intern license) my-licenses))
        (to (concat (project-root (project-current))
                    "COPYING." license)))
    (copy-file from to)
    (message "Copied license of %s to %s" license to)))

(defun my-project-remember-all-projects ()
  "Remember all projects under `my-projects-root-dirs'."
  (pcase-dolist (`(_ . ,dir) my-projects-root-dirs)
    (project-remember-projects-under dir)))

;; Override project-remember-projects-under The original function is
;; buggy: it does not look for projects in surdirs unless recursive.
(defun my-project-remember-projects-under (dir &optional recursive)
  "Index all projects below a directory DIR.
If RECURSIVE is non-nil, recurse into all subdirectories to find
more projects.  After finishing, a message is printed summarizing
the progress.  The function returns the number of detected
projects."
  (interactive "DDirectory: \nP")
  (project--ensure-read-project-list)
  (let ((queue (directory-files
                dir
                t
                directory-files-no-dot-files-regexp))
        (count 0)
        (known (make-hash-table
                :size (* 2 (length project--list))
                :test #'equal )))
    (dolist (project (mapcar #'car project--list))
      (puthash project t known))
    (while queue
      (when-let ((subdir (pop queue))
                 ((file-directory-p subdir)))
        (when-let ((project (project--find-in-directory subdir))
                   (project-root (project-root project))
                   ((not (gethash project-root known))))
          (project-remember-project project t)
          (puthash project-root t known)
          (message "Found %s..." project-root)
          (setq count (1+ count)))
        (when (and recursive (file-directory-p subdir))
          (setq queue
                (nconc
                 (directory-files
                  subdir t directory-files-no-dot-files-regexp t)
                 queue)))))
    (unless (eq recursive 'in-progress)
      (if (zerop count)
          (message "No projects were found")
        (project--write-project-list)
        (message "%d project%s were found"
                 count (if (= count 1) "" "s"))))
    count))

;; FIXME: do we really need this or does the project package already
;; do so?
(defun my-project-read-project ()
  (let ((key-val
         (completing-read "Choose projects: "
                          (my-get-list-of-projects) nil t)))
    (string-match "^\\(.*\\)(\\(.*\\))$" key-val)
    (cons (match-string 2 key-val) (match-string 1 key-val))))
(defun my-project-get-project-directory (pair)
  (concat 
   (alist-get (car pair) my-projects-root-dirs nil nil 'string=)
   "/" (cdr pair)))
(defun my-project-read-project-root ()
  (my-project-get-project-directory (my-project-read-project)))
(defun my-project-shell-at (arg)
  (interactive "P")
  (if arg (project-shell)
    (my-shell-with-directory (my-project-read-project-root))))
(defun my-project-dired-at (arg)
  (interactive "P")
  (if arg (project-dired)
    (dired (my-project-read-project-root))))
(defun my-project-rgrep-at (arg)
  (interactive "P")
  (if arg (project-query-replace-regexp)
    (my-rgrep-at-directory (my-project-read-project-root))))
(defun my-project-org-set-local-source ()
  (interactive)
  (org-set-property "Local-source" (my-project-read-project-root)))
(defun my-project-code-stats ()
  (interactive)
  (switch-to-buffer-other-window (get-buffer-create "*cloc*"))
  (erase-buffer)
  (my-with-default-directory (my-project-read-project-root)
    (message default-directory)
    (insert default-directory "\n")
    (call-process "cloc" nil "*cloc*" nil "HEAD" "--quiet")))

(provide 'my-project)
;;; my-project.el ends here