[patch] Optionally enable reasonable defaults for running ebuild command

file_816354.txt (text/plain), 7.58 KB, created by akater on 2021-10-05 06:03:45 UTC

From 2c2debabc07d28f73c07bca8fcc2d74a3136331d Mon Sep 17 00:00:00 2001
From: akater <[e-mail]>
Date: Thu, 30 Sep 2021 21:54:53 +0000
Subject: [PATCH] Optionally enable reasonable defaults for running ebuild
 command

Signed-off-by: Dmitrii Neskoromnyi <[e-mail]>
---
 ebuild-mode.el | 141 ++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 140 insertions(+), 1 deletion(-)

diff --git a/ebuild-mode.el b/ebuild-mode.el
index 3ec3347..a3ee206 100644
--- a/ebuild-mode.el
+++ b/ebuild-mode.el
@@ -357,6 +357,137 @@ Optional argument LIMIT restarts collection after that number of elements."
   "Major mode for the log buffer of `ebuild-run-command'.
 If nil, `compilation-mode' will be used.")
 
+(eval-when-compile
+  (defmacro emacs-ecase (&rest clauses)
+    "Dispatch on emacs version with ecase-like syntax at compile-time."
+    (declare (indent 0))
+    (let* ((sublist clauses) (body nil) (version-spec nil) (no-match t)
+           result)
+      (while
+          (and sublist
+               (progn
+                 (setq body (car sublist)
+                       version-spec (pop body))
+                 (if (eval (cond
+                            ((eq 'otherwise version-spec)
+                             (error
+                              "‘otherwise’-clauses are not allowed in ecase"))
+                            ((eq 'xemacs version-spec) `(featurep 'xemacs))
+                            ((numberp version-spec)
+                             `(= ,version-spec emacs-major-version))
+                            ((and (consp version-spec)
+                                  (numberp (car version-spec))
+                                  (numberp (cdr version-spec)))
+                             `(<= ,(car version-spec)
+                                  emacs-major-version
+                                  ,(cdr version-spec)))
+                            ((memq (car version-spec) '(> < >= <= = ≥ ≤))
+                             `(,(car version-spec)
+                               emacs-major-version
+                               ,@(cdr version-spec)))
+                            (t (error "Unrecognised emacs version-spec %s"
+                                      version-spec))))
+                     (setq result (if (cdr body) `(progn ,@body)
+                                    (car body))
+                           no-match nil)
+                   t)))
+        (pop sublist))
+      (if no-match
+          (error "emacs-ecase failed: emacs version does not match %s"
+                 (mapcar #'car clauses))
+        result))))
+
+(emacs-ecase
+  ;; We must require tramp separately
+  ;; so that with-parsed-tramp-file-name can be macroexpanded in the next form.
+  (xemacs)
+  ((< 24))
+  ((>= 24) (require 'tramp)))
+
+(emacs-ecase
+  (xemacs)
+  ((< 24))
+  ((>= 24)
+   (defcustom ebuild-run-as-portage-or-root nil
+     "When non-nil, adjust user of `ebuild-run-command':
+
+Run as root: merge, install, postinst, preinst,
+             unmerge, postrm, prerm,
+             config, package, qmerge
+
+Run as current user: manifest, digest, help
+
+Run as portage: (everything else)"
+     :type 'boolean
+     :group 'ebuild)
+
+   (emacs-ecase
+     ((24 . 25)
+      (defconst ebuild-run-tramp-method "sudo"
+        "Tramp method to employ for the user adjustment
+enabled by `ebuild-run-as-portage-or-root'.
+
+Not supposed to be customized in this version of GNU Emacs"))
+     ((>= 26)
+      (defcustom ebuild-run-tramp-method "sudo"
+        "Tramp method to employ for the user adjustment
+enabled by `ebuild-run-as-portage-or-root'."
+        :type '(choice (const "sudo") (const "doas"))
+        :group 'ebuild)))
+
+   (defun ebuild--run-default-directory (command)
+     "Return the value of `default-directory' most appropriate to
+conveniently run ebuild command COMMAND, presuming the ebuild
+script in question is located in (the current)
+`default-directory'.
+
+If `ebuild-run-as-portage-or-root' is nil, always return
+`default-directory'."
+     (let ((root-commands '("merge" "install" "postinst" "preinst"
+                            "unmerge" "postrm" "prerm"
+                            ;; TODO: Maybe rpm should be listed here too.
+                            "config" "package" "qmerge"))
+           (default-user-commands '("manifest" "digest" "help")))
+       (cond ((or (not ebuild-run-as-portage-or-root)
+                  (member command default-user-commands))
+              default-directory)
+             ((not (tramp-tramp-file-p default-directory))
+              (concat "/" ebuild-run-tramp-method
+                      ":" (if (member command root-commands) "root"
+                            "portage")
+                      "@" tramp-default-host
+                      ":" default-directory))
+             (t
+              (emacs-ecase
+                ((24 . 25)
+                 (with-parsed-tramp-file-name default-directory ebuild-dir
+                   (setf ebuild-dir-user
+                         (if (member command root-commands) "root"
+                           "portage"))
+                   (tramp-make-tramp-file-name ebuild-dir-method
+                                               ebuild-dir-user
+                                               ebuild-dir-host
+                                               ebuild-dir-localname
+                                               ebuild-dir-hop)))
+                (26
+                 (with-parsed-tramp-file-name default-directory ebuild-dir
+                   (setf ebuild-dir-user
+                         (if (member command root-commands) "root"
+                           "portage"))
+                   (tramp-make-tramp-file-name ebuild-dir-method
+                                               ebuild-dir-user
+                                               ebuild-dir-domain
+                                               ebuild-dir-host
+                                               ebuild-dir-port
+                                               ebuild-dir-localname
+                                               ebuild-dir-hop)))
+                ((> 26)
+                 (with-parsed-tramp-file-name default-directory ebuild-dir
+                   (setf (tramp-file-name-user ebuild-dir)
+                         (if (member command root-commands) "root"
+                           "portage"))
+                   (tramp-make-tramp-file-name ebuild-dir))))))))))
+
 (defun ebuild-run-command (command)
   "Run ebuild COMMAND, with output to a compilation buffer."
   (interactive
@@ -365,7 +496,15 @@ If nil, `compilation-mode' will be used.")
 			  nil t)))
   (or (member command ebuild-commands-list)
       (error "Ebuild command \"%s\" not known" command))
-  (let* ((file (file-relative-name buffer-file-name))
+  (let* ((preserved-directory
+          ;; Preserve directory for more tidy command in the ebuild-run buffer
+          default-directory)
+         (default-directory (emacs-ecase
+                              (xemacs default-directory)
+                              ((< 24) default-directory)
+                              ((>= 24) (ebuild--run-default-directory
+                                        command))))
+         (file (file-relative-name buffer-file-name preserved-directory))
 	 (shell-command (format "ebuild %s %s" file command))
 	 (process-environment (cons "NOCOLOR=true" process-environment))
 	 ;;(compilation-mode-hook (lambda () (setq truncate-lines t)))
-- 
2.32.0