gentoo.el (6892B)
1 ;;; gentoo.el --- Portage interface for Emacs. 2 3 ;;; Commentary: 4 ;; 5 ;; This is a minimal package that I threw together late one night to let me 6 ;; use most of what I need from Portage from within Emacs. It's pretty nice! 7 8 (require 'dash) 9 (require 'eat) 10 (require 'consult) 11 12 ;;; Code: 13 14 (defvar gentoo--eix-format 15 "<category>/<name>|<description>|{havebest}<bestversion:NAMEVERSION>{else}none\n{}" 16 "Format string passed to eix --format flag.") 17 18 (defvar gentoo-display-padding 60 19 "Padding between package names and info.") 20 (defvar gentoo-gap-padding 10 21 "Padding between various pieces of package info.") 22 (defvar gentoo-emerge-ask nil 23 "Whether or not to run emerge with --ask.") 24 (defvar gentoo-portage-use-file "/etc/portage/package.use" 25 "File path of the portage package.use file.") 26 (defvar gentoo-portage-accept-file "/etc/portage/package.accept_keywords/xcape" 27 "File path of the portage package.accept_keywords file.") 28 (defvar gentoo-cmd-display-type 'eat 29 "What to use to run commands. 30 Possible values are \\='eat (for using the EAT package) or 31 \\='compile (for using \\[compile]).") 32 33 (defgroup gentoo nil 34 "Use portage from Emacs." 35 :group 'convenience 36 :group 'minibuffer 37 :group 'consult 38 :prefix "gentoo-") 39 40 (defface gentoo-use-stop 41 '((t (:inherit default :foreground "green"))) 42 "Face to display DONE option.") 43 44 (defface gentoo-use-enabled 45 '((t (:inherit default :foreground "red"))) 46 "Face to display enabled USE flags.") 47 48 (defface gentoo-use-disabled 49 '((t (:inherit default :foreground "cyan"))) 50 "Face to display disabled USE flags.") 51 52 (defun gentoo--table-from-lists (keypairs) 53 "Create a hash table given list of kv pairs KEYPAIRS." 54 (let ((table (make-hash-table :test #'equal))) 55 (dolist (x keypairs) 56 (puthash (car x) (cdr x) table)) 57 table)) 58 59 (defun gentoo--build-package-dict (&optional installed) 60 "Create hash table of possibly INSTALLED packages by querying eix." 61 (let* ((cmd (format "EIX_LIMIT_COMPACT=0 eix -Sc%s --format '%s'" 62 (if installed "I" "") ;; HACK 63 gentoo--eix-format)) 64 (pkgs (butlast (split-string (shell-command-to-string cmd) "\n")))) 65 (gentoo--table-from-lists 66 (--filter (> (length it) 1) (--map (split-string it "|") pkgs))))) 67 68 (defun gentoo--query-packages-annotate (cand info) 69 "Annotator function for `consult--read' for package CAND and its INFO." 70 ;; TODO fix this gross hack of a meta format string 71 (let ((fmtstr (format "%%%ds%%%ds%%s" (- gentoo-display-padding (length cand)) gentoo-gap-padding))) 72 (format fmtstr (cadr info) "" (car info)))) 73 74 (defun gentoo--query-packages (&optional &key prompt &key installed) 75 "Interactively query possibly INSTALLED gentoo packages with a given PROMPT." 76 (let* ((table (gentoo--build-package-dict installed)) 77 (sel 78 (consult--read 79 table 80 :prompt (if prompt prompt "Select: ") 81 :annotate (lambda (x) (gentoo--query-packages-annotate x (gethash x table)))))) 82 (list sel (string= (cadr (gethash sel table)) "none")))) 83 84 (defun gentoo--get-useflags (pkg) 85 "Get USE flags for Gentoo package PKG using equery." 86 (let ((uses (split-string (shell-command-to-string (format "equery -N -C uses %s" pkg)) "\n")) 87 (rgx (rx (seq " " (group (or "+" "-")) " " (or "+" "-") " " 88 (group (one-or-more (or alnum "_" "-" "/"))) 89 (zero-or-more blank) ": " (group (zero-or-more any)))))) 90 (gentoo--table-from-lists 91 (-non-nil (-map (lambda (x) 92 (if (string-match rgx x) 93 (list (match-string 2 x) (equal (match-string 1 x) "+") (match-string 3 x)))) 94 uses))))) 95 96 (defun gentoo--query-useflags-annotate (cand info) 97 "Annotator function for `consult--read' for USE flag CAND and its INFO." 98 ;; TODO fix this cursed evil hack of a meta format string 99 (let ((fmtstr (format "%%%ds%%s" (- gentoo-display-padding (length cand))))) 100 (if (not info) (list (propertize cand 'face 'gentoo-use-stop) "" "") 101 (list (if (car info) 102 (propertize cand 'face 'gentoo-use-enabled) 103 (propertize cand 'face 'gentoo-use-disabled)) 104 (if (car info) "+" "-") (format fmtstr "" (cadr info)))))) 105 106 (defun gentoo--ask-useflags (table pkg) 107 "Interactively query USE flags of PKG given TABLE of USE flags." 108 (let ((x (consult--read 109 (cons "_DONE_" (map-keys table)) 110 :prompt "Toggle USE flags: " 111 :annotate (lambda (x) (gentoo--query-useflags-annotate x (gethash x table)))))) 112 (unless (string= x "_DONE_") 113 (puthash x (list (not (car (gethash x table))) (cadr (gethash x table))) table) 114 (gentoo--ask-useflags table pkg)))) 115 116 (defun gentoo--set-useflags (pkg) 117 "Interactively query and set USE flags of package PKG." 118 (let* ((flags (gentoo--get-useflags pkg)) 119 (default (copy-hash-table flags))) 120 (if (> (hash-table-count flags) 0) (gentoo--ask-useflags flags pkg)) 121 (let* ((diffs (-non-nil (map-apply (lambda (k v) 122 (if (not (eq (car (gethash k default)) (car v))) 123 (concat (if (car v) "" "-") k))) flags))) 124 (path (concat "/sudo::" gentoo-portage-use-file)) 125 (rgx (rx-to-string `(seq ,pkg (zero-or-more any)) t)) 126 (defn (format "%s %s" pkg (mapconcat (lambda (x) x) diffs " ")))) 127 (with-temp-buffer 128 (insert-file-contents path) 129 (if (string-match rgx (buffer-string)) 130 (replace-regexp rgx defn) 131 (progn (end-of-buffer) (insert (concat defn "\n")))) 132 (write-region (point-min) (point-max) path))))) 133 134 (defun gentoo--unmask-pkg (pkg) 135 "Unmask package PKG by editing file at `gentoo-portage-accept-file'." 136 (if (y-or-n-p (format "Unmask %s?" pkg)) 137 (write-region (concat pkg "\n") 138 nil (concat "/sudo::" gentoo-portage-accept-file) 'append))) 139 140 (defun gentoo--run-cmd (command &optional withsudo) 141 "Run command COMMAND possibly WITHSUDO using method in `gentoo-cmd-display-type'." 142 (let ((default-directory (if withsudo "/sudo::" default-directory)) 143 (inhibit-read-only t) 144 (eat-buffer-name "*emerge*") 145 (compilation-buffer-name-function (lambda (_) "*emerge*")) 146 (compilation-environment (if (eq gentoo-cmd-display-type 'compile) '("NO_COLOR=1")))) 147 (if (eq gentoo-cmd-display-type 'eat) 148 (eat command) (compile command)))) 149 150 (defun gentoo-install-pkg () 151 "Install a package via emerge and set its USE flags." 152 (interactive) 153 (let* ((pkgi (gentoo--query-packages)) 154 (pkg (car pkgi)) (masked (cadr pkgi))) 155 (when (or (not masked) (and masked (gentoo--unmask-pkg pkg))) 156 (gentoo--set-useflags pkg) 157 (gentoo--run-cmd (format "emerge %s %s" (if gentoo-emerge-ask "--ask" "") pkg) t)))) 158 159 (defun gentoo-depclean () 160 "Run emerge --depclean and remove unused packages." 161 (interactive) 162 (gentoo--run-cmd "emerge --depclean" t)) 163 164 (defun gentoo-deselect () 165 "Interactively query a package to remove from @world." 166 (interactive) 167 (let ((pkg (car (gentoo--query-packages :prompt "Deselect: " :installed t)))) 168 (gentoo--run-cmd (format "emerge --deselect %s" pkg) t))) 169 170 (provide 'gentoo) 171 ;;; gentoo.el ends here 172 173