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