emacs-config/lisp/llvm-lib/clang-command.el
2026-05-14 17:11:23 -05:00

223 lines
8 KiB
EmacsLisp

;;; clang-command.el --- -*- lexical-binding: t -*-
;; Copyright (C) 2022 Benson Chu
;; Author: Benson Chu <bensonchu457@gmail.com>
;; Created: [2022-12-17 11:27]
;; This file is not part of GNU Emacs
;; This program 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 3 of the License, or
;; (at your option) any later version.
;; This program 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 this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'c-compiler-option-sets)
(defclass clang-option-config (compiler-option-config)
nil)
(cl-defmethod cos/to-string ((config clang-option-config))
(with-slots
(binary-path
target-options lang-options
other-options optimization-level
include-dirs)
config
(-->
(list
(or binary-path "")
target-options
lang-options
optimization-level
other-options
(mapconcat (lambda (x)
(format "-I\"%s\"" x))
include-dirs
" "))
(remove-if #'string-empty-p it)
(string-join it " "))))
(defvar clang-subtargets
(make-hash-table :test #'equal))
(defvar clang-options-extensions
(make-hash-table :test #'equal))
(defvar clang/all-target-options
(make-hash-table))
(defvar clang/current-target-optionset
(make-hash-table))
(defun clang/push-new-target-option (target name option-set)
(puthash target
(cons (cons name option-set)
(gethash target clang/all-target-options))
clang/all-target-options))
(defun clang/add-and-set-target-option (target name option-set)
(puthash target name clang/current-target-optionset)
(clang/push-new-target-option target name option-set))
(defvar clang/file-specific-options
(make-hash-table :test #'equal))
(defun my/completing-read-formatter (formatter prompt list)
(let ((alist
(mapcar #'(lambda (x)
(cons (funcall formatter x)
x))
list)))
(alist-get (completing-read prompt (mapcar #'car alist))
alist
nil nil #'equal)))
(defun clang/make-clang-option-set (target)
(let ((subtargets (hash-table-values clang-subtargets))
primary extensions)
(setq primary
(my/completing-read-formatter
#'cos/to-string
"Primary Subtarget? "
(remove-if-not (lambda (x)
(string= target
(slot-value x 'target-str)))
subtargets)))
(cons primary extensions)))
(defun clang/get-named-target-clang-optionset (target option-name)
(when-let ((target-options
(gethash target clang/all-target-options)))
(and target-options
(alist-get option-name target-options nil nil #'equal))))
(defun clang/reinitialize-clang-options (target)
(interactive (list (intern (comp-dev/conf-get 'target))))
(let ((option-name (or (gethash target clang/current-target-optionset)
(puthash target "default" clang/current-target-optionset))))
(aprog1 (clang/make-clang-option-set target)
(clang/push-new-target-option target option-name it))))
;;; THE function
(defun clang/get-clang-options-for-target (target &optional option-name)
(let ((option-name (or option-name
(gethash target clang/current-target-optionset)
(puthash target "default" clang/current-target-optionset))))
(or (gethash (buffer-file-name) clang/file-specific-options)
(clang/get-named-target-clang-optionset target option-name)
(aprog1 (clang/make-clang-option-set target)
(clang/push-new-target-option target option-name it)))))
;; (clang/get-clang-options-for-target "c29")
;; (defun clang/new-clang-option-set (target name &optional optionset)
;; (interactive
;; (list (intern (comp-dev/conf-get 'target))
;; (read-string "Name for new optionset? ")))
;; (let ((optionset (or optionset (clang/make-clang-option-set target))))
;; (clang/add-and-set-target-option target name optionset)))
;; (defun clang/copy-clang-option-set (target name &optional optionset)
;; (interactive
;; (list (intern (comp-dev/conf-get 'target))
;; (read-string "Name for new optionset? ")))
;; (let ((optionset (clang/get-clang-options-for-target target)))
;; (clang/add-and-set-target-option target name optionset)))
;; (defun clang/file-specific-option-set (target &optional optionset)
;; (interactive
;; (list (intern (comp-dev/conf-get 'target))))
;; ;; TODO: might need to garbage collect these
;; (or (gethash (buffer-file-name)
;; clang/file-specific-options)
;; (let ((optionset (clang/get-clang-options-for-target target)))
;; (puthash (buffer-file-name)
;; optionset
;; clang/file-specific-options))))
;; (clang/new-clang-option-set "c29" "toyota")
(defun clang/switch-clang-option-set (target name)
(interactive
(let ((target comp-dev/conf-get 'target))
(list target
(--> (intern target)
(gethash it clang/all-target-options)
(mapcar #'car it)
(completing-read "Optionset? " it)))))
(remhash (buffer-file-name)
clang/file-specific-options)
(clang/get-clang-options-for-target target name)
(puthash (intern target) name clang/current-target-optionset))
(defun clang/edit-clang-options (prefix)
(interactive "P")
(let* ((target (intern (comp-dev/conf-get 'target)))
(options-config
(->>
target
(clang/get-clang-options-for-target)
(car)))
(current-name
(or (and (gethash (buffer-file-name) clang/file-specific-options )
"file-specific")
(gethash target clang/current-target-optionset))))
(cos/edit-compiler-options prefix options-config current-name)))
(defun clang/clang-options-merge (primary secondary)
(make-instance
'clang-option-config
:target-str (slot-value primary 'target-str)
:binary (or (slot-value primary 'binary-path)
(car (mapcar #'(lambda (x) (slot-value x 'binary-path))) ))
:target (slot-value primary 'target-options)
:lang (slot-value primary 'lang-options)
:optimization (slot-value primary 'optimization-level)
:other (-->
(cons primary secondary)
(mapconcat
(lambda (x)
(when (slot-boundp x 'other-options)
(slot-value x 'other-options)))
it
" "))
:include-dirs (-->
(cons primary secondary)
(apply #'append
(mapcar
(lambda (x)
(when (slot-boundp x 'include-dirs)
(slot-value x 'include-dirs)))
it)))))
(defvar clang/detect-extensions-function nil)
(cl-defun clang/get-clang-options (&key filename compiler)
(interactive)
(let* ((filename (or filename (buffer-file-name)))
(target-str (comp-dev/conf-get 'target))
(target (intern target-str))
(options-config
(clang/get-clang-options-for-target target))
(detected-extensions
(awhen clang/detect-extensions-function
(funcall it compiler filename target-str))))
(cos/to-string
(clang/clang-options-merge
(car options-config)
(append detected-extensions (cdr options-config))))))
(provide 'clang-command)
;;; clang-command.el ends here