bug#50297: 28.0.50; Aggregate project functions for project.el

[Philip Kaludercic]

Philip Kaludercic <philipk@posteo.net> writes:

> An entirely different approach might be to implement a tabulated list
> major mode to manage projects, comparable to package-list.

For the sake of it, it tried it out how this might look like. It feels
clunky as of now, doesn't implement everything that it should and it
might make more sense to provide as an additional package.

diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index e420a4ccca..b438249b95 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1327,6 +1327,102 @@ project-execute-extended-command
   (let ((default-directory (project-root (project-current t))))
     (call-interactively #'execute-extended-command)))
 
+
+;;; Project managment
+
+(defun project-list-generate-list ()
+  "Generate a list of projects for `tabulated-list-mode'."
+  (let (entries)
+    (dolist (root (project-known-project-roots))
+      (when-let* ((proj (project--find-in-directory root))
+                  (root (project-root proj))
+                  ;; XXX: Name and Type are just to keep the buffer
+                  ;;      from looking too empty.
+                  (name (capitalize
+                         (file-name-nondirectory
+                          (directory-file-name root))))
+                  (type (if (consp proj) (format "%S" (car proj)) "??"))
+                  (data (vector name type root)))
+        (push (list root data) entries)))
+    entries))
+
+(defun project-list-select ()
+  "Select the project at point."
+  (interactive)
+  (project-switch-project (tabulated-list-get-id)))
+
+(defun project-list-mark-forget ()
+  "Mark the project at point to be forgotten."
+  (interactive)
+  (save-mark-and-excursion
+    (save-restriction
+      (narrow-to-region (region-beginning) (region-end))
+      (goto-char (point-min))
+      (while (not (eobp))
+        (tabulated-list-put-tag "F" t)))))
+
+(defun project-list-forget-zombies ()
+  "Mark the project at point to be forgotten."
+  (interactive)
+  (save-excursion
+    (goto-char (point-min))
+    (while (not (eobp))
+      (unless (file-exists-p (tabulated-list-get-id))
+        (tabulated-list-put-tag "F" t)))))
+
+(defun project-list-unmark ()
+  "Unmark the project at point."
+  (save-mark-and-excursion
+    (save-restriction
+      (narrow-to-region (region-beginning) (region-end))
+      (goto-char (point-min))
+      (while (not (eobp))
+        (tabulated-list-put-tag " " t)))))
+
+(defun project-list-execute ()
+  "Preform marked actions on the project list."
+  (interactive)
+  (let (forget-list)
+    (save-excursion
+      (goto-char (point-min))
+      (while (not (eobp))
+        (when (eq (char-after) ?F)
+          (push (tabulated-list-get-id) forget-list))
+        (forward-line)))
+    (when (yes-or-no-p (format "Forget %d projects? " (length forget-list)))
+      (mapc #'project-remove-known-project forget-list)
+      (tabulated-list-clear-all-tags)
+      (tabulated-list-print))))
+
+(defvar project-list-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "RET") #'project-list-select)
+    (define-key map (kbd "f") #'project-list-mark-forget)
+    (define-key map (kbd "d") #'project-list-mark-forget)
+    (define-key map (kbd "z") #'project-list-forget-zombies)
+    (define-key map (kbd "u") #'project-list-unmark)
+    (define-key map (kbd "x") #'project-list-execute)
+    map))
+
+(define-derived-mode project-list-mode tabulated-list-mode "Project List"
+  "Major mode for browsing the list of known projects."
+  (setq tabulated-list-format [("Name" 16 t)
+                               ("Type" 4 nil)
+                               ("Path" 0 t)]
+        tabulated-list-entries #'project-list-generate-list
+        tabulated-list-padding 2)
+  (tabulated-list-init-header)
+  (tabulated-list-print))
+
+;;;###autoload
+(defun project-list-projects ()
+  "Display a list of all known projects."
+  (interactive)
+  (project--ensure-read-project-list)
+  (with-current-buffer (get-buffer-create "*Projects*")
+    (project-list-mode)
+    (pop-to-buffer-same-window (current-buffer))))
+
 
 ;;; Project switching
 

-- 
        Philip Kaludercic