From f6f40200bbd4ce420c01703fd9950faccae6cf8e Mon Sep 17 00:00:00 2001 From: USAMI Kenta Date: Thu, 17 Oct 2024 03:11:51 +0900 Subject: [PATCH] Add composer-list feature --- README.org | 1 + composer-list.el | 182 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 183 insertions(+) create mode 100644 composer-list.el diff --git a/README.org b/README.org index 9b6896d..00fb588 100644 --- a/README.org +++ b/README.org @@ -25,6 +25,7 @@ See [[https://getcomposer.org/doc/][Composer Documentation]]. =composer.el= sup | =M-x composer-run-vendor-bin-command= | Run =command= in =vendor/bin= | | =M-x composer-find-json-file= | Open =composer.json= of the project | | =M-x composer-view-lock-file= | Open =composer.lock= of the project (as read-only) | +| =M-x composer-list-packages= | Open the list of packages for the project | ** API *** Function =composer-get-config(name)= diff --git a/composer-list.el b/composer-list.el new file mode 100644 index 0000000..f991704 --- /dev/null +++ b/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 +;; 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 . + +;;; 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) + +(defvar composer-list--load-no-latest nil) + +(define-derived-mode composer-list-mode tabulated-list-mode "Composer packages" + "Major mode for Composer list 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) + (let ((composer-list--load-no-latest t)) + (composer-list--refresh-packages)) + (tabulated-list-print)) + +(defun composer-list--load-packages () + "List `composer' sub commands." + (let ((output (if composer-list--load-no-latest + (composer--command-execute "show" "--locked" "--format=json") + (composer--command-execute "show" "--latest" "--all" "--format=json")))) + (cdr-safe (assq 'locked (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 (or (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 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