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