blob: 21a05f18de0029287b2ba902a8fcc4c87e342620 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
;;; 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)))
;; 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
|
