1 ;;; semantic/bovine/gcc.el --- gcc querying special code for the C parser
3 ;; Copyright (C) 2008-2012 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 (semantic-cpp-defs query
))
161 (ver (cdr (assoc 'version fields
)))
162 (host (or (cdr (assoc 'target fields
))
163 (cdr (assoc '--target fields
))
164 (cdr (assoc '--host fields
))))
165 (prefix (cdr (assoc '--prefix fields
)))
166 ;; gcc output supplied paths
167 (c-include-path (semantic-gcc-get-include-paths "c"))
168 (c++-include-path
(semantic-gcc-get-include-paths "c++"))
169 (gcc-exe (locate-file "gcc" exec-path exec-suffixes
'executable
))
171 ;; Remember so we don't have to call GCC twice.
172 (setq semantic-gcc-setup-data fields
)
173 (when (and (not c-include-path
) gcc-exe
)
174 ;; Fallback to guesses
175 (let* ( ;; gcc include dirs
176 (gcc-root (expand-file-name ".." (file-name-directory gcc-exe
)))
177 (gcc-include (expand-file-name "include" gcc-root
))
178 (gcc-include-c++ (expand-file-name "c++" gcc-include
))
179 (gcc-include-c++-ver
(expand-file-name ver gcc-include-c
++))
180 (gcc-include-c++-ver-host
(expand-file-name host gcc-include-c
++-ver
)))
182 ;; Replace cl-function remove-if-not.
183 (delq nil
(mapcar (lambda (d)
184 (if (file-accessible-directory-p d
) d
))
185 (list "/usr/include" gcc-include
))))
186 (setq c
++-include-path
187 (delq nil
(mapcar (lambda (d)
188 (if (file-accessible-directory-p d
) d
))
193 gcc-include-c
++-ver-host
))))))
195 ;;; Fix-me: I think this part might have been a misunderstanding, but I am not sure.
196 ;; If this option is specified, try it both with and without prefix, and with and without host
197 ;; (if (assoc '--with-gxx-include-dir fields)
198 ;; (let ((gxx-include-dir (cdr (assoc '--with-gxx-include-dir fields))))
199 ;; (nconc try-paths (list gxx-include-dir
200 ;; (concat prefix gxx-include-dir)
201 ;; (concat gxx-include-dir "/" host)
202 ;; (concat prefix gxx-include-dir "/" host)))))
204 ;; Now setup include paths etc
205 (dolist (D (semantic-gcc-get-include-paths "c"))
206 (semantic-add-system-include D
'c-mode
))
207 (dolist (D (semantic-gcc-get-include-paths "c++"))
208 (semantic-add-system-include D
'c
++-mode
)
209 (let ((cppconfig (list (concat D
"/bits/c++config.h") (concat D
"/sys/cdefs.h"))))
210 (dolist (cur cppconfig
)
211 ;; Presumably there will be only one of these files in the try-paths list...
212 (when (file-readable-p cur
)
213 ;; Add it to the symbol file
214 (if (boundp 'semantic-lex-c-preprocessor-symbol-file
)
215 ;; Add to the core macro header list
216 (add-to-list 'semantic-lex-c-preprocessor-symbol-file cur
)
217 ;; Setup the core macro header
218 (setq semantic-lex-c-preprocessor-symbol-file
(list cur
)))
220 (if (not (boundp 'semantic-lex-c-preprocessor-symbol-map
))
221 (setq semantic-lex-c-preprocessor-symbol-map nil
))
223 (add-to-list 'semantic-lex-c-preprocessor-symbol-map D
))
224 ;; Needed for parsing OS X libc
225 (when (eq system-type
'darwin
)
226 (add-to-list 'semantic-lex-c-preprocessor-symbol-map
'("__i386__" .
"")))
227 (when (featurep 'semantic
/bovine
/c
)
228 (semantic-c-reset-preprocessor-symbol-map))
231 (provide 'semantic
/bovine
/gcc
)
234 ;; generated-autoload-file: "../loaddefs.el"
235 ;; generated-autoload-load-name: "semantic/bovine/gcc"
238 ;;; semantic/bovine/gcc.el ends here