path: root/company-ebuild.el

;;; company-ebuild.el --- Company backend for editing Ebuild files -*- lexical-binding: t -*-



;; Copyright 2022 Gentoo Authors


;; 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/>.


;; Authors: Maciej Barć <xgqt@gentoo.org>
;; Created: 16 Aug 2022
;; Version: 0.1.0
;; Keywords: languages
;; Homepage: https://gitweb.gentoo.org/proj/company-ebuild.git
;; Package-Requires: ((emacs "25.1"))
;; SPDX-License-Identifier: GPL-2.0-or-later



;;; Commentary:


;; Company backend for editing Ebuild files.



;;; Code:


(require 'cl-lib)

(require 'company)
(require 'ebuild-mode)

(require 'company-ebuild-keywords)


(defconst company-ebuild-version "0.1.0"
  "Company-Ebuild version.")


(defun company-ebuild--annotation-and-kind (candidate)
  "Return annotation for CANDIDATE."
  (cond
   ((member candidate company-ebuild--constant-keywords-architectures)
    '(" architecture" . value))
   ((member candidate company-ebuild--constant-keywords-restrict)
    '(" restrict" . value))
   ((member candidate company-ebuild--constant-keywords-phases)
    '(" phase" . function))
   ((member candidate company-ebuild--constant-keywords-sandbox)
    '(" sandbox" . function))
   ((member candidate company-ebuild--constant-keywords-doc)
    '(" doc" . variable))
   ((member candidate company-ebuild--constant-keywords-variables-predefined)
    '(" variable (predefined)" . variable))
   ((member candidate company-ebuild--constant-keywords-variables-ebuild-defined)
    '(" variable (ebuild-defined)" . variable))
   ((member candidate company-ebuild--constant-keywords-variables-dependencies)
    '(" variable (dependencies)" . variable))
   ((member candidate company-ebuild--constant-keywords-variables-user-environment)
    '(" variable (user-environment)" . variable))
   ((member candidate company-ebuild--dynamic-keywords-eclasses)
    '(" eclass" . module))
   ((or (member candidate company-ebuild--constant-keywords-functions)
        (member candidate company-ebuild--dynamic-keywords-functions))
    '(" function" . function))
   ((member candidate company-ebuild--dynamic-keywords-variables)
    '(" variable (eclass)" . variable))
   ((member candidate company-ebuild--dynamic-keywords-use-flags)
    '(" USE flag" . value))
   ((member candidate company-ebuild--dynamic-keywords-packages)
    '(" package" . value))
   ((member candidate company-ebuild--dynamic-keywords-licenses)
    '(" license" . value))
   ((executable-find candidate)
    '(" executable" . file))
   (t
    '("" . t))))

(defun company-ebuild--packages ()
  "Return a list of all available packages.

Uses the \"qsearch\" tool to get the packages."
  (let ((qsearch
         (executable-find "qsearch"))
        (qsearch-formats
         '("%{CATEGORY}/%{PN}"
           "%{CATEGORY}/%{PN}-%{PV}"
           "%{CATEGORY}/%{PN}-%{PV}:%{SLOT}"
           "%{CATEGORY}/%{PN}-%{PV}:%{SLOT}::%{REPO}")))
    (cond
     (qsearch
      (mapcan (lambda (qsearch-format)
                (let ((qlist-result
                       (shell-command-to-string
                        (format "%s --all --format \"%s\" --name-only --nocolor"
                                qsearch
                                qsearch-format))))
                  (split-string qlist-result "\n" t)))
              qsearch-formats))
     (t
      nil))))

(defun company-ebuild--get-tags (file-path tag-name)
  "Return all tags with TAG-NAME from file at FILE-PATH.

For example:
\(company-ebuild--get-tags \"/gentoo/eclass/edo.eclass\" \"FUNCTION\")"
  (let ((tag
         (concat "# @" tag-name ": "))
        (file-lines
         (with-temp-buffer
           (insert-file-contents file-path)
           (split-string (buffer-string) "\n" t))))
    ;; Hack with `mapcan' - doing both filter and map.
    (mapcan (lambda (line)
              (cond
               ((string-match-p (concat tag ".*") line)
                (list (replace-regexp-in-string tag "" line)))
               (t
                nil)))
            file-lines)))

(defun company-ebuild--find-repo-root (file-path)
  "Return the root directory of current Ebuild repository.

FILE-PATH is the location from which we start searching for repository root."
  (and (not (null file-path))
       (file-exists-p file-path)
       (locate-dominating-file file-path "profiles/repo_name")))

(defun company-ebuild--find-eclass-files (repo-root)
  "Return found Eclass files.

REPO-ROOT is the location from which we start searching for Eclass files."
  (and repo-root
       (directory-files
        (expand-file-name "eclass" repo-root) t ".*\\.eclass" t)))

(defun company-ebuild--regenerate-dynamic-keywords-eclasses ()
  "Set new content of the ‘company-ebuild--dynamic-keywords’ Eclass variables."
  (let ((repo-root
         (company-ebuild--find-repo-root buffer-file-name)))
    (when repo-root
      (let ((eclass-files
             (company-ebuild--find-eclass-files repo-root)))
        (mapc
         (lambda (eclass-file)
           (mapc (lambda (str)
                   (add-to-list 'company-ebuild--dynamic-keywords-eclasses
                                (replace-regexp-in-string "\\.eclass" "" str)))
                 (company-ebuild--get-tags eclass-file "ECLASS"))
           (mapc (lambda (str)
                   (add-to-list 'company-ebuild--dynamic-keywords-variables str))
                 (company-ebuild--get-tags eclass-file "ECLASS_VARIABLE"))
           (mapc (lambda (str)
                   (add-to-list 'company-ebuild--dynamic-keywords-functions str))
                 (company-ebuild--get-tags eclass-file "FUNCTION")))
         eclass-files)))))

(defun company-ebuild--regenerate-dynamic-keywords-use-flags ()
  "Set new content of the ‘company-ebuild--dynamic-keywords-use-flags’ variable."
  (let ((repo-root
         (company-ebuild--find-repo-root buffer-file-name))
        (awk-format
         "awk -F - '{ print $1 }' %s/profiles/use.desc"))
    (when (and repo-root
               (file-exists-p (expand-file-name "profiles/use.desc" repo-root)))
      (setq company-ebuild--dynamic-keywords-use-flags
            (let ((awk-result
                   (shell-command-to-string (format awk-format repo-root))))
              (mapcan (lambda (line)
                        (cond
                         ((not (string-prefix-p "#" line))
                          (list line))
                         (t
                          nil)))
                      (split-string awk-result "\n" t)))))))

(defun company-ebuild--regenerate-dynamic-keywords-packages ()
  "Set new content of the ‘company-ebuild--dynamic-keywords-packages’ variable."
  (setq company-ebuild--dynamic-keywords-packages
        (company-ebuild--packages)))

(defun company-ebuild--regenerate-dynamic-keywords-licenses ()
  "Set new content of the ‘company-ebuild--dynamic-keywords-licenses’ variable."
  (let ((repo-root
         (company-ebuild--find-repo-root buffer-file-name)))
    (when repo-root
      (setq company-ebuild--dynamic-keywords-licenses
            (directory-files (expand-file-name "licenses" repo-root))))))

(defun company-ebuild--regenerate-dynamic-keywords ()
  "Regenerate dynamic keywords."
  (company-ebuild--regenerate-dynamic-keywords-eclasses)
  (company-ebuild--regenerate-dynamic-keywords-use-flags)
  (company-ebuild--regenerate-dynamic-keywords-packages)
  (company-ebuild--regenerate-dynamic-keywords-licenses))

(defun company-ebuild--grab-symbol ()
  "Workaround wrapper for `company-grab-symbol'."
  ;; TODO: (Hard mode) write a proper `company-grab-symbol' replacement.
  (with-syntax-table (copy-syntax-table (syntax-table))
    (modify-syntax-entry ?/ "w")
    (modify-syntax-entry ?@ "w")  ; To make Eclass tags work.
    (company-grab-symbol)))


;;;###autoload
(defun company-ebuild (command &optional arg &rest ignored)
  "Company backend for editing Ebuild files.

COMMAND, ARG and IGNORED are for Company.
COMMAND is matched with `cl-case'.
ARG is the completion argument for annotation and candidates."
  (interactive (list 'interactive))
  (cl-case command
    (annotation
     (car (company-ebuild--annotation-and-kind arg)))
    (candidates
     (cl-remove-if-not (lambda (candidate)
                         (string-prefix-p arg candidate t))
                       (append company-ebuild--constant-keywords
                               (company-ebuild--dynamic-keywords)
                               (company-ebuild--executables arg))))
    (interactive
     (company-begin-backend 'company-ebuild))
    (kind
     (cdr (company-ebuild--annotation-and-kind arg)))
    (prefix
     (and (eq major-mode 'ebuild-mode) (company-ebuild--grab-symbol)))
    (require-match
     nil)))

;;;###autoload
(defun company-ebuild-setup ()
  "Setup for Company-Ebuild.

To setup the integration correctly, add this function to ‘ebuild-mode-hook’
in your config:
\(add-hook 'ebuild-mode-hook 'company-ebuild-setup)
or `require' Company-Ebuild:
\(require 'company-ebuild)"
  ;; Force-enable `company-mode'.
  (when (null company-mode)
    (company-mode +1))
  ;; Regenerate dynamic keywords.
  (company-ebuild--regenerate-dynamic-keywords)
  ;; Add the `company-ebuild' backend.
  (setq-local company-backends
              `((company-ebuild
                 company-capf  ; standard fallback
                 ,@(cond
                    ((fboundp 'company-yasnippet)  ; YAS for easier setup
                     '(company-yasnippet))
                    (t
                     '())))
                ,@company-backends))
  ;; Because some completions have length 1:
  (setq-local company-minimum-prefix-length 1)
  (setq-local company-require-match nil))

;;;###autoload
(add-hook 'ebuild-mode-hook 'company-ebuild-setup)


(provide 'company-ebuild)



;;; company-ebuild.el ends here