(compile (format "ebuild %s %s" file command))))

    (ebuild-run-compile-ignoring-mode-in-xemacs

     (format "ebuild %s %s" file command) 'ebuild-run-mode)))

- 

;;; ebuild-run-mode.el --- major mode for buffers running ebuild commands

;; Copyright 2006-2020 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

  (if (version<= "24.1" emacs-version) (require 'cl-macs)

    (load "cl-macs")

    (defalias 'cl-symbol-macrolet 'symbol-macrolet)

    (defalias 'cl-loop 'loop)

    (defalias 'cl-ecase 'ecase)))

(eval-when-compile (require 'rx))

(require 'compile)

(require 'tramp)

(when (version= "23.4.1" emacs-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 (version= "23.4.1" emacs-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 (and (version<= "24.1" emacs-version)

             (version<= emacs-version "25.3.1"))

    (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 (and (version<= "23.4.1" emacs-version)

             (version<= emacs-version "25.3.1"))

    (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 (and (version<= "23.4.1" emacs-version)

             (version<= emacs-version "26.3"))

    (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)))

    (defalias 'tramp-compat-file-local-name 'file-local-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 ,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.")

(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