;;; helm-system-packages-portage.el --- Helm UI for Portage. -*- lexical-binding: t -*-

;; Copyright (C) 2017 ~ 2020 Pierre Neidhardt <mail@ambrevar.xyz>
;;               2020 ~ 2026 Thierry Volpiatto <thievol@posteo.net>

;; Author: Thierry Volpiatto <thievol@posteo.com>
;; Maintainer: Pierre Neidhardt <mail@ambrevar.xyz>
;; URL: https://github.com/emacs-helm/helm-system-packages

;; 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 <http://www.gnu.org/licenses/>.

;;; Commentary:
;; Helm UI for Portage.

;;; Code:
(require 'helm-system-packages)

(defvar helm-system-packages-portage-help-message
  "* Helm Portage

** Commands
\\<helm-system-packages-portage-map>
\\[helm-system-packages-portage-toggle-explicit]\t\tToggle display of explicitly installed packages.
\\[helm-system-packages-portage-toggle-uninstalled]\t\tToggle display of non-installed.
\\[helm-system-packages-portage-toggle-dependencies]\t\tToggle display of dependencies.
\\[helm-system-packages-toggle-descriptions]\t\tToggle display of package descriptions.")

(defvar helm-system-packages-portage--show-uninstalled-p t)
(defvar helm-system-packages-portage--show-explicit-p t)
(defvar helm-system-packages-portage--show-dependencies-p t)

(defvar helm-system-packages-portage-map
  ;; M-U is reserved for `helm-unmark-all'.
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map helm-map)
    (define-key map (kbd "M-I")   'helm-system-packages-toggle-explicit)
    (define-key map (kbd "M-N")   'helm-system-packages-toggle-uninstalled)
    (define-key map (kbd "M-D")   'helm-system-packages-toggle-dependencies)
    (define-key map (kbd "C-]")   'helm-system-packages-toggle-descriptions)
    map))

(defun helm-system-packages-portage-transformer (packages)
  (let (res (pkglist (reverse packages)))
    (dolist (p pkglist res)
      (let ((face (cdr (assoc (helm-system-packages-extract-name p)
                              (plist-get (helm-system-packages--cache-get) :filtered)))))
        (cond
         ((and (not face) helm-system-packages--show-uninstalled-p)
          (push p res))
         ((or
           (and helm-system-packages--show-explicit-p (memq 'helm-system-packages-explicit face))
           (and helm-system-packages--show-dependencies-p (memq 'helm-system-packages-dependencies face)))
          (push (propertize p 'face (car face)) res)))))))

(defun helm-system-packages-portage-list-explicit ()
  "List explicitly installed packages."
  (with-temp-buffer
    (insert-file-contents-literally "/var/lib/portage/world")
    (split-string (buffer-string))))

(defun helm-system-packages-portage-list-dependencies (&optional explicit)
  "List packages installed as a required dependency.
The caller can pass the list of EXPLICIT packages to avoid re-computing it."
  (cl-loop with seq1 = (with-temp-buffer
                         (process-file
                          "qlist" nil t nil "-I")
                         (buffer-string))
           with seq2 = (or explicit
                           (helm-system-packages-portage-list-explicit))
           for elm in seq1
           unless (member elm seq2)
           collect elm))

(defun helm-system-packages-portage-cache (display-list)
  "Cache all package names with descriptions."
  (let* ((raw (with-temp-buffer
                ;; TODO: Can eix pad in the format string just like `expac' does?
                ;; TODO: Or output straight to Elisp?
                (process-file "env" nil '(t nil) nil
                              "EIX_LIMIT=0" "OVERLAYS_LIST=none" "PRINT_COUNT_ALWAYS=never"
                              "eix" "--format" "<category>/<name>\t<description>\n")
                (sort-lines nil (point-min) (point-max))
                (buffer-string)))
         (paired (mapcar (lambda (x) (let ((l (split-string x "\t"))) (cons (car l) (cadr l))))
                         (split-string raw "\n")))
         (names (mapcar 'car paired))
         (descriptions (mapcar (lambda (x)
                                 (concat (car x)
                                         (make-string
                                          (max (- helm-system-packages-column-width
                                                  (length (car x)))
                                               0)
                                          ? )
                                         (cdr x)))
                               paired)))
    (helm-system-packages--cache-set names descriptions display-list "portage")))

