diff options
Diffstat (limited to 'elpa/irony-20220110.849/irony-cdb-json.el')
| -rw-r--r-- | elpa/irony-20220110.849/irony-cdb-json.el | 336 |
1 files changed, 0 insertions, 336 deletions
diff --git a/elpa/irony-20220110.849/irony-cdb-json.el b/elpa/irony-20220110.849/irony-cdb-json.el deleted file mode 100644 index f24e144..0000000 --- a/elpa/irony-20220110.849/irony-cdb-json.el +++ /dev/null @@ -1,336 +0,0 @@ -;;; irony-cdb-json.el --- JSON Compilation Database support for irony - -;; Copyright (C) 2014 Guillaume Papin - -;; Author: Guillaume Papin <guillaume.papin@epitech.eu> -;; 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 <http://www.gnu.org/licenses/>. - -;;; 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 <output-file> and -o<output-file> - ((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 |