From 67c5c988fa90d6b7314fd80d7466e05f9383aea8 Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Mon, 17 Sep 2018 17:38:08 +0200 Subject: [PATCH] Abstract package manager interface For now, only implement the new interface for Guix. We make sure to keep backward compatibility with the old interface for the other package managers. --- helm-system-packages-guix.el | 34 +++++------------- helm-system-packages.el | 67 ++++++++++++++++++++++++++++++++++-- 2 files changed, 74 insertions(+), 27 deletions(-) diff --git a/helm-system-packages-guix.el b/helm-system-packages-guix.el index 2a1c075..de76c58 100644 --- a/helm-system-packages-guix.el +++ b/helm-system-packages-guix.el @@ -301,31 +301,15 @@ Otherwise display in `helm-system-packages-buffer'." :group 'helm-system-packages :type '(alist :key-type string :value-type function)) -(defun helm-system-packages-guix-build-source () - "Build Helm source for guix" - (let ((title (or (plist-get (helm-system-packages--cache-get) :title) "package manager"))) - (helm-build-in-buffer-source title - :init 'helm-system-packages-init - :candidate-transformer 'helm-system-packages-guix-transformer - :candidate-number-limit helm-system-packages-candidate-limit - :display-to-real 'helm-system-packages-extract-name - :keymap helm-system-packages-guix-map - :help-message 'helm-system-packages-guix-help-message - :persistent-help "Show package description" - :action helm-system-packages-guix-actions))) - -(defun helm-system-packages-guix () - "Preconfigured `helm' for guix." - ;; Guix can be installed beside another package manager. Let's make this - ;; command directly accessible then so that both the original package manager - ;; and Guix can be called. - (interactive) - (unless (helm-system-packages-missing-dependencies-p "guix" "recsel") - (helm :sources (helm-system-packages-guix-build-source) - :buffer "*helm guix*" - :truncate-lines t - :input (when helm-system-packages-use-symbol-at-point-p - (substring-no-properties (or (thing-at-point 'symbol) "")))))) +(defvar helm-system-packages-guix + (helm-system-packages-manager-create + :name "guix" + :refresh-function #'helm-system-packages-guix-refresh + :dependencies '("guix" "recsel") + :help-message 'helm-system-packages-guix-help-message + :keymap helm-system-packages-guix-map + :transformer #'helm-system-packages-guix-transformer + :actions helm-system-packages-guix-actions)) (provide 'helm-system-packages-guix) diff --git a/helm-system-packages.el b/helm-system-packages.el index eff9530..7e65ad0 100644 --- a/helm-system-packages.el +++ b/helm-system-packages.el @@ -60,6 +60,7 @@ (require 'tramp) (require 'tramp-sh) (require 'helm) +(require 'cl-lib) (defvar helm-system-packages-shell-buffer-name "helm-system-packages-eshell") (defvar helm-system-packages-eshell-buffer (concat "*" helm-system-packages-shell-buffer-name "*")) @@ -277,6 +278,22 @@ EXTRA is an arbitrary prop-val sequence appended to the resulting plist." (plist-get val :descriptions) (plist-get val :names))))) +(defun helm-system-packages--make-init (manager) + "Cache package lists and create Helm buffer." + (lambda () + (let ((val (helm-system-packages--cache-get))) + (unless val + (funcall (helm-system-packages-manager-refresh-function manager)) + (setq val (helm-system-packages--cache-get))) + ;; TODO: We should only create the buffer if it does not already exist. + ;; On the other hand, we need to be able to override the package list. + ;; (unless (helm-candidate-buffer) ... + (helm-init-candidates-in-buffer + 'global + (if helm-system-packages-show-descriptions-p + (plist-get val :descriptions) + (plist-get val :names)))))) + (defun helm-system-packages-mapalist (fun-alist alist) "Apply each function of FUN-ALIST to the list with the same key in ALIST. Return the alist of the results. @@ -574,6 +591,39 @@ TITLE is the name of the Helm session." (message "Dependencies are missing (%s), please install them" (mapconcat 'identity missing-deps ", "))))) +(cl-defstruct (helm-system-packages-manager + (:constructor nil) + (:copier nil) + (:constructor helm-system-packages-manager-create)) + "Package manager interface. + +DEPENDENCIES is a list of strings of external executables +required by the package manager. + +HELP-MESSAGE, KEYMAP, TRANSFORMER and ACTIONS are as specified by +`helm-build-in-buffer-source'." + name + refresh-function + dependencies + ;; Helm source parameters follow: + help-message + keymap + transformer + actions) + +(defun helm-system-packages-build-source (manager) + "Build Helm source for MANAGER." + (let ((title (or (plist-get (helm-system-packages--cache-get) :title) "package manager"))) + (helm-build-in-buffer-source title + :init (helm-system-packages--make-init manager) + :candidate-transformer (helm-system-packages-manager-transformer manager) + :candidate-number-limit helm-system-packages-candidate-limit + :display-to-real 'helm-system-packages-extract-name + :keymap (helm-system-packages-manager-keymap manager) + :help-message (helm-system-packages-manager-help-message manager) + :persistent-help "Show package description" + :action (helm-system-packages-manager-actions manager)))) + ;;;###autoload (defun helm-system-packages () "Helm user interface for system packages." @@ -596,8 +646,21 @@ TITLE is the name of the Helm session." "No supported package manager was found.")) (let ((manager (car (last (car managers))))) (require (intern (concat "helm-system-packages-" manager))) - (fset 'helm-system-packages-refresh (intern (concat "helm-system-packages-" manager "-refresh"))) - (funcall (intern (concat "helm-system-packages-" manager))))))) + (if (boundp (intern (concat "helm-system-packages-" manager))) + ;; New abstraction. + (let ((current-manager + (symbol-value (intern (concat "helm-system-packages-" manager))))) + (unless (apply 'helm-system-packages-missing-dependencies-p + (helm-system-packages-manager-dependencies current-manager)) + (helm :sources (helm-system-packages-build-source current-manager) + :buffer (format "*helm %s*" (helm-system-packages-manager-name + current-manager)) + :truncate-lines t + :input (when helm-system-packages-use-symbol-at-point-p + (substring-no-properties (or (thing-at-point 'symbol) "")))))) + ;; Old abstraction. + (fset 'helm-system-packages-refresh (intern (concat "helm-system-packages-" manager "-refresh"))) + (funcall (intern (concat "helm-system-packages-" manager)))))))) (provide 'helm-system-packages)