1 ;;; semantic/bovine/gcc.el --- gcc querying special code for the C parser
3 ;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
5 ;; Author: Eric M. Ludlam <eric@siege-engine.com>
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software: you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation, either version 3 of the License, or
12 ;; (at your option) any later version.
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24 ;; GCC stores things in special places. These functions will query
25 ;; GCC, and set up the preprocessor and include paths.
27 (require 'semantic
/dep
)
29 (defvar semantic-lex-c-preprocessor-symbol-file
)
30 (defvar semantic-lex-c-preprocessor-symbol-map
)
31 (declare-function semantic-c-reset-preprocessor-symbol-map
"semantic/bovine/c")
35 (defun semantic-gcc-query (gcc-cmd &rest gcc-options
)
36 "Return program output or error code in case error happens.
37 GCC-CMD is the program to execute and GCC-OPTIONS are the options
38 to give to the program."
41 (let* ((buff (get-buffer-create " *gcc-query*"))
42 (old-lc-messages (getenv "LC_ALL"))
43 (options `(,nil
,(cons buff t
) ,nil
,@gcc-options
))
45 (with-current-buffer buff
49 (setq err
(apply 'call-process gcc-cmd options
))
50 (error ;; Some bogus directory for the first time perhaps?
51 (let ((default-directory (expand-file-name "~/")))
53 (setq err
(apply 'call-process gcc-cmd options
))
54 (error ;; gcc doesn't exist???
56 (setenv "LC_ALL" old-lc-messages
)
61 (kill-buffer buff
)))))
63 ;;(semantic-gcc-get-include-paths "c")
64 ;;(semantic-gcc-get-include-paths "c++")
65 (defun semantic-gcc-get-include-paths (lang)
66 "Return include paths as gcc uses them for language LANG."
68 ((string= lang
"c") "gcc")
69 ((string= lang
"c++") "c++")
71 (error "Unknown lang: %s" lang
)
72 (error "LANG=%S, should be a string" lang
)))))
73 (gcc-output (semantic-gcc-query gcc-cmd
"-v" "-E" "-x" lang null-device
))
74 (lines (split-string gcc-output
"\n"))
76 (inc-mark "#include ")
77 (inc-mark-len (length "#include "))
79 ;;(message "gcc-output=%s" gcc-output)
81 (when (> (length line
) 1)
82 (if (= 0 include-marks
)
83 (when (and (> (length line
) inc-mark-len
)
84 (string= inc-mark
(substring line
0 inc-mark-len
)))
85 (setq include-marks
(1+ include-marks
)))
86 (let ((chars (append line nil
)))
87 (when (= 32 (nth 0 chars
))
88 (let ((path (substring line
1)))
89 (when (file-accessible-directory-p path
)
90 (when (if (memq system-type
'(windows-nt))
93 (add-to-list 'inc-path
94 (expand-file-name (substring line
1))
99 (defun semantic-cpp-defs (str)
100 "Convert CPP output STR into a list of cons cells with defines for C++."
101 (let ((lines (split-string str
"\n"))
104 (let ((dat (split-string L
)))
105 (when (= (length dat
) 3)
106 (add-to-list 'lst
(cons (nth 1 dat
) (nth 2 dat
))))))
109 (defun semantic-gcc-fields (str)
110 "Convert GCC output STR into an alist of fields."
112 (lines (split-string str
"\n"))
115 ;; For any line, what do we do with it?
116 (cond ((or (string-match "Configured with\\(:\\)" L
)
117 (string-match "\\(:\\)\\s-*[^ ]*configure " L
))
118 (let* ((parts (substring L
(match-end 1)))
119 (opts (split-string parts
" " t
))
121 (dolist (O (cdr opts
))
122 (let* ((data (split-string O
"="))
123 (sym (intern (car data
)))
124 (val (car (cdr data
))))
125 (push (cons sym val
) fields
)
128 ((string-match "gcc[ -][vV]ersion" L
)
129 (let* ((vline (substring L
(match-end 0)))
130 (parts (split-string vline
" ")))
131 (push (cons 'version
(nth 1 parts
)) fields
)))
132 ((string-match "Target: " L
)
133 (let ((parts (split-string L
" ")))
134 (push (cons 'target
(nth 1 parts
)) fields
)))
138 (defvar semantic-gcc-setup-data nil
140 This is setup by `semantic-gcc-setup'.
141 This is an alist, and should include keys of:
142 'version - the version of gcc
143 '--host - the host symbol (used in include directories)
144 '--prefix - where GCC was installed.
145 It should also include other symbols GCC was compiled with.")
148 (defun semantic-gcc-setup ()
149 "Setup Semantic C/C++ parsing based on GCC output."
151 (let* ((fields (or semantic-gcc-setup-data
152 (semantic-gcc-fields (semantic-gcc-query "gcc" "-v"))))
153 (cpp-options `("-E" "-dM" "-x" "c++" ,null-device
))
154 (query (let ((q (apply 'semantic-gcc-query
"cpp" cpp-options
)))
157 ;; `cpp' command in `semantic-gcc-setup' doesn't work on
159 (apply 'semantic-gcc-query
"gcc" cpp-options
))))
160 (defines (if (stringp query
)
161 (semantic-cpp-defs query
)
162 (message (concat "Could not query gcc for defines. "
163 "Maybe g++ is not installed."))
165 (ver (cdr (assoc 'version fields
)))
166 (host (or (cdr (assoc 'target fields
))
167 (cdr (assoc '--target fields
))
168 (cdr (assoc '--host fields
))))
169 (prefix (cdr (assoc '--prefix fields
)))
170 ;; gcc output supplied paths
171 (c-include-path (semantic-gcc-get-include-paths "c"))
172 (c++-include-path
(semantic-gcc-get-include-paths "c++"))
173 (gcc-exe (locate-file "gcc" exec-path exec-suffixes
'executable
))
175 ;; Remember so we don't have to call GCC twice.
176 (setq semantic-gcc-setup-data fields
)
177 (when (and (not c-include-path
) gcc-exe
)
178 ;; Fallback to guesses
179 (let* ( ;; gcc include dirs
180 (gcc-root (expand-file-name ".." (file-name-directory gcc-exe
)))
181 (gcc-include (expand-file-name "include" gcc-root
))
182 (gcc-include-c++ (expand-file-name "c++" gcc-include
))
183 (gcc-include-c++-ver
(expand-file-name ver gcc-include-c
++))
184 (gcc-include-c++-ver-host
(expand-file-name host gcc-include-c
++-ver
)))
186 ;; Replace cl-function remove-if-not.
187 (delq nil
(mapcar (lambda (d)
188 (if (file-accessible-directory-p d
) d
))
189 (list "/usr/include" gcc-include
))))
190 (setq c
++-include-path
191 (delq nil
(mapcar (lambda (d)
192 (if (file-accessible-directory-p d
) d
))
197 gcc-include-c
++-ver-host
))))))
199 ;;; Fix-me: I think this part might have been a misunderstanding, but I am not sure.
200 ;; If this option is specified, try it both with and without prefix, and with and without host
201 ;; (if (assoc '--with-gxx-include-dir fields)
202 ;; (let ((gxx-include-dir (cdr (assoc '--with-gxx-include-dir fields))))
203 ;; (nconc try-paths (list gxx-include-dir
204 ;; (concat prefix gxx-include-dir)
205 ;; (concat gxx-include-dir "/" host)
206 ;; (concat prefix gxx-include-dir "/" host)))))
208 ;; Now setup include paths etc
209 (dolist (D (semantic-gcc-get-include-paths "c"))
210 (semantic-add-system-include D
'c-mode
))
211 (dolist (D (semantic-gcc-get-include-paths "c++"))
212 (semantic-add-system-include D
'c
++-mode
)
213 (let ((cppconfig (list (concat D
"/bits/c++config.h") (concat D
"/sys/cdefs.h")
214 (concat D
"/features.h"))))
215 (dolist (cur cppconfig
)
216 ;; Presumably there will be only one of these files in the try-paths list...
217 (when (file-readable-p cur
)
218 ;; Add it to the symbol file
219 (if (boundp 'semantic-lex-c-preprocessor-symbol-file
)
220 ;; Add to the core macro header list
221 (add-to-list 'semantic-lex-c-preprocessor-symbol-file cur
)
222 ;; Setup the core macro header
223 (setq semantic-lex-c-preprocessor-symbol-file
(list cur
)))
225 (if (not (boundp 'semantic-lex-c-preprocessor-symbol-map
))
226 (setq semantic-lex-c-preprocessor-symbol-map nil
))
228 (add-to-list 'semantic-lex-c-preprocessor-symbol-map D
))
229 ;; Needed for parsing OS X libc
230 (when (eq system-type
'darwin
)
231 (add-to-list 'semantic-lex-c-preprocessor-symbol-map
'("__i386__" .
"")))
232 (when (featurep 'semantic
/bovine
/c
)
233 (semantic-c-reset-preprocessor-symbol-map))
236 (provide 'semantic
/bovine
/gcc
)
239 ;; generated-autoload-file: "../loaddefs.el"
240 ;; generated-autoload-load-name: "semantic/bovine/gcc"
243 ;;; semantic/bovine/gcc.el ends here