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.0.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.0.0"
  "Company-Ebuild version.")


(defun company-ebuild--annotation (candidate)
  "Return annotation for CANDIDATE."
  (cond
   ((member candidate company-ebuild--constant-keywords-architectures)
    " architecture")
   ((member candidate company-ebuild--constant-keywords-restrict)
    " restrict")
   ((member candidate company-ebuild--constant-keywords-phases)
    " phase")
   ((member candidate company-ebuild--constant-keywords-sandbox)
    " sandbox")
   ((member candidate company-ebuild--constant-keywords-doc)
    " doc")
   ((member candidate company-ebuild--constant-keywords-variables-predefined)
    " variable (predefined)")
   ((member candidate company-ebuild--constant-keywords-variables-ebuild-defined)
    " variable (ebuild-defined)")
   ((member candidate company-ebuild--constant-keywords-variables-dependencies)
    " variable (dependencies)")
   ((member candidate company-ebuild--constant-keywords-variables-user-environment)
    " variable (user-environment)")
   ((member candidate company-ebuild--dynamic-keywords-eclasses)
    " eclass")
   ((or (member candidate company-ebuild--constant-keywords-functions)
        (member candidate company-ebuild--dynamic-keywords-functions))
    " function")
   ((member candidate company-ebuild--dynamic-keywords-variables)
    " variable (eclass)")
   ((member candidate company-ebuild--dynamic-keywords-use-flags)
    " USE flag")
   ((member candidate company-ebuild--dynamic-keywords-packages)
    " package")
   ((member candidate company-ebuild--dynamic-keywords-licenses)
    " license")
   ((executable-find candidate)
    " executable")
   (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 (file-path)
  "Return found Eclass files.

FILE-PATH is the location from which we start searching for Eclass files."
  (let ((repo-root
         (company-ebuild--find-repo-root file-path)))
    (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)))
        (setq company-ebuild--dynamic-keywords-eclasses
              (apply #'append
                     (mapcar (lambda (f)
                               (mapcar (lambda (s)
                                         (replace-regexp-in-string "\\.eclass"
                                                                   ""
                                                                   s))
                                       (company-ebuild--get-tags f "ECLASS")))
                             eclass-files)))
        (setq company-ebuild--dynamic-keywords-variables
              (apply #'append
                     (mapcar (lambda (f)
                               (company-ebuild--get-tags f "ECLASS_VARIABLE"))
                             eclass-files)))
        (setq company-ebuild--dynamic-keywords-functions
              (apply #'append
                     (mapcar (lambda (f)
                               (company-ebuild--get-tags f "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))


;;;###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
    (interactive
     (company-begin-backend 'company-ebuild))
    (prefix
     (and (eq major-mode 'ebuild-mode) (company-grab-symbol)))
    (annotation
     (company-ebuild--annotation arg))
    (candidates
     ;; TODO: Complete any string that already appears in current buffer.
     (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))))))

;;;###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)"
  ;; HACK: Modify syntax to treat "/" as a word constituent.
  ;; TODO: (Hard mode) write a proper `company-grab-symbol' replacement.
  (modify-syntax-entry ?/ "w")
  ;; Force-enable `company-mode'.
  (when (null company-mode)
    (company-mode +1))
  ;; Regenerate dynamic keywords.
  (company-ebuild--regenerate-dynamic-keywords)
  ;; Add the `company-ebuild' backend.
  (cond
   ((fboundp 'company-yasnippet)
    (add-to-list 'company-backends '(company-ebuild company-yasnippet)))
   (t
    (add-to-list 'company-backends 'company-ebuild)))
  ;; Because some completions have length 1:
  (setq-local company-minimum-prefix-length 1))

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


(provide 'company-ebuild)



;;; company-ebuild.el ends here