From 093ffa5fbf7143f4668bb0a3dc9659a5cc836e12 Mon Sep 17 00:00:00 2001 From: Yuchen Pei Date: Sat, 17 Jun 2023 17:20:29 +1000 Subject: Moving things one level deeper To ease gnu stow usage. Now we can do stow -t ~ emacs --- emacs/.emacs.d/lisp/my/my-project.el | 104 +++++++++++++++++++++++++++++++++++ 1 file changed, 104 insertions(+) create mode 100644 emacs/.emacs.d/lisp/my/my-project.el (limited to 'emacs/.emacs.d/lisp/my/my-project.el') diff --git a/emacs/.emacs.d/lisp/my/my-project.el b/emacs/.emacs.d/lisp/my/my-project.el new file mode 100644 index 0000000..21a05f1 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-project.el @@ -0,0 +1,104 @@ +;;; my-project.el -- Project related extensions for emacs core -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei +;; 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 . + +;;; 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))) +;; 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 -- cgit v1.2.3