Commit | Line | Data |
---|---|---|
4feec2f5 CY |
1 | ;;; semantic/bovine/gcc.el --- gcc querying special code for the C parser |
2 | ||
73b0cd50 | 3 | ;; Copyright (C) 2008-2011 Free Software Foundation, Inc. |
4feec2f5 CY |
4 | |
5 | ;; Author: Eric M. Ludlam <eric@siege-engine.com> | |
6 | ||
7 | ;; This file is part of GNU Emacs. | |
8 | ||
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. | |
13 | ||
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. | |
18 | ||
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/>. | |
21 | ||
22 | ;;; Commentary: | |
23 | ;; | |
24 | ;; GCC stores things in special places. These functions will query | |
25 | ;; GCC, and set up the preprocessor and include paths. | |
26 | ||
27 | (require 'semantic/dep) | |
28 | ||
1fe1547a CY |
29 | (defvar semantic-lex-c-preprocessor-symbol-file) |
30 | (defvar semantic-lex-c-preprocessor-symbol-map) | |
57b0083a | 31 | (declare-function semantic-c-reset-preprocessor-symbol-map "semantic/bovine/c") |
4feec2f5 CY |
32 | |
33 | ;;; Code: | |
34 | ||
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." | |
39 | ;; $ gcc -v | |
40 | ;; | |
41 | (let ((buff (get-buffer-create " *gcc-query*")) | |
42 | (old-lc-messages (getenv "LC_ALL"))) | |
0816d744 | 43 | (with-current-buffer buff |
4feec2f5 CY |
44 | (erase-buffer) |
45 | (setenv "LC_ALL" "C") | |
46 | (condition-case nil | |
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 "~/"))) | |
50 | (condition-case nil | |
51 | (apply 'call-process gcc-cmd nil (cons buff t) nil gcc-options) | |
52 | (error ;; gcc doesn't exist??? | |
53 | nil))))) | |
54 | (setenv "LC_ALL" old-lc-messages) | |
55 | (prog1 | |
56 | (buffer-string) | |
57 | (kill-buffer buff) | |
58 | ) | |
59 | ))) | |
60 | ||
61 | ;;(semantic-gcc-get-include-paths "c") | |
62 | ;;(semantic-gcc-get-include-paths "c++") | |
63 | (defun semantic-gcc-get-include-paths (lang) | |
57b0083a | 64 | "Return include paths as gcc uses them for language LANG." |
4feec2f5 CY |
65 | (let* ((gcc-cmd (cond |
66 | ((string= lang "c") "gcc") | |
67 | ((string= lang "c++") "c++") | |
68 | (t (if (stringp lang) | |
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")) | |
73 | (include-marks 0) | |
74 | (inc-mark "#include ") | |
75 | (inc-mark-len (length "#include ")) | |
76 | inc-path) | |
77 | ;;(message "gcc-output=%s" gcc-output) | |
78 | (dolist (line lines) | |
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)) | |
89 | (/= ?/ (nth 1 chars)) | |
90 | (= ?/ (nth 1 chars))) | |
91 | (add-to-list 'inc-path | |
92 | (expand-file-name (substring line 1)) | |
93 | t))))))))) | |
94 | inc-path)) | |
95 | ||
96 | ||
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")) | |
100 | (lst nil)) | |
101 | (dolist (L lines) | |
102 | (let ((dat (split-string L))) | |
103 | (when (= (length dat) 3) | |
104 | (add-to-list 'lst (cons (nth 1 dat) (nth 2 dat)))))) | |
105 | lst)) | |
106 | ||
107 | (defun semantic-gcc-fields (str) | |
108 | "Convert GCC output STR into an alist of fields." | |
109 | (let ((fields nil) | |
110 | (lines (split-string str "\n")) | |
111 | ) | |
112 | (dolist (L lines) | |
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)) | |
118 | ) | |
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) | |
124 | )) | |
125 | )) | |
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))) | |
133 | )) | |
134 | fields)) | |
135 | ||
136 | (defvar semantic-gcc-setup-data nil | |
137 | "The GCC setup data. | |
138 | This is setup by `semantic-gcc-setup'. | |
139 | This is an alist, and should include keys of: | |
57b0083a GM |
140 | 'version - the version of gcc |
141 | '--host - the host symbol (used in include directories) | |
142 | '--prefix - where GCC was installed. | |
4feec2f5 CY |
143 | It should also include other symbols GCC was compiled with.") |
144 | ||
1fe1547a | 145 | ;;;###autoload |
4feec2f5 CY |
146 | (defun semantic-gcc-setup () |
147 | "Setup Semantic C/C++ parsing based on GCC output." | |
148 | (interactive) | |
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))) | |
171 | (setq c-include-path | |
9280709b GM |
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)))) | |
4feec2f5 | 176 | (setq c++-include-path |
9280709b GM |
177 | (delq nil (mapcar (lambda (d) |
178 | (if (file-accessible-directory-p d) d)) | |
179 | (list "/usr/include" | |
180 | gcc-include | |
181 | gcc-include-c++ | |
182 | gcc-include-c++-ver | |
183 | gcc-include-c++-ver-host)))))) | |
4feec2f5 CY |
184 | |
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))))) | |
193 | ||
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))) | |
208 | ))) | |
209 | (if (not (boundp 'semantic-lex-c-preprocessor-symbol-map)) | |
210 | (setq semantic-lex-c-preprocessor-symbol-map nil)) | |
211 | (dolist (D defines) | |
212 | (add-to-list 'semantic-lex-c-preprocessor-symbol-map D)) | |
213 | (when (featurep 'semantic/bovine/c) | |
214 | (semantic-c-reset-preprocessor-symbol-map)) | |
215 | nil)) | |
216 | ||
4feec2f5 | 217 | (provide 'semantic/bovine/gcc) |
1fe1547a CY |
218 | |
219 | ;; Local variables: | |
220 | ;; generated-autoload-file: "../loaddefs.el" | |
1fe1547a CY |
221 | ;; generated-autoload-load-name: "semantic/bovine/gcc" |
222 | ;; End: | |
223 | ||
4feec2f5 | 224 | ;;; semantic/bovine/gcc.el ends here |