1 files changed, 336 insertions, 0 deletions
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 <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