;;; 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 .
;; Authors: Maciej Barć
;; Created: 16 Aug 2022
;; Version: 0.1.4
;; Keywords: languages
;; Homepage: https://gitweb.gentoo.org/proj/company-ebuild.git
;; Package-Requires: ((emacs "26.2"))
;; 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-custom)
(require 'company-ebuild-keywords)
(defconst company-ebuild-version "0.1.4"
"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-eclassdoc)
'(" 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-formats
'("%{CATEGORY}/%{PN}"
"%{CATEGORY}/%{PN}-%{PV}"
"%{CATEGORY}/%{PN}-%{PV}:%{SLOT}")))
(cond
(company-ebuild-qsearch-executable
(mapcan (lambda (qsearch-format)
(let ((qlist-result
(shell-command-to-string
(format "%s --all --format \"%s\" --name-only --nocolor"
company-ebuild-qsearch-executable
qsearch-format))))
(split-string qlist-result "\n" t)))
qsearch-formats))
(t
'()))))
(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."
(when repo-root
(let ((repo-eclass
(expand-file-name "eclass" repo-root)))
(when (file-exists-p repo-eclass)
(directory-files repo-eclass t ".*\\.eclass" t)))))
(defvar company-ebuild--eclass-mtimes '()
"Cache to prevent accessing eclasses multiple times.
This is a global value holding a list of pairs.
The key is an eclass path and the value is it's last modification time.
This variable primarily is used in
`company-ebuild--regenerate-dynamic-keywords-eclass'.")
(defun company-ebuild--mtime (file-path)
"Return the modification time of a file at FILE-PATH."
(file-attribute-modification-time (file-attributes file-path)))
(defun company-ebuild--regenerate-dynamic-keywords-eclass ()
"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
(mapc
(lambda (eclass-file)
(let ((eclass-file-mtime
(company-ebuild--mtime eclass-file)))
(unless (equal (cdr (assoc eclass-file
company-ebuild--eclass-mtimes))
eclass-file-mtime)
(assoc-delete-all eclass-file company-ebuild--eclass-mtimes)
(push `(,eclass-file . ,eclass-file-mtime)
company-ebuild--eclass-mtimes)
(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")))))
(company-ebuild--find-eclass-files repo-root)))))
(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
(let ((repo-licenses
(expand-file-name "licenses" repo-root)))
(when (file-exists-p repo-licenses)
(setq company-ebuild--dynamic-keywords-licenses
(directory-files repo-licenses)))))))
(defun company-ebuild--regenerate-dynamic-keywords ()
"Regenerate dynamic keywords."
(when company-ebuild--regenerate-dynamic-keywords-eclass
(company-ebuild--regenerate-dynamic-keywords-eclass))
(when company-ebuild--regenerate-dynamic-keywords-use-flags
(company-ebuild--regenerate-dynamic-keywords-use-flags))
(when company-ebuild--regenerate-dynamic-keywords-use-flags
(company-ebuild--regenerate-dynamic-keywords-packages))
(when company-ebuild--regenerate-dynamic-keywords-licenses
(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))
(setq-local company-require-match nil))
;;;###autoload
(add-hook 'ebuild-mode-hook 'company-ebuild-setup)
(provide 'company-ebuild)
;;; company-ebuild.el ends here