(defcustom helm-system-packages-portage-column-width 40
  "Column at which descriptions are aligned, excluding a double-space gap.
If nil, then use `helm-system-packages-column-width'."
  :group 'helm-system-packages
  :type 'integer)

(defun helm-system-packages-portage-refresh ()
  "Refresh the package list."
  (interactive)
  (setq helm-system-packages-column-width
        (or helm-system-packages-portage-column-width
            helm-system-packages-column-width))
  (let ((explicit (helm-system-packages-portage-list-explicit))
        (dependencies (helm-system-packages-portage-list-dependencies))
        display-list)
    (dolist (p explicit)
      (push (cons p '(helm-system-packages-explicit)) display-list))
    (dolist (p dependencies)
      (push (cons p '(helm-system-packages-dependencies)) display-list))
    (helm-system-packages-portage-cache display-list)))

(defcustom helm-system-packages-portage-actions
  '(("Show package(s)" .
     (lambda (_)
       (helm-system-packages-print "eix")))
    ("Install (`C-u' to not add to world)" .
     (lambda (_)
       (helm-system-packages-run-as-root "emerge" "--ask" "--verbose" (when helm-current-prefix-arg "--oneshot"))))
    ("Uninstall (`C-u' to include dependencies)" .
     (lambda (_)
       (helm-system-packages-run-as-root-over-installed "emerge" "--ask" "--verbose" (if helm-current-prefix-arg "--depclean" "--unmerge"))))
    ("Browse homepage URL" .
     (lambda (_)
       (helm-system-packages-browse-url (split-string (helm-system-packages-run "eix" "--format" "<homepage>\n") "\n" t))))
    ("Find files" .
     (lambda (_)
       (helm-system-packages-print "equery" "files")))
    ("Show dependencies" .
     (lambda (_)
       (helm-system-packages-print "equery" "depgraph")))
    ("Show reverse dependencies" .
     (lambda (_)
       (helm-system-packages-print "equery" "--no-color" "depends")))
    ("Emerge-pretend" .
     (lambda (_)
       (helm-system-packages-print "emerge" "--pretend")))
    ("Show history" .
     (lambda (_)
       (helm-system-packages-print "genlop" "-qe")))
    ("Show extra info" .
     (lambda (_)
       (helm-system-packages-print "genlop" "-qi")))
    ("Show USE flags" .
     (lambda (_)
       (helm-system-packages-print "equery" "--no-color" "uses")
       ;; TODO: Test font-lock.
       (unless helm-current-prefix-arg
         (font-lock-add-keywords nil '(("^\+.*" . font-lock-variable-name-face)))
         (font-lock-mode 1)))))
  "Actions for Helm portage."
  :group 'helm-system-packages
  :type '(alist :key-type string :value-type function))

(defun helm-system-packages-portage-use-init ()
  "Initialize buffer with all USE flags."
  (unless (helm-candidate-buffer)
    (let ((local-uses (with-temp-buffer
                        (process-file "portageq" nil t nil "envvar" "USE")
                        (split-string (buffer-string)))))
      (helm-init-candidates-in-buffer
          'global
        (mapcar (lambda (use-flag)
                  (propertize
                   use-flag 'face
                   (if (member use-flag local-uses)
                       'helm-system-packages-explicit 'default)))
                (with-temp-buffer
                  (process-file "eix" nil t nil "--print-all-useflags")
                  (split-string (buffer-string))))))))

(defcustom helm-system-packages-portage-use-actions
  '(("Description" .
     (lambda (elm)
       (switch-to-buffer helm-system-packages-buffer)
       (erase-buffer)
       (apply #'process-file "euse" nil t nil `("--info" ,elm))
       (font-lock-add-keywords nil `((,elm . font-lock-variable-name-face)))
       (font-lock-mode 1)))
    ("Enable" .
     (lambda (_)
       (helm-system-packages-run-as-root "euse" "--enable")))
    ("Disable" .
     (lambda (_)
       (helm-system-packages-run-as-root "euse" "--disable")))
    ("Remove" .
     (lambda (_)
       (helm-system-packages-run-as-root "euse" "--prune")))
    ("Show which dependencies use this flag" .
     (lambda (_)
       (helm-system-packages-print "equery" "--no-color" "hasuse"))))
  "Actions for Helm portage USE flags."
  :group 'helm-system-packages
  :type '(alist :key-type string :value-type function))

(defvar helm-system-packages-portage-use-source
  (helm-build-in-buffer-source "USE flags"
    :init 'helm-system-packages-portage-use-init
    :help-message 'helm-system-packages-portage-help-message
    :action helm-system-packages-portage-use-actions))

(defvar helm-system-packages-portage-dependencies
  '("emerge" "eix" "qlist" "euse" "portageq" "genlop"))
(defvar helm-system-packages-portage
  (helm-system-packages-manager-create
   :name "dpkg"
   :refresh-function #'helm-system-packages-portage-refresh
   :dependencies helm-system-packages-portage-dependencies
   :help-message 'helm-system-packages-portage-help-message
   :keymap helm-system-packages-portage-map
   :transformer #'helm-system-packages-portage-transformer
   :actions helm-system-packages-portage-actions
   :extra-source 'helm-system-packages-portage-use-source))

(provide 'helm-system-packages-portage)

;;; helm-system-packages-portage.el ends here
