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