1 ;;; semantic/bovine/gcc.el --- gcc querying special code for the C parser
3 ;; Copyright (C) 2008, 2009 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 to both standard output and standard error.
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")))
48 (apply 'call-process gcc-cmd nil
(cons buff t
) nil gcc-options
)
49 (error ;; Some bogus directory for the first time perhaps?
50 (let ((default-directory (expand-file-name "~/")))
52 (apply 'call-process gcc-cmd nil
(cons buff t
) nil gcc-options
)
53 (error ;; gcc doesn't exist???
55 (setenv "LC_ALL" old-lc-messages
)
62 ;;(semantic-gcc-get-include-paths "c")
63 ;;(semantic-gcc-get-include-paths "c++")
64 (defun semantic-gcc-get-include-paths (lang)
65 "Return include paths as gcc uses them for language LANG."
67 ((string= lang
"c") "gcc")
68 ((string= lang
"c++") "c++")
70 (error "Unknown lang: %s" lang
)
71 (error "LANG=%S, should be a string" lang
)))))
72 (gcc-output (semantic-gcc-query gcc-cmd
"-v" "-E" "-x" lang null-device
))
73 (lines (split-string gcc-output
"\n"))
75 (inc-mark "#include ")
76 (inc-mark-len (length "#include "))
78 ;;(message "gcc-output=%s" gcc-output)
80 (when (> (length line
) 1)
81 (if (= 0 include-marks
)
82 (when (and (> (length line
) inc-mark-len
)
83 (string= inc-mark
(substring line
0 inc-mark-len
)))
84 (setq include-marks
(1+ include-marks
)))
85 (let ((chars (append line nil
)))
86 (when (= 32 (nth 0 chars
))
87 (let ((path (substring line
1)))
88 (when (file-accessible-directory-p path
)
89 (when (if (memq system-type
'(windows-nt))
92 (add-to-list 'inc-path
93 (expand-file-name (substring line
1))
98 (defun semantic-cpp-defs (str)
99 "Convert CPP output STR into a list of cons cells with defines for C++."
100 (let ((lines (split-string str
"\n"))
103 (let ((dat (split-string L
)))
104 (when (= (length dat
) 3)
105 (add-to-list 'lst
(cons (nth 1 dat
) (nth 2 dat
))))))
108 (defun semantic-gcc-fields (str)
109 "Convert GCC output STR into an alist of fields."
111 (lines (split-string str
"\n"))
114 ;; For any line, what do we do with it?
115 (cond ((or (string-match "Configured with\\(:\\)" L
)
116 (string-match "\\(:\\)\\s-*[^ ]*configure " L
))
117 (let* ((parts (substring L
(match-end 1)))
118 (opts (split-string parts
" " t
))
120 (dolist (O (cdr opts
))
121 (let* ((data (split-string O
"="))
122 (sym (intern (car data
)))
123 (val (car (cdr data
))))
124 (push (cons sym val
) fields
)
127 ((string-match "gcc[ -][vV]ersion" L
)
128 (let* ((vline (substring L
(match-end 0)))
129 (parts (split-string vline
" ")))
130 (push (cons 'version
(nth 1 parts
)) fields
)))
131 ((string-match "Target: " L
)
132 (let ((parts (split-string L
" ")))
133 (push (cons 'target
(nth 1 parts
)) fields
)))
137 (defvar semantic-gcc-setup-data nil
139 This is setup by `semantic-gcc-setup'.
140 This is an alist, and should include keys of:
141 'version - the version of gcc
142 '--host - the host symbol (used in include directories)
143 '--prefix - where GCC was installed.
144 It should also include other symbols GCC was compiled with.")
147 (defun semantic-gcc-setup ()
148 "Setup Semantic C/C++ parsing based on GCC output."
150 (let* ((fields (or semantic-gcc-setup-data
151 (semantic-gcc-fields (semantic-gcc-query "gcc" "-v"))))
152 (defines (semantic-cpp-defs (semantic-gcc-query "cpp" "-E" "-dM" "-x" "c++" null-device
)))
153 (ver (cdr (assoc 'version fields
)))
154 (host (or (cdr (assoc 'target fields
))
155 (cdr (assoc '--target fields
))
156 (cdr (assoc '--host fields
))))
157 (prefix (cdr (assoc '--prefix fields
)))
158 ;; gcc output supplied paths
159 (c-include-path (semantic-gcc-get-include-paths "c"))
160 (c++-include-path
(semantic-gcc-get-include-paths "c++")))
161 ;; Remember so we don't have to call GCC twice.
162 (setq semantic-gcc-setup-data fields
)
163 (unless c-include-path
164 ;; Fallback to guesses
165 (let* ( ;; gcc include dirs
166 (gcc-exe (locate-file "gcc" exec-path exec-suffixes
'executable
))
167 (gcc-root (expand-file-name ".." (file-name-directory gcc-exe
)))
168 (gcc-include (expand-file-name "include" gcc-root
))
169 (gcc-include-c++ (expand-file-name "c++" gcc-include
))
170 (gcc-include-c++-ver
(expand-file-name ver gcc-include-c
++))
171 (gcc-include-c++-ver-host
(expand-file-name host gcc-include-c
++-ver
)))
173 ;; Replace cl-function remove-if-not.
174 (delq nil
(mapcar (lambda (d)
175 (if (file-accessible-directory-p d
) d
))
176 (list "/usr/include" gcc-include
))))
177 (setq c
++-include-path
178 (delq nil
(mapcar (lambda (d)
179 (if (file-accessible-directory-p d
) d
))
184 gcc-include-c
++-ver-host
))))))
186 ;;; Fix-me: I think this part might have been a misunderstanding, but I am not sure.
187 ;; If this option is specified, try it both with and without prefix, and with and without host
188 ;; (if (assoc '--with-gxx-include-dir fields)
189 ;; (let ((gxx-include-dir (cdr (assoc '--with-gxx-include-dir fields))))
190 ;; (nconc try-paths (list gxx-include-dir
191 ;; (concat prefix gxx-include-dir)
192 ;; (concat gxx-include-dir "/" host)
193 ;; (concat prefix gxx-include-dir "/" host)))))
195 ;; Now setup include paths etc
196 (dolist (D (semantic-gcc-get-include-paths "c"))
197 (semantic-add-system-include D
'c-mode
))
198 (dolist (D (semantic-gcc-get-include-paths "c++"))
199 (semantic-add-system-include D
'c
++-mode
)
200 (let ((cppconfig (concat D
"/bits/c++config.h")))
201 ;; Presumably there will be only one of these files in the try-paths list...
202 (when (file-readable-p cppconfig
)
203 ;; Add it to the symbol file
204 (if (boundp 'semantic-lex-c-preprocessor-symbol-file
)
205 ;; Add to the core macro header list
206 (add-to-list 'semantic-lex-c-preprocessor-symbol-file cppconfig
)
207 ;; Setup the core macro header
208 (setq semantic-lex-c-preprocessor-symbol-file
(list cppconfig
)))
210 (if (not (boundp 'semantic-lex-c-preprocessor-symbol-map
))
211 (setq semantic-lex-c-preprocessor-symbol-map nil
))
213 (add-to-list 'semantic-lex-c-preprocessor-symbol-map D
))
214 (when (featurep 'semantic
/bovine
/c
)
215 (semantic-c-reset-preprocessor-symbol-map))
218 (provide 'semantic
/bovine
/gcc
)
221 ;; generated-autoload-file: "../loaddefs.el"
222 ;; generated-autoload-feature: semantic/loaddefs
223 ;; generated-autoload-load-name: "semantic/bovine/gcc"
226 ;; arch-tag: 7086f4a0-1ce8-48e2-9783-d750d3765186
227 ;;; semantic/bovine/gcc.el ends here