Skip to content
Open
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
121 changes: 71 additions & 50 deletions ede-compdb.el
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@

;; Author: Alastair Rankine <alastair@girtby.net>
;; Keywords: development ninja build cedet ede
;; Package-Version: 20150920.2033
;; Package-Requires: ((ede "1.2") (semantic "2.2") (cl-lib "0.4"))

;; This file is not part of GNU Emacs.
Expand Down Expand Up @@ -36,6 +37,7 @@
;;; Code:

(require 'ede)
(require 'semantic/db)
(require 'json)
(require 'rx)
(require 'tramp)
Expand Down Expand Up @@ -67,8 +69,7 @@
;;;###autoload
(eval-after-load "ede/auto"
'(ede-add-project-autoload
(ede-project-autoload "compdb"
:name "Compilation DB"
(ede-project-autoload :name "Compilation DB"
:file 'ede-compdb
:proj-file "compile_commands.json"
:load-type 'ede-compdb-load-project
Expand All @@ -77,8 +78,7 @@
;;;###autoload
(eval-after-load "ede/auto"
'(ede-add-project-autoload
(ede-project-autoload "ninja"
:name "Ninja"
(ede-project-autoload :name "Ninja"
:file 'ede-compdb
:proj-file "build.ninja"
:load-type 'ede-ninja-load-project
Expand Down Expand Up @@ -216,9 +216,9 @@
(defun ede-compdb-compiler-include-path (comp &optional dir)
"Look up include paths for COMP in directory DIR, and add to INCLUDE-PATHS."
(let ((path (cdr (assoc comp ede-compdb-compiler-cache))))
(unless path
(setq path (ede-compdb-get-compiler-includes comp dir))
(add-to-list 'ede-compdb-compiler-cache (cons comp path)))
;; (unless path
;; (setq path (ede-compdb-get-compiler-includes comp dir))
;; (add-to-list 'ede-compdb-compiler-cache (cons comp path)))
path))

(defun ede-compdb-make-path (base-path path)
Expand All @@ -228,33 +228,37 @@ base-path are applied to path making it accessible over Tramp."
(if (tramp-tramp-file-p base-path)
(let ((tramp-file (tramp-dissect-file-name base-path)))
(tramp-make-tramp-file-name
(tramp-file-name-method tramp-file)
(tramp-file-name-user tramp-file)
(tramp-file-name-host tramp-file)
path))
`(,(tramp-file-name-method tramp-file)
,(tramp-file-name-user tramp-file)
""
,(tramp-file-name-host tramp-file)
""
path)))
path))

;;; compdb-entry methods:

(defmethod get-command-line ((this compdb-entry))
(cl-defmethod get-command-line ((this compdb-entry))
(parse-command-line-if-needed this)
(oref this command-line))

(defmethod parse-command-line-if-needed ((this compdb-entry))
(cl-defmethod parse-command-line-if-needed ((this compdb-entry))
"For performance reasons we delay parsing the compdb command
line until needed. Call this before accessing any slots derived
from the command line (which is most of them!)"
;; compiler slot is used to determine whether we need to parse the command line
(unless (slot-boundp this :compiler)
(parse-command-line this)))
(parse-command-line this (oref this command-line)))
)

(defconst ede-compdb-entry-combined-args-rx
(rx
string-start
(submatch
(or (: "-" (any "DUIF"))
"-isystem"
"--sysroot"))
"--sysroot"
"@"))
(optional
(submatch (+? (not (any "=")))))
(optional
Expand All @@ -273,11 +277,11 @@ from the command line (which is most of them!)"
string-end)
"Regex to identify directories which are relative to sysroot")

(defmethod parse-command-line ((this compdb-entry))
(cl-defmethod parse-command-line ((this compdb-entry) command-line)
"Parse the :command-line slot of THIS to derive :compiler, :include-path, etc."
(let ((args (split-string (oref this command-line)))
(seenopt nil)
(case-fold-search nil))
(let* ((args (split-string command-line))
(seenopt nil)
(case-fold-search nil))
;; parsing code inspired by `command-line'
(while args
(let ((argi (pop args)) argval eqval)
Expand All @@ -286,8 +290,12 @@ from the command line (which is most of them!)"
(setq argval (match-string 2 argi))
(setq eqval (match-string 3 argi))
(setq argi (match-string 1 argi)))
(when (char-equal ?- (string-to-char argi))
(setq seenopt t))
(let ((first-char (string-to-char argi)))
(when (or (char-equal ?- first-char)
(and (char-equal ?/ first-char)
(not (file-exists-p argi))))
(setq seenopt t)))
;ooooooo
(pcase argi
(`"-D"
(object-add-to-list this :defines (cons (or argval (pop args)) eqval) t))
Expand All @@ -296,6 +304,12 @@ from the command line (which is most of them!)"
;; TODO: support gcc notation "=dir" where '=' is the sysroot prefix
((or `"-I" `"-F" `"-isystem")
(object-add-to-list this :include-path (file-name-as-directory (or argval (pop args))) t))
(`"@"
(parse-command-line
this
(with-temp-buffer
(insert-file-contents (concat (oref this directory) (or argval (pop args))))
(buffer-string))))
(`"-include"
(object-add-to-list this :includes (pop args) t)) ;; append
(`"-imacros"
Expand All @@ -322,7 +336,7 @@ from the command line (which is most of them!)"
(oref this include-path))
))

(defmethod get-defines ((this compdb-entry))
(cl-defmethod get-defines ((this compdb-entry))
"Get the preprocessor defines for THIS compdb entry. Returns a list of strings, suitable for use with -D arguments."
(parse-command-line-if-needed this)
(mapcar
Expand All @@ -332,7 +346,7 @@ from the command line (which is most of them!)"
(car def)))
(oref this defines)))

(defmethod get-include-path ((this compdb-entry) &optional excludecompiler)
(cl-defmethod get-include-path ((this compdb-entry) &optional excludecompiler)
"Get the system include path used by THIS compdb entry.
If EXCLUDECOMPILER is t, we ignore compiler include paths"
(parse-command-line-if-needed this)
Expand All @@ -346,7 +360,7 @@ If EXCLUDECOMPILER is t, we ignore compiler include paths"
path)))
))

(defmethod get-includes ((this compdb-entry))
(cl-defmethod get-includes ((this compdb-entry))
"Get the include files used by THIS compdb entry. Relative paths are resolved."
(parse-command-line-if-needed this)
(mapcar (lambda (I)
Expand All @@ -355,15 +369,15 @@ If EXCLUDECOMPILER is t, we ignore compiler include paths"

;;; ede-compdb-target methods:

(defmethod ede-system-include-path ((this ede-compdb-target) &optional excludecompiler)
(cl-defmethod ede-system-include-path ((this ede-compdb-target) &optional excludecompiler)
"Get the system include path used by project THIS target.
If EXCLUDECOMPILER is t, we ignore compiler include paths"
(project-rescan-if-needed (oref this project))
(let ((comp (oref this compilation)))
(when comp
(get-include-path comp excludecompiler))))

(defmethod ede-preprocessor-map ((this ede-compdb-target))
(cl-defmethod ede-preprocessor-map ((this ede-compdb-target))
"Get the preprocessor map for target THIS."
(project-rescan-if-needed (oref this project))
(let ((comp (oref this compilation)))
Expand Down Expand Up @@ -396,11 +410,11 @@ If EXCLUDECOMPILER is t, we ignore compiler include paths"
(oref (oref this compilation) includes))
spp))))

(defmethod project-compile-target ((this ede-compdb-target))
(cl-defmethod project-compile-target ((this ede-compdb-target))
"Compile the current target THIS."
(project-compile-target (oref this project) this))

(defmethod ede-project-root ((this ede-compdb-target))
(cl-defmethod ede-project-root ((this ede-compdb-target))
"Returns the root project for target THIS."
(oref this project))

Expand Down Expand Up @@ -449,13 +463,13 @@ If EXCLUDECOMPILER is t, we ignore compiler include paths"

;;; ede-compdb-project methods:

(defmethod current-configuration-directory-path ((this ede-compdb-project) &optional config)
(cl-defmethod current-configuration-directory-path ((this ede-compdb-project) &optional config)
"Returns the path to the configuration directory for CONFIG, or for :configuration-default if CONFIG not set"
(let ((dir (nth (cl-position (or config (oref this configuration-default)) (oref this configurations) :test 'equal)
(oref this configuration-directories))))
(and dir (file-name-as-directory (expand-file-name dir (oref this directory))))))

(defmethod current-configuration-directory ((this ede-compdb-project) &optional config)
(cl-defmethod current-configuration-directory ((this ede-compdb-project) &optional config)
"Returns the validated configuration directory for CONFIG, or for :configuration-default if CONFIG not set"
(let ((dir (current-configuration-directory-path this config)))
(unless dir
Expand All @@ -464,7 +478,7 @@ If EXCLUDECOMPILER is t, we ignore compiler include paths"
(error "Directory not found for configuration %s: %s" config dir))
dir))

(defmethod set-configuration-directory ((this ede-compdb-project) dir &optional config)
(cl-defmethod set-configuration-directory ((this ede-compdb-project) dir &optional config)
"Sets the directory for configuration CONFIG to DIR. The
current configuration directory is used if CONFIG not set."
(let ((config (or config (oref this configuration-default))))
Expand All @@ -473,23 +487,23 @@ current configuration directory is used if CONFIG not set."
dir)
(message "Configuration \"%s\" directory set to: %s" config dir)))

(defmethod current-compdb-path ((this ede-compdb-project))
(cl-defmethod current-compdb-path ((this ede-compdb-project))
"Returns a path to the current compdb file"
(expand-file-name (oref this compdb-file) (current-configuration-directory-path this)))

(defmethod insert-compdb ((_this ede-compdb-project) compdb-path)
(cl-defmethod insert-compdb ((_this ede-compdb-project) compdb-path)
"Inserts the compilation database into the current buffer"
(insert-file-contents compdb-path))

(defmethod other-file-list ((_this ede-compdb-project) fname)
(cl-defmethod other-file-list ((_this ede-compdb-project) fname)
"Returns a list of 'other' files for FNAME."
;; Use projectile-get-other-files if defined, or ff-other-file-list (see below) if not
(or (and (fboundp 'projectile-get-other-files)
(projectile-project-p)
(projectile-get-other-files fname (projectile-current-project-files) t))
(projectile-get-other-files fname (projectile-current-project-files) ))
(ff-other-file-list)))

(defmethod compdb-entry-for-buffer ((this ede-compdb-project))
(cl-defmethod compdb-entry-for-buffer ((this ede-compdb-project))
"Returns an instance of ede-compdb-entry suitable for use with
the current buffer. In general, we do a lookup on the current
buffer file in the compdb hashtable. If not present, we look
Expand Down Expand Up @@ -518,7 +532,7 @@ an d pick one that is present in the compdb hashtable."
bestmatch)
)))

(defmethod project-rescan ((this ede-compdb-project))
(cl-defmethod project-rescan ((this ede-compdb-project))
"Reload the compilation database."
(clrhash (oref this compdb))
(let* ((compdb-path (current-compdb-path this))
Expand All @@ -544,7 +558,14 @@ an d pick one that is present in the compdb hashtable."
(let* ((directory (file-name-as-directory (ede-compdb-make-path compdb-path (cdr (assoc 'directory E)))))
(filename (expand-file-name (ede-compdb-make-path compdb-path (cdr (assoc 'file E))) directory))
(filetruename (file-truename filename))
(command-line (cdr (assoc 'command E)))
;; From http://clang.llvm.org/docs/JSONCompilationDatabase.html
;; arguments: The compile command executed as list of strings.
;; Either arguments or command is required.
;; More recent versions of bear prefer "arguments", so we generate
;; "command" field from "arguments" field.
(command-line (or (cdr (assoc 'command E)) (reduce (lambda (acum arg)
(concat acum " " arg))
(cdr (assoc 'arguments E)))))
(compilation
(compdb-entry filename
:command-line command-line
Expand Down Expand Up @@ -601,7 +622,7 @@ an d pick one that is present in the compdb hashtable."

))

(defmethod project-rescan-if-needed ((this ede-compdb-project))
(cl-defmethod project-rescan-if-needed ((this ede-compdb-project))
"Reload the compilation database if the corresponding watch file has changed."
(let ((stats (file-attributes (current-compdb-path this))))
;; Logic stolen from ede/arduino.el
Expand All @@ -612,7 +633,7 @@ an d pick one that is present in the compdb hashtable."
(not (equal (oref this compdb-file-timestamp) (nth 5 stats)))))
(project-rescan this))))

(defmethod initialize-instance :AFTER ((this ede-compdb-project) &rest _fields)
(cl-defmethod initialize-instance :after ((this ede-compdb-project) &rest _fields)
(unless (slot-boundp this 'targets)
(oset this :targets nil))

Expand Down Expand Up @@ -650,12 +671,12 @@ an d pick one that is present in the compdb hashtable."
(message "Error reading Compilation Database: %s not found" (current-compdb-path this)))
)

(defmethod ede-find-subproject-for-directory ((proj ede-compdb-project)
(cl-defmethod ede-find-subproject-for-directory ((proj ede-compdb-project)
_dir)
"Return PROJ, for handling all subdirs below DIR."
proj)

(defmethod ede-find-target ((this ede-compdb-project) buffer)
(cl-defmethod ede-find-target ((this ede-compdb-project) buffer)
"Find an EDE target in THIS for BUFFER.
If one doesn't exist, create a new one."
(let* ((path (ede-convert-path this buffer-file-name))
Expand All @@ -672,7 +693,7 @@ If one doesn't exist, create a new one."
)
ans))

(defmethod project-compile-target ((this ede-compdb-project) target)
(cl-defmethod project-compile-target ((this ede-compdb-project) target)
"Build TARGET using :build-command. TARGET may be an instance
of `ede-compdb-target' or a string."
(project-rescan-if-needed this)
Expand All @@ -686,15 +707,15 @@ of `ede-compdb-target' or a string."
(compile cmd)
))

(defmethod project-compile-project ((this ede-compdb-project))
(cl-defmethod project-compile-project ((this ede-compdb-project))
"Build the project THIS using :build-command"
(let ((default-directory (current-configuration-directory this)))
(compile (oref this build-command))
))

(defmethod ede-menu-items-build ((_this ede-compdb-project) &optional _current)
(cl-defmethod ede-menu-items-build ((_this ede-compdb-project) &optional _current)
"Override to add a custom target menu item"
(append (call-next-method)
(append (cl-call-next-method)
(list
[ "Set Configuration Directory..." ede-compdb-set-configuration-directory ])))

Expand All @@ -708,9 +729,9 @@ of `ede-compdb-target' or a string."
(defvar ede-ninja-target-regexp "^\\(.+\\): \\(phony\\|CLEAN\\)$"
"Regexp to identify phony targets in the output of ninja -t targets.")

(defmethod project-rescan ((this ede-ninja-project))
(cl-defmethod project-rescan ((this ede-ninja-project))
"Get ninja to describe the set of phony targets, add them to the target list"
(call-next-method)
(cl-call-next-method)
(with-temp-buffer
(let ((default-directory (current-configuration-directory this)))
(oset this phony-targets nil)
Expand All @@ -726,15 +747,15 @@ of `ede-compdb-target' or a string."
(progress-reporter-done progress-reporter))
)))

(defmethod insert-compdb ((this ede-ninja-project) compdb-path)
(cl-defmethod insert-compdb ((this ede-ninja-project) compdb-path)
"Use ninja's compdb tool to insert the compilation database
into the current buffer. COMPDB-PATH represents the current path
to :compdb-file"
(message "Building compilation database...")
(let ((default-directory (file-name-directory compdb-path)))
(apply 'process-file (append `("ninja" nil t nil "-f" ,(oref this compdb-file) "-t" "compdb") (oref this :build-rules)))))

(defmethod project-interactive-select-target ((this ede-ninja-project) prompt)
(cl-defmethod project-interactive-select-target ((this ede-ninja-project) prompt)
"Interactively query for a target. Argument PROMPT is the prompt to use."
(let ((tname (completing-read prompt (oref this phony-targets) nil nil nil 'ede-ninja-target-history)))
;; Create a new target and return it - doesn't matter that it's not in :targets list...
Expand Down