Add composer-list feature

Author: zonuexe

Diff for: composer-list.el

@@ -0,0 +1,182 @@
+;;; composer-list.el --- Interface for viewing and manipulating composer packages -*- lexical-binding: t -*-
+
+;; Copyright (C) 2024  Friends of Emacs-PHP development
+
+;; Author: USAMI Kenta <[email protected]>
+;; Created: 15 June 2024
+;; Version: 0.2.0
+;; Keywords: tools php dependency manager
+;; Homepage: https://github.com/zonuexe/composer.el
+;; Package-Requires: ((emacs "25.1") (seq "1.9") (php-runtime "0.1.0"))
+;; License: GPL-3.0-or-later
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Interface for viewing and manipulating composer packages.
+
+;;; Code:
+(require 'tabulated-list)
+(require 'composer)
+(require 'php-project nil t)
+(require 'package)
+
+(defgroup composer-list nil
+  "Interface to PHP Composer."
+  :group 'composer-list
+  :tag "Composer List"
+  :prefix "composer-list-")
+
+(defcustom composer-list-name-column-width 30
+  "Column width for the Package name in the composer list."
+  :type 'natnum
+  :group 'composer-list)
+
+(defcustom composer-list-version-column-width 14
+  "Column width for the Package version in the composer list."
+  :type 'natnum
+  :group 'composer-list)
+
+(defcustom composer-list-status-column-width 12
+  "Column width for the Package status in the composer list."
+  :type 'natnum
+  :group 'composer-list)
+
+(define-derived-mode composer-list-mode tabulated-list-mode "Composer packages"
+  "."
+  :interactive nil
+  (setq-local buffer-stale-function
+              (lambda (&optional _noconfirm) 'fast))
+  (setq tabulated-list-format
+        `[("Package" ,composer-list-name-column-width t)
+          ("Version" ,composer-list-version-column-width t)
+          ("Latest" ,composer-list-version-column-width t)
+          ("Status"  ,composer-list-status-column-width  t)
+          ("Description" 0 package-menu--description-predicate)])
+  (setq tabulated-list-padding 2)
+  (add-hook 'tabulated-list-revert-hook #'composer-list--refresh-packages nil t)
+  (tabulated-list-init-header)
+  (composer-list--refresh-packages)
+  (tabulated-list-print))
+
+(defun composer-list--load-packages ()
+  "List `composer' sub commands."
+  (let ((output (composer--command-execute "show" "--latest" "--all" "--format=json")))
+    (cdr-safe (assq 'locked (composer--parse-json-string output)))))
+
+(defun composer-list--load-outdated ()
+  "List `composer' sub commands."
+  (let ((output (composer--command-execute "outdated" "--format=json")))
+    (cdr-safe (assq 'installed (composer--parse-json-string output)))))
+
+(defun composer-list--ensure-bool (value)
+  "Ensure that the provided VALUE is a boolean.
+If VALUE is :false or nil, return nil.
+If VALUE is :true, return t.
+Otherwise, if VALUE is already a boolean, return it as is."
+  (cond
+   ((or (eq :false value) (null value)) nil)
+   ((eq :true value) t)
+   ((booleanp value) value)))
+
+(defun composer-list--ensure-string (value)
+  "Ensure that the provided VALUE is a string.
+If VALUE is :null or NIL, return an empty string \"\".
+If VALUE is already a string, return it as is.
+If VALUE is a number, convert it to a string using `number-to-string'."
+  (cond
+   ((or (eq :null value) (null value)) "")
+   ((stringp value) value)
+   ((numberp value) (number-to-string value))))
+
+(defun composer-list--print-info (pkg)
+  "Return a PKG package entry suitable for `tabulated-list-entries'."
+  (let* ((latest-status (alist-get 'latest-status pkg))
+         (face (pcase latest-status
+                 ("update-possible" 'error)
+                 ("semver-safe-update" 'warning)
+                 ("up-to-date" 'success)))
+         (name (alist-get 'name pkg))
+         (version (alist-get 'version pkg))
+         (direct (composer-list--ensure-bool (alist-get 'direct-dependency pkg)))
+         (latest (alist-get 'latest pkg))
+         (warning (composer-list--ensure-bool (alist-get 'warning pkg)))
+         (abandoned (alist-get 'warning pkg))
+         (status (cond (abandoned "abandoned")
+                       ((not direct) "dependency")
+                       ("installed")))
+         (desc (composer-list--ensure-string (alist-get 'description pkg)))
+         (entry `[(,name
+                    face link
+                    font-lock-face link
+                    follow-link t
+                    package-desc ,name
+                    action composer-list-describe-package)
+                  ,version
+                  ,(if face (propertize (or latest "") 'font-lock-face face) latest)
+                  ,(if warning (propertize status 'font-lock-face 'error) status)
+                  ,desc]))
+    (list name entry)))
+
+(defun composer-list--refresh-packages ()
+  "Setup for `tabulated-list-format'."
+  (let ((packages (composer-list--load-packages)))
+    (tabulated-list-init-header)
+    (setq tabulated-list-entries (seq-map #'composer-list--print-info packages))))
+
+(define-derived-mode composer-list-describe-mode text-mode "Composer-pkg"
+  "Major mode for viewing PsySH Doc."
+  (setq show-trailing-whitespace nil)
+  (goto-address-mode +1)
+  (read-only-mode +1))
+
+(defun composer-list-describe-package (package)
+  "Display the full information of PACKAGE."
+  (interactive (list (or (tabulated-list-get-id)
+                         (completing-read
+                          "Composer package: "
+                          (let ((composer-use-ansi-color nil))
+                            (split-string (composer--command-execute "show" "--name-only")))))))
+  (let* ((buf (get-buffer-create "*Composer-pkg*"))
+         (composer-use-ansi-color t)
+         (command (composer--make-command-string "show" (list package "--ansi"))))
+    (with-current-buffer buf
+      (composer-list-describe-mode)
+      (let ((default-directory (composer--find-composer-root default-directory))
+            (buffer-read-only nil)
+            (composer--quote-shell-argument t)
+            pos)
+        (erase-buffer)
+        (insert command "\n\n")
+        (setq pos (point))
+        (shell-command command (current-buffer))
+        (ansi-color-apply-on-region pos (point-max))))
+    (pop-to-buffer-same-window buf)))
+
+;;;###autoload
+(defun composer-list-packages (directory)
+  "Display a list of packages in DIRECTORY."
+  (interactive
+   (list (read-directory-name "Composer Directory: " (composer--find-composer-root default-directory))))
+  (let* ((default-directory (composer--find-composer-root directory))
+         (buf (get-buffer-create (format "*Composer: %s*" default-directory))))
+    (with-current-buffer buf
+      (composer-list-mode))
+    (pop-to-buffer-same-window buf)))
+
+(provide 'composer-list)
+;;; composer-list.el ends here