From 3f4a0d5370ae6c34afe180df96add3b8522f4af1 Mon Sep 17 00:00:00 2001 From: mattkae Date: Wed, 11 May 2022 09:23:58 -0400 Subject: initial commit --- elpa/irony-20220110.849/irony-cdb-json.el | 336 ++++++++++++++++++++++++++++++ 1 file changed, 336 insertions(+) create mode 100644 elpa/irony-20220110.849/irony-cdb-json.el (limited to 'elpa/irony-20220110.849/irony-cdb-json.el') diff --git a/elpa/irony-20220110.849/irony-cdb-json.el b/elpa/irony-20220110.849/irony-cdb-json.el new file mode 100644 index 0000000..f24e144 --- /dev/null +++ b/elpa/irony-20220110.849/irony-cdb-json.el @@ -0,0 +1,336 @@ +;;; irony-cdb-json.el --- JSON Compilation Database support for irony + +;; Copyright (C) 2014 Guillaume Papin + +;; Author: Guillaume Papin +;; Keywords: c, convenience, tools + +;; 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 . + +;;; Commentary: +;; +;; JSON Compilation Database support for Irony, see +;; http://clang.llvm.org/docs/JSONCompilationDatabase.html. +;; + +;;; Code: + +(require 'irony-cdb) + +(require 'cl-lib) + +(require 'json) +(require 'pp) + +(defvar irony-cdb-json--project-alist nil + "Alist of source directory and compile_commands.json locations. + +Note, the compile_commands.json location may be relative to the +source directory.") + +(defconst irony-cdb-json--project-alist-file + (concat irony-user-dir "cdb-json-projects")) + +;;;###autoload +(defun irony-cdb-json (command &rest args) + (cl-case command + (get-compile-options (irony-cdb-json--get-compile-options)))) + +;;;###autoload +(defun irony-cdb-json-add-compile-commands-path (project-root + compile-commands-path) + "Add an out-of-source compilation database. + +Files below the PROJECT-ROOT directory will use the JSON +Compilation Database as specified by COMPILE-COMMANDS-PATH. + +The JSON Compilation Database are often generated in the build +directory. This functions helps mapping out-of-source build +directories to project directory." + (interactive + (progn + (let ((proot (read-directory-name "Project root:" nil nil t))) + (list proot (read-file-name "Compile commands:" proot nil t + "compile_commands.json"))))) + (add-to-list 'irony-cdb-json--project-alist + (cons (expand-file-name project-root) + (expand-file-name compile-commands-path))) + (irony-cdb-json--save-project-alist) + + ; and tell irony to load it now + (irony-cdb-autosetup-compile-options)) + +(defun irony-cdb-json--put-first (pos target-list) + (if (>= pos (length target-list)) + target-list + (let ((elm (nth pos target-list))) + (append (list elm) (delete elm target-list))))) + +(defun irony-cdb-json--choose-cdb () + "Prompt to select CDB from current project root." + (let* ((proot (irony-cdb-json--find-best-prefix-path + (irony-cdb-json--target-path) + (mapcar 'car irony-cdb-json--project-alist))) + (cdbs (mapcar 'cdr + (cl-remove-if-not (lambda (x) (string-equal proot (car x))) + irony-cdb-json--project-alist)))) + (completing-read "Choose Irony CDB: " cdbs nil 'require-match nil))) + +;;;###autoload +(defun irony-cdb-json-select () + "Select CDB to use with a prompt. + +It is useful when you have several CDBs with the same project +root. + +The completion function used internally is `completing-read' so +it could easily be used with other completion functions by +temporarily using a let-bind on `completing-read-function'. Or +even helm by enabling `helm-mode' before calling the function." + (interactive) + (let ((pos (cl-position (irony-cdb-json--choose-cdb) + irony-cdb-json--project-alist + :test (lambda (x y) (string-equal x (cdr y)))))) + (setq irony-cdb-json--project-alist + (irony-cdb-json--put-first pos irony-cdb-json--project-alist)) + (irony-cdb-json--save-project-alist) + (irony-cdb-autosetup-compile-options))) + +(defun irony-cdb-json--last-mod (file) + "File modification time or null time if file doesn't exist." + (or (nth 5 (file-attributes file)) + '(0 0 0 0))) + +;;;###autoload +(defun irony-cdb-json-select-most-recent () + "Select CDB that is most recently modified." + (interactive) + (setq irony-cdb-json--project-alist + (sort irony-cdb-json--project-alist + (lambda (x y) + (time-less-p (irony-cdb-json--last-mod (cdr y)) + (irony-cdb-json--last-mod (cdr x)))))) + (irony-cdb-json--save-project-alist) + (irony-cdb-autosetup-compile-options)) + +(defun irony-cdb-json--get-compile-options () + (irony--awhen (irony-cdb-json--locate-db) + (let ((db (irony-cdb-json--load-db it))) + (irony--aif (irony-cdb-json--exact-flags db) + it + (let ((dir-cdb (irony-cdb-json--compute-directory-cdb db))) + (irony-cdb-json--guess-flags dir-cdb)))))) + +(defsubst irony-cdb-json--target-path () + (or buffer-file-name (expand-file-name default-directory))) + +(defun irony-cdb-json--ensure-project-alist-loaded () + (unless irony-cdb-json--project-alist + (irony-cdb-json--load-project-alist))) + +(defun irony-cdb-json--save-project-alist () + (with-temp-file irony-cdb-json--project-alist-file + (insert ";; -*- emacs-lisp -*-\n\ +;;\n\ +;; JSON Compilation Database project list.\n\ +;;\n\ +;; File auto-generated by irony-cdb-json.\n\ +;;\n") + (pp irony-cdb-json--project-alist (current-buffer)) + (insert "\n"))) + +(defun irony-cdb-json--load-project-alist () + (when (file-exists-p irony-cdb-json--project-alist-file) + (setq irony-cdb-json--project-alist + (with-temp-buffer + (insert-file-contents irony-cdb-json--project-alist-file) + (read (current-buffer)))))) + +(defun irony-cdb-json--find-best-prefix-path (file prefixes) + (cl-loop for prefix in prefixes + with found = nil + ;; keep the closest directory + if (and (string-prefix-p prefix file) + (> (length prefix) (length found))) + do (setq found prefix) + finally return found)) + +(defun irony-cdb-json--locate-db () + (irony-cdb-json--ensure-project-alist-loaded) + (irony--aif (irony-cdb-json--find-best-prefix-path + (irony-cdb-json--target-path) + (mapcar 'car irony-cdb-json--project-alist)) + (expand-file-name + (cdr (assoc it irony-cdb-json--project-alist)) + it) + ;; If not in the project table, look in the dominating directories + (irony--awhen (irony-cdb--locate-dominating-file-with-dirs + (irony-cdb-json--target-path) + "compile_commands.json" + irony-cdb-search-directory-list) + (expand-file-name it)))) + +(defvar irony-cdb-json--cache-key nil + "The name of the last loaded JSON file and its modification time.") +(defvar irony-cdb-json--cache-cdb nil + "The last loaded compilation database.") + +(defun irony-cdb-json--make-cache-key (file) + (irony--aif (file-attributes file) + (cons file (nth 5 it)))) + +(defun irony-cdb-json--load-db (json-file) + (let ((cache-key (irony-cdb-json--make-cache-key json-file))) + (unless (and cache-key (equal irony-cdb-json--cache-key cache-key)) + (setq irony-cdb-json--cache-cdb + (delq nil (mapcar #'irony-cdb-json--transform-compile-command + ;; JSON read may throw + (json-read-file json-file)))) + (setq irony-cdb-json--cache-key cache-key))) + irony-cdb-json--cache-cdb) + +(defun irony-cdb-json--exact-flags (file-cdb) + (when buffer-file-name + (mapcar #'(lambda (e) + (cons (nth 1 e) (nth 2 e))) + (irony--assoc-all buffer-file-name file-cdb)))) + +(defun irony-cdb-json--guess-flags (dir-cdb) + (cl-loop for e in dir-cdb + with buf-path = (irony-cdb-json--target-path) + with found = nil + for dir = (car e) + ;; keep the closest directory + if (and (string-prefix-p dir buf-path) + (> (length dir) (length (car found)))) + do (setq found e) + finally return (list (cons (nth 1 found) (nth 2 found))))) + +(defsubst irony-cdb-json--compile-command-directory (compile-command) + (cdr (assq 'directory compile-command))) + +(defsubst irony-cdb-json--compile-command-file (compile-command) + (cdr (assq 'file compile-command))) + +(defun irony-cdb-json--compile-command-options (compile-command) + "Return the compile options of COMPILE-COMMAND as a list." + (let ((command (assq 'command compile-command)) + (arguments (assq 'arguments compile-command))) + (irony-cdb--remove-compiler-from-flags + (cond (command (irony--split-command-line (cdr command))) + (arguments (append (cdr arguments) nil)))))) + +(defun irony-cdb-json--adjust-compile-options (compile-options file default-dir) + "Adjust COMPILE-OPTIONS to only use options useful for parsing. + +COMPILE-OPTIONS is modified by side effects but the returned list +should be used since elements can change at the head. + +Removes the input file, the output file, ... + +Relative paths are relative to DEFAULT-DIR." + ;; compute the truename of the absolute path for FILE only once + (setq file (file-truename (expand-file-name file default-dir))) + (let* ((head (cons 'nah compile-options)) + (it head) + opt) + (while (setq opt (cadr it)) + (cond + ;; end of options, skip all positional arguments (source files) + ((string= opt "--") + (setcdr it nil)) + ;; strip -c + ((string= "-c" opt) + (setcdr it (nthcdr 2 it))) + ;; strip -o and -o + ((string-prefix-p "-o" opt) + (if (string= opt "-o") + (setcdr it (nthcdr 3 it)) + (setcdr it (nthcdr 2 it)))) + ;; skip input file; avoid invoking file commands if an option argument + ((and (not (string-prefix-p "-" opt)) (string= file (file-truename (expand-file-name opt default-dir)))) + (setcdr it (nthcdr 2 it))) + (t + ;; if head of cdr hasn't been skipped, iterate, otherwise check if the + ;; new cdr need skipping + (setq it (cdr it))))) + (cdr head))) + +(defun irony-cdb-json--transform-compile-command (compile-command) + "Transform a compile command in the JSON compilation database +into a friendlier format. + +The returned value is a list composed of the following elements: +0. The absolute path to the file. +1. The compile options. +2. The invocation directory. Relative paths in the compile + options elements are relative to this directory. + +Return nil if the compile command is invalid or the compile +options are empty." + (let* ((directory (irony-cdb-json--compile-command-directory compile-command)) + (path (expand-file-name + (irony-cdb-json--compile-command-file compile-command) directory)) + (options (irony-cdb-json--compile-command-options compile-command))) + (when (and path directory options) + (list path + (irony-cdb-json--adjust-compile-options options path directory) + directory)))) + +(defun irony-cdb-json--compute-directory-cdb (file-cdb) + ;; collect flags by directory, e.g: for headers in source directories or + ;; new files that are not yet present in the compilation database + (let ((dir-cdb (irony-cdb-json--collect-compile-options-by-dir file-cdb))) + (nconc dir-cdb + ;; collect flags for header search paths too + (irony-cdb-json--collect-compile-options-for-include-dirs dir-cdb)))) + +(defun irony-cdb-json--collect-compile-options-by-dir (file-cdb) + "Collect the compile options per directory from a file compilation database. + +The returned value similar to +`irony-cdb-json--transform-compile-command' except for the first +argument which represents a whole directory (ending with slash on +Unix, `file-name-as-directory') instead of a single file." + (let ((dir-cdb (delete-dups + (mapcar #'(lambda (e) + (cons (file-name-directory (car e)) (cdr e))) + file-cdb)))) + ;; TODO: remove directories when a parent directory has the same flags, for + ;; example, writing the following in CMake: + ;; add_executable(exe foo.cpp sub/bar.cpp) + ;; will result in duplicated compile options for the subdirectory 'sub/'. + dir-cdb)) + +(defun irony-cdb-json--collect-compile-options-for-include-dirs (dir-cdb) + "Guess the compile options to use for directories in the search path. + +The returned value is in the same format as the input value, see +`irony-cdb-json--collect-compile-options-for-include-dirs'." + (let ((include-dirs (delete-dups (mapcar 'car dir-cdb))) + out) + (dolist (e dir-cdb) + (dolist (dir (irony--extract-user-search-paths (nth 1 e) (nth 2 e))) + (unless (member dir include-dirs) + (setq include-dirs (cons dir include-dirs) + out (cons (cons dir (cdr e)) out))))) + out)) + +(provide 'irony-cdb-json) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions) +;; End: + +;;; irony-cdb-json ends here -- cgit v1.2.1