From 1d07decd4b69af21af382d697e3b79e48efc23d1 Mon Sep 17 00:00:00 2001
From: akater <nuclearspace@gmail.com>
Date: Mon, 21 Sep 2020 09:03:11 +0000
Subject: [PATCH] Provide ebuild-run-mode and employ it in ebuild-run-command
Signed-off-by: Dmitrii Neskoromnyi <nuclearspace@gmail.com>
---
ebuild-mode.el | 4 +-
ebuild-run-mode.el | 361 +++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 364 insertions(+), 1 deletion(-)
create mode 100644 ebuild-run-mode.el
diff --git a/ebuild-mode.el b/ebuild-mode.el
index ea61045..07e1da4 100644
--- a/ebuild-mode.el
+++ b/ebuild-mode.el
@@ -366,7 +366,9 @@ Optional argument LIMIT restarts collection after that number of elements."
;;(compilation-mode-hook (lambda () (setq truncate-lines t)))
(compilation-buffer-name-function
(list 'lambda '(mode) (concat "*ebuild " command "*"))))
- (compile (format "ebuild %s %s" file command))))
+ (let ((ebuild-command (format "ebuild %s %s" file command)))
+ (if (featurep 'xemacs) (compile ebuild-command)
+ (compile ebuild-command 'ebuild-run-mode)))))
;;; Modify package keywords.
diff --git a/ebuild-run-mode.el b/ebuild-run-mode.el
new file mode 100644
index 0000000..bb76d19
--- /dev/null
+++ b/ebuild-run-mode.el
@@ -0,0 +1,361 @@
+;;; ebuild-run-mode.el --- major mode for buffers running ebuild commands
+
+;; Copyright 2006-2021 Gentoo Authors
+
+;; Author: Dima Akater <nuclearspace@gmail.com>
+;; Maintainer: <emacs@gentoo.org>
+;; Keywords: compilation, processes
+
+;; This file 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 2 of the License, or
+;; (at your option) any later version.
+
+;; This file 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file should be ignored in app-xemacs/ebuild-mode ebuild
+;; as the feature is not supported in XEmacs.
+;;
+;; It is not difficult to support; the issue is, `ebuild-run-command'
+;; is not working correctly in XEmacs via Tramp at the moment,
+;; in the first place.
+;;
+;; Accessing the build environment normally requires Tramp,
+;; we use it extensively here, and possible future features will likely
+;; require it too. So no need to complicate the code until XEmacs supports
+;; `ebuild-run-command' fully.
+
+;; This file is lexical-binding compatible. We do not set it because
+;; - ebuild-mode rules demand lexical-binding: t to be set at the end
+;; of the file which triggers a compiler warning
+;; - lexical-binding: t is not necessary here
+
+;; More relevant issues:
+;; - A naming scheme is needed that would follow names outlined in
+;; man ebuild(5) while still looking good in Lisp code
+
+;;; Code:
+
+;;; Dependencies:
+
+(eval-when-compile
+ (defmacro emacs-version-between (min max)
+ `(and (<= ,min emacs-major-version)
+ ;; this can be replaced with a single <= form
+ ;; when support for Emacs 23 is dropped
+ ;; subsequently,
+ ;; emacs-version-between can be macroexpanded in-place everywhere
+ ;; into a single <= form and dropped too
+ (<= emacs-major-version ,max))))
+
+(eval-when-compile
+ (if (<= 24 emacs-major-version) (require 'cl-macs)
+ (load "cl-macs")
+ (defalias 'cl-symbol-macrolet 'symbol-macrolet)
+ (defalias 'cl-loop 'loop)
+ (defalias 'cl-ecase 'ecase))
+ (when (with-no-warnings
+ (emacs-version-between 23 26))
+ (declare-function tramp-compat-file-local-name "ebuild-run-mode")))
+(eval-when-compile (require 'rx))
+(require 'compile)
+(require 'tramp)
+(when (= 23 emacs-major-version) (require 'cl))
+
+;;; Macros:
+
+(defmacro ebuild-macs-expand-file-namef (place filename)
+ "Update PLACE (a directory) to the full path to FILENAME, relative to PLACE.
+
+Useful in imperative algorithms involving movement across file system(s)."
+ `(setf ,place (expand-file-name ,filename ,place)))
+
+(eval-and-compile
+ ;; We include dependencies from future Emacs almost verbatim,
+ ;; namely from Emacs 28.0
+
+ ;; Strengthen conditions in the following two forms
+ ;; as support for old Emacs drops.
+
+ (when (= 23 emacs-major-version)
+
+ (defun file-name-base (&optional filename)
+ "Return the base name of the FILENAME: no directory, no extension."
+ (declare (advertised-calling-convention (filename) "27.1"))
+ (file-name-sans-extension
+ (file-name-nondirectory (or filename (buffer-file-name)))))
+
+ (eval-when-compile
+ (defmacro defvar-local (var val &optional docstring)
+ "Define VAR as a buffer-local variable with default value VAL.
+Like `defvar' but additionally marks the variable as being automatically
+buffer-local wherever it is set."
+ (declare (debug defvar) (doc-string 3))
+ ;; Can't use backquote here, it's too early in the bootstrap.
+ (list 'progn (list 'defvar var val docstring)
+ (list 'make-variable-buffer-local (list 'quote var))))))
+
+ (when (emacs-version-between 24 25)
+
+ (defvar gensym-counter 0
+ "Number used to construct the name of the next symbol created by
+`gensym'.")
+
+ (defun gensym (&optional prefix)
+ "Return a new uninterned symbol.
+The name is made by appending `gensym-counter' to PREFIX.
+PREFIX is a string, and defaults to \"g\"."
+ (let ((num (prog1 gensym-counter
+ (setq gensym-counter (1+ gensym-counter)))))
+ (make-symbol (format "%s%d" (or prefix "g") num)))))
+
+ (when (emacs-version-between 23 25)
+
+ (defun file-local-name (file)
+ "Return the local name component of FILE.
+This function removes from FILE the specification of the remote host
+and the method of accessing the host, leaving only the part that
+identifies FILE locally on the remote system.
+The returned file name can be used directly as argument of
+`process-file', `start-file-process', or `shell-command'."
+ (or (file-remote-p file 'localname) file)))
+
+ (when (emacs-version-between 23 26)
+
+ (defalias 'tramp-compat-file-local-name 'file-local-name)
+
+ (defun tramp-file-local-name (name)
+ "Return the local name component of NAME.
+This function removes from NAME the specification of the remote
+host and the method of accessing the host, leaving only the part
+that identifies NAME locally on the remote system. If NAME does
+not match `tramp-file-name-regexp', just `file-local-name' is
+called. The returned file name can be used directly as argument
+of `process-file', `start-file-process', or `shell-command'."
+ (or (and (tramp-tramp-file-p name)
+ (string-match (nth 0 tramp-file-name-structure) name)
+ (match-string (nth 4 tramp-file-name-structure) name))
+ (tramp-compat-file-local-name name)))))
+
+(defmacro with-file-buffer/ebuild-macs (filename &rest body)
+ "Visit FILENAME unless already visited. Set the buffer as current,
+evaluate BODY forms. Kill the buffer if it did not exist initially."
+ ;; We want a with- name but we also need ebuild- namespace,
+ ;; and with-ebuild-macs-file-buffer is ugly
+ ;; while with-ebuild-file-buffer is misleading
+ (declare (indent 1))
+ (let ((o-o-filename (gensym "filename-"))
+ (existing-buffer-g (gensym "existing-buffer-"))
+ (buffer-g (gensym "buffer-")))
+ `(let* ((,o-o-filename ,filename)
+ (,existing-buffer-g (get-file-buffer ,o-o-filename))
+ (,buffer-g (or ,existing-buffer-g
+ (find-file-noselect ,o-o-filename))))
+ (unwind-protect (with-current-buffer ,buffer-g ,@body)
+ (unless ,existing-buffer-g (kill-buffer ,buffer-g))))))
+
+(defmacro with-ebuild-compilation-buffer (buffer &rest body)
+ "Evaluate BODY forms in buffer BUFFER, presumbaly compilation-mode buffer
+where ebuild command is being executed. The following variables are captured:
+- COMMAND as is, e.g. ebuild frobnicate-99999999.ebuild ‹command›
+- FILENAME passed to COMMAND as the first argument
+- PACKAGE-VERSION: counterpart of ebuild's ${PV}, e.g. frobnicate-99999999
+- EXPANDED-FILENAME: full path to FILENAME
+- PORTAGE-HOME/CATEGORY/PV: full path to PACKAGE-VERSION dir in Portage build
+ directory."
+ (declare (indent 1))
+ `(with-current-buffer ,buffer
+ (let ((command (car compilation-arguments)))
+ (if (string-match (rx line-start
+ "ebuild" (one-or-more whitespace)
+ (group (one-or-more (not whitespace))))
+ command)
+ (let* ((filename (match-string-no-properties 1 command))
+ (package-version (file-name-base filename))
+ (expanded-filename (expand-file-name filename))
+ (category (file-name-base
+ (ebuild-util-up-directory expanded-filename 2)))
+ (portage-home/category/pv
+ (ebuild-util-file-name-join
+ (ebuild-run-mode-tramp-portage-homedir)
+ (list category package-version))))
+ ;; Arguably, it would be convenient to also provide access
+ ;; to environment file and maybe other objects.
+ ;; Things to consider prior to doing this:
+ ;; - naming conventions: we should follow Gentoo naming scheme
+ ;; but this can be done in different ways, e.g., we could use
+ ;; elisp symbol `pv', or `PV', or `$PV', or `$pv'.
+ ;; Or we could have them all and give them different meaning
+ ;; - permissions burden: depending on the method for determining
+ ;; relevant values, we might need to access Portage environment
+ ;; via tramp; such events should be isolated, at least,
+ ;; and minimized, at most.
+ ,@body)
+ (error
+ "Does not look like ebuild command in %s; maybe `%s' value is broken"
+ (current-buffer) 'compilation-arguments)))))
+
+
+;;; Utilities:
+
+(defun ebuild-util-file-name-join (root names)
+ "Join file name.
+
+Examples:
+
+ELISP> (ebuild-util-file-name-join \"/a/b\" '(\"c\" \"d\"))
+\"/a/b/c/d\"
+
+ELISP> (ebuild-util-file-name-join \"/a/b\" '(\"c\" \"d/\"))
+\"/a/b/c/d/\"
+
+ELISP> (ebuild-util-file-name-join \"/a/b\" '(\"c/\" \"d\"))
+\"/a/b/c/d\"
+
+ELISP> (ebuild-util-file-name-join \"/a/b/\" '(\"c\" \"d\"))
+\"/a/b/c/d\""
+ (dolist (name names root) (ebuild-macs-expand-file-namef root name)))
+
+(defun ebuild-util-up-directory (root &optional n)
+ "Return file name of directory N (1 by default) times upwards the directory
+tree.
+
+File name is returned without trailing slash so that `file-name-base' works
+with it hassle-free.
+
+Examples:
+
+ELISP> (ebuild-util-up-directory \"/a/b/c/d\")
+\"/a/b/c\"
+
+ELISP> (ebuild-util-up-directory \"/a/b/c/d\" 2)
+\"/a/b\"
+
+ELISP> (ebuild-util-up-directory \"/a/b/c/d\" 3)
+\"/a\""
+ (cl-loop repeat (or n 1) do (ebuild-macs-expand-file-namef root ".."))
+ root)
+
+(defun ebuild-util-maybe-remove-quotes (string)
+ "Remove quotes at the beginning and at the end of STRING, if present."
+ (let ((length (length string)) long-enough first-quote-p)
+ (cl-symbol-macrolet ((last-quote-p
+ (char-equal ?\" (aref string (1- length)))))
+ (if (and (setq long-enough (> length 1))
+ (setq first-quote-p (char-equal ?\" (aref string 0)))
+ last-quote-p)
+ (substring string 1 -1)
+ (when long-enough
+ (warn "Missing %s quote in string “%s”"
+ (if first-quote-p 'trailing 'leading) string))
+ string))))
+
+
+;;; Main part:
+
+(defun ebuild-run-mode-tramp-prefix ()
+ "In `ebuild-run-mode', return tramp prefix necessary to access build files
+and portage cache, as seen in `default-directory' of the buffer."
+ (cl-ecase major-mode
+ (ebuild-run-mode
+ (substring-no-properties default-directory
+ 0 (- (length (tramp-file-local-name
+ default-directory)))))))
+
+(defvar ebuild-run-mode-portage-homedir "/var/tmp/portage/"
+ "Absolute path to main portage build directory.")
+
+(defun ebuild-run-mode-tramp-portage-homedir ()
+ "Path to main portage build directory, with all tramp prefixes necessary
+to access build files."
+ (concat (ebuild-run-mode-tramp-prefix) ebuild-run-mode-portage-homedir))
+
+(defun ebuild-run-mode-tramp-default-current-sourcedir (&optional buffer)
+ "For buffer BUFFER where ebuild command is being executed, return
+corresponding default temporary build directory (default value for ${S}, as
+specified e.g. in man ebuild(5)), derived from `compilation-arguments' of
+BUFFER.
+
+The retuned directory name is prefixed with appropriate `tramp' prefix."
+ (with-ebuild-compilation-buffer (or buffer (current-buffer))
+ (file-name-as-directory
+ (ebuild-util-file-name-join portage-home/category/pv
+ (list "work" package-version)))))
+
+(defun ebuild-run-mode-tramp-current-sourcedir (&optional buffer)
+ "For buffer BUFFER where ebuild command is being executed, return
+corresponding temporary build directory (counterpart of ${S}), derived from
+`compilation-arguments' of BUFFER.
+
+The returned directory name is prefixed with appropriate `tramp' prefix."
+ (with-ebuild-compilation-buffer (or buffer (current-buffer))
+ (file-name-as-directory
+ (concat
+ (ebuild-run-mode-tramp-prefix)
+ (ebuild-util-maybe-remove-quotes
+ (let ((env-file
+ (ebuild-util-file-name-join portage-home/category/pv
+ (list "temp"
+ "environment"))))
+ (with-file-buffer/ebuild-macs env-file
+ (save-excursion
+ (goto-char (point-min))
+ (re-search-forward
+ (rx line-start "declare -x S="
+ (group (one-or-more (not whitespace)))
+ line-end)))
+ (match-string-no-properties 1))))))))
+
+(defun ebuild-run-mode-goto-error ()
+ "Visit the source for the error message at point.
+Use this command in `ebuild-run-mode' buffers."
+ (interactive)
+ (let ((default-directory
+ (or (ebuild-run-mode-tramp-current-sourcedir)
+ (progn
+ (warn "Current Portage Sourcedir is unknown.")
+ (ebuild-run-mode-tramp-default-current-sourcedir)))))
+ (compile-goto-error)))
+
+(defvar ebuild-run-font-lock-keywords
+ '(("^Ebuild \\(finished\\).*"
+ (0 '(face nil compilation-message nil help-echo nil mouse-face nil) t)
+ (1 compilation-info-face))
+ ("^>>> Source \\(compiled\\).*"
+ (0 '(face nil compilation-message nil help-echo nil mouse-face nil) t)
+ (1 compilation-info-face))
+ ("^Ebuild \\(exited abnormally\\|interrupt\\|killed\\|terminated\
+\\|segmentation fault\\)\\(?:.*with code \\([0-9]+\\)\\)?.*"
+ (0 '(face nil compilation-message nil help-echo nil mouse-face nil) t)
+ (1 compilation-error-face)
+ (2 compilation-error-face nil t)))
+ "Substrings to highlight in `ebuild-run-mode'.")
+
+(defvar-local ebuild-run-mode nil
+ "Set to t when `ebuild-run-mode' is enabled.")
+
+;;;###autoload
+(define-compilation-mode ebuild-run-mode "Ebuild"
+ "Major mode for non-interactive buffers spawned by `ebuild-run-command'."
+ (setq buffer-read-only t)
+ (font-lock-add-keywords nil ebuild-run-font-lock-keywords)
+ (setq ebuild-run-mode t))
+
+(define-key ebuild-run-mode-map [remap compile-goto-error]
+ #'ebuild-run-mode-goto-error)
+
+(provide 'ebuild-run-mode)
+
+;; Local Variables:
+;; coding: utf-8
+;; End:
+
+;;; ebuild-run-mode.el ends here
--
2.31.1