[bpt/emacs.git] / lisp / cedet / semantic / bovine / gcc.el

;;; semantic/bovine/gcc.el --- gcc querying special code for the C parser

;; Copyright (C) 2008-2013 Free Software Foundation, Inc.

;; Author: Eric M. Ludlam <eric@siege-engine.com>

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; GCC stores things in special places.  These functions will query
;; GCC, and set up the preprocessor and include paths.

(require 'semantic/dep)

(defvar semantic-lex-c-preprocessor-symbol-file)
(defvar semantic-lex-c-preprocessor-symbol-map)
(declare-function semantic-c-reset-preprocessor-symbol-map "semantic/bovine/c")

;;; Code:

(defun semantic-gcc-query (gcc-cmd &rest gcc-options)
  "Return program output or error code in case error happens.
GCC-CMD is the program to execute and GCC-OPTIONS are the options
to give to the program."
  ;; $ gcc -v
  ;;
  (let* ((buff (get-buffer-create " *gcc-query*"))
         (old-lc-messages (getenv "LC_ALL"))
         (options `(,nil ,(cons buff t) ,nil ,@gcc-options))
         (err 0))
    (with-current-buffer buff
      (erase-buffer)
      (setenv "LC_ALL" "C")
      (condition-case nil
          (setq err (apply 'call-process gcc-cmd options))
        (error ;; Some bogus directory for the first time perhaps?
         (let ((default-directory (expand-file-name "~/")))
           (condition-case nil
               (setq err (apply 'call-process gcc-cmd options))
             (error ;; gcc doesn't exist???
              nil)))))
      (setenv "LC_ALL" old-lc-messages)
      (prog1
          (if (zerop err)
              (buffer-string)
            err)
        (kill-buffer buff)))))

;;(semantic-gcc-get-include-paths "c")
;;(semantic-gcc-get-include-paths "c++")
(defun semantic-gcc-get-include-paths (lang)
  "Return include paths as gcc uses them for language LANG."
  (let* ((gcc-cmd (cond
                   ((string= lang "c") "gcc")
                   ((string= lang "c++") "c++")
                   (t (if (stringp lang)
                          (error "Unknown lang: %s" lang)
                        (error "LANG=%S, should be a string" lang)))))
         (gcc-output (semantic-gcc-query gcc-cmd "-v" "-E" "-x" lang null-device))
         (lines (split-string gcc-output "\n"))
         (include-marks 0)
         (inc-mark "#include ")
         (inc-mark-len (length "#include "))
         inc-path)
    ;;(message "gcc-output=%s" gcc-output)
    (dolist (line lines)
      (when (> (length line) 1)
        (if (= 0 include-marks)
            (when (and (> (length line) inc-mark-len)
                       (string= inc-mark (substring line 0 inc-mark-len)))
              (setq include-marks (1+ include-marks)))
          (let ((chars (append line nil)))
            (when (= 32 (nth 0 chars))
              (let ((path (substring line 1)))
                (when (file-accessible-directory-p path)
                  (when (if (memq system-type '(windows-nt))
                            (/= ?/ (nth 1 chars))
                          (= ?/ (nth 1 chars)))
                    (add-to-list 'inc-path
                                 (expand-file-name (substring line 1))
                                 t)))))))))
    inc-path))


(defun semantic-cpp-defs (str)
  "Convert CPP output STR into a list of cons cells with defines for C++."
  (let ((lines (split-string str "\n"))
        (lst nil))
    (dolist (L lines)
      (let ((dat (split-string L)))
        (when (= (length dat) 3)
          (add-to-list 'lst (cons (nth 1 dat) (nth 2 dat))))))
    lst))

(defun semantic-gcc-fields (str)
  "Convert GCC output STR into an alist of fields."
  (let ((fields nil)
        (lines (split-string str "\n"))
        )
    (dolist (L lines)
      ;; For any line, what do we do with it?
      (cond ((or (string-match "Configured with\\(:\\)" L)
                 (string-match "\\(:\\)\\s-*[^ ]*configure " L))
             (let* ((parts (substring L (match-end 1)))
                    (opts (split-string parts " " t))
                    )
               (dolist (O (cdr opts))
                 (let* ((data (split-string O "="))
                        (sym (intern (car data)))
                        (val (car (cdr data))))
                   (push (cons sym val) fields)
                   ))
               ))
            ((string-match "gcc[ -][vV]ersion" L)
             (let* ((vline (substring L (match-end 0)))
                    (parts (split-string vline " ")))
               (push (cons 'version (nth 1 parts)) fields)))
            ((string-match "Target: " L)
             (let ((parts (split-string L " ")))
               (push (cons 'target (nth 1 parts)) fields)))
            ))
    fields))

(defvar semantic-gcc-setup-data nil
  "The GCC setup data.
This is setup by `semantic-gcc-setup'.
This is an alist, and should include keys of:
  'version  - the version of gcc
  '--host   - the host symbol (used in include directories)
  '--prefix - where GCC was installed.
It should also include other symbols GCC was compiled with.")

;;;###autoload
(defun semantic-gcc-setup ()
  "Setup Semantic C/C++ parsing based on GCC output."
  (interactive)
  (let* ((fields (or semantic-gcc-setup-data
                     (semantic-gcc-fields (semantic-gcc-query "gcc" "-v"))))
         (cpp-options `("-E" "-dM" "-x" "c++" ,null-device))
         (query (let ((q (apply 'semantic-gcc-query "cpp" cpp-options)))
                  (if (stringp q)
                      q
                    ;; `cpp' command in `semantic-gcc-setup' doesn't work on
                    ;; Mac, try `gcc'.
                    (apply 'semantic-gcc-query "gcc" cpp-options))))
         (defines (semantic-cpp-defs query))
         (ver (cdr (assoc 'version fields)))
         (host (or (cdr (assoc 'target fields))
                   (cdr (assoc '--target fields))
                   (cdr (assoc '--host fields))))
         (prefix (cdr (assoc '--prefix fields)))
         ;; gcc output supplied paths
         (c-include-path (semantic-gcc-get-include-paths "c"))
         (c++-include-path (semantic-gcc-get-include-paths "c++"))
	 (gcc-exe (locate-file "gcc" exec-path exec-suffixes 'executable))
	 )
    ;; Remember so we don't have to call GCC twice.
    (setq semantic-gcc-setup-data fields)
    (when (and (not c-include-path) gcc-exe)
      ;; Fallback to guesses
      (let* ( ;; gcc include dirs
             (gcc-root (expand-file-name ".." (file-name-directory gcc-exe)))
             (gcc-include (expand-file-name "include" gcc-root))
             (gcc-include-c++ (expand-file-name "c++" gcc-include))
             (gcc-include-c++-ver (expand-file-name ver gcc-include-c++))
             (gcc-include-c++-ver-host (expand-file-name host gcc-include-c++-ver)))
        (setq c-include-path
              ;; Replace cl-function remove-if-not.
              (delq nil (mapcar (lambda (d)
                                  (if (file-accessible-directory-p d) d))
                                (list "/usr/include" gcc-include))))
        (setq c++-include-path
              (delq nil (mapcar (lambda (d)
                                  (if (file-accessible-directory-p d) d))
                                (list "/usr/include"
                                      gcc-include
                                      gcc-include-c++
                                      gcc-include-c++-ver
                                      gcc-include-c++-ver-host))))))

    ;;; Fix-me: I think this part might have been a misunderstanding, but I am not sure.
    ;; If this option is specified, try it both with and without prefix, and with and without host
    ;; (if (assoc '--with-gxx-include-dir fields)
    ;;     (let ((gxx-include-dir (cdr (assoc '--with-gxx-include-dir fields))))
    ;;       (nconc try-paths (list gxx-include-dir
    ;;                              (concat prefix gxx-include-dir)
    ;;                              (concat gxx-include-dir "/" host)
    ;;                              (concat prefix gxx-include-dir "/" host)))))

    ;; Now setup include paths etc
    (dolist (D (semantic-gcc-get-include-paths "c"))
      (semantic-add-system-include D 'c-mode))
    (dolist (D (semantic-gcc-get-include-paths "c++"))
      (semantic-add-system-include D 'c++-mode)
      (let ((cppconfig (list (concat D "/bits/c++config.h") (concat D "/sys/cdefs.h"))))
	(dolist (cur cppconfig)
	  ;; Presumably there will be only one of these files in the try-paths list...
	  (when (file-readable-p cur)
          ;; Add it to the symbol file
          (if (boundp 'semantic-lex-c-preprocessor-symbol-file)
              ;; Add to the core macro header list
              (add-to-list 'semantic-lex-c-preprocessor-symbol-file cur)
            ;; Setup the core macro header
            (setq semantic-lex-c-preprocessor-symbol-file (list cur)))
          ))))
    (if (not (boundp 'semantic-lex-c-preprocessor-symbol-map))
        (setq semantic-lex-c-preprocessor-symbol-map nil))
    (dolist (D defines)
      (add-to-list 'semantic-lex-c-preprocessor-symbol-map D))
    ;; Needed for parsing OS X libc
    (when (eq system-type 'darwin)
      (add-to-list 'semantic-lex-c-preprocessor-symbol-map '("__i386__" . "")))
    (when (featurep 'semantic/bovine/c)
      (semantic-c-reset-preprocessor-symbol-map))
    nil))

(provide 'semantic/bovine/gcc)

;; Local variables:
;; generated-autoload-file: "../loaddefs.el"
;; generated-autoload-load-name: "semantic/bovine/gcc"
;; End:

;;; semantic/bovine/gcc.el ends here
Commit	Line	Data
4feec2f5 CY	1	;;; semantic/bovine/gcc.el --- gcc querying special code for the C parser
4feec2f5 CY	2
ab422c4d	3	;; Copyright (C) 2008-2013 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)
1fe1547a CY	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)
62a81506	36	"Return program output or error code in case error happens.
4feec2f5 CY	37	GCC-CMD is the program to execute and GCC-OPTIONS are the options
	38	to give to the program."
	39	;; $ gcc -v
	40	;;
62a81506 CY	41	(let* ((buff (get-buffer-create " gcc-query"))
	42	(old-lc-messages (getenv "LC_ALL"))
	43	(options `(,nil ,(cons buff t) ,nil ,@gcc-options))
	44	(err 0))
0816d744	45	(with-current-buffer buff
4feec2f5 CY	46	(erase-buffer)
	47	(setenv "LC_ALL" "C")
	48	(condition-case nil
62a81506	49	(setq err (apply 'call-process gcc-cmd options))
4feec2f5 CY	50	(error ;; Some bogus directory for the first time perhaps?
	51	(let ((default-directory (expand-file-name "~/")))
	52	(condition-case nil
62a81506	53	(setq err (apply 'call-process gcc-cmd options))
4feec2f5 CY	54	(error ;; gcc doesn't exist???
	55	nil)))))
	56	(setenv "LC_ALL" old-lc-messages)
	57	(prog1
62a81506 CY	58	(if (zerop err)
	59	(buffer-string)
	60	err)
	61	(kill-buffer buff)))))
4feec2f5 CY	62
	63	;;(semantic-gcc-get-include-paths "c")
	64	;;(semantic-gcc-get-include-paths "c++")
	65	(defun semantic-gcc-get-include-paths (lang)
57b0083a	66	"Return include paths as gcc uses them for language LANG."
4feec2f5 CY	67	(let* ((gcc-cmd (cond
	68	((string= lang "c") "gcc")
	69	((string= lang "c++") "c++")
	70	(t (if (stringp lang)
	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"))
	75	(include-marks 0)
	76	(inc-mark "#include ")
	77	(inc-mark-len (length "#include "))
	78	inc-path)
	79	;;(message "gcc-output=%s" gcc-output)
	80	(dolist (line lines)
	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))
	91	(/= ?/ (nth 1 chars))
	92	(= ?/ (nth 1 chars)))
	93	(add-to-list 'inc-path
	94	(expand-file-name (substring line 1))
	95	t)))))))))
	96	inc-path))
	97
	98
	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"))
	102	(lst nil))
	103	(dolist (L lines)
	104	(let ((dat (split-string L)))
	105	(when (= (length dat) 3)
	106	(add-to-list 'lst (cons (nth 1 dat) (nth 2 dat))))))
	107	lst))
	108
	109	(defun semantic-gcc-fields (str)
	110	"Convert GCC output STR into an alist of fields."
	111	(let ((fields nil)
	112	(lines (split-string str "\n"))
	113	)
	114	(dolist (L lines)
	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))
	120	)
	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)
	126	))
	127	))
	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)))
135	))
136	fields))
137
138	(defvar semantic-gcc-setup-data nil
139	"The GCC setup data.
140	This is setup by `semantic-gcc-setup'.
141	This is an alist, and should include keys of:
57b0083a GM	142	'version - the version of gcc
	143	'--host - the host symbol (used in include directories)
	144	'--prefix - where GCC was installed.
4feec2f5 CY	145	It should also include other symbols GCC was compiled with.")
4feec2f5 CY	146
1fe1547a	147	;;;###autoload
4feec2f5 CY	148	(defun semantic-gcc-setup ()
	149	"Setup Semantic C/C++ parsing based on GCC output."
	150	(interactive)
	151	(let* ((fields (or semantic-gcc-setup-data
	152	(semantic-gcc-fields (semantic-gcc-query "gcc" "-v"))))
62a81506 CY	153	(cpp-options `("-E" "-dM" "-x" "c++" ,null-device))
	154	(query (let ((q (apply 'semantic-gcc-query "cpp" cpp-options)))
	155	(if (stringp q)
	156	q
	157	;; `cpp' command in `semantic-gcc-setup' doesn't work on
	158	;; Mac, try `gcc'.
	159	(apply 'semantic-gcc-query "gcc" cpp-options))))
	160	(defines (semantic-cpp-defs query))
4feec2f5 CY	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"))
62a81506 CY	168	(c++-include-path (semantic-gcc-get-include-paths "c++"))
	169	(gcc-exe (locate-file "gcc" exec-path exec-suffixes 'executable))
	170	)
4feec2f5 CY	171	;; Remember so we don't have to call GCC twice.
4feec2f5 CY	172	(setq semantic-gcc-setup-data fields)
62a81506	173	(when (and (not c-include-path) gcc-exe)
4feec2f5 CY	174	;; Fallback to guesses
4feec2f5 CY	175	(let* ( ;; gcc include dirs
4feec2f5 CY	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)))
	181	(setq c-include-path
9280709b GM	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))))
4feec2f5	186	(setq c++-include-path
9280709b GM	187	(delq nil (mapcar (lambda (d)
	188	(if (file-accessible-directory-p d) d))
	189	(list "/usr/include"
	190	gcc-include
	191	gcc-include-c++
	192	gcc-include-c++-ver
	193	gcc-include-c++-ver-host))))))
4feec2f5 CY	194
	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)))))
	203
	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)
62a81506 CY	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)
4feec2f5 CY	213	;; Add it to the symbol file
	214	(if (boundp 'semantic-lex-c-preprocessor-symbol-file)
	215	;; Add to the core macro header list
62a81506	216	(add-to-list 'semantic-lex-c-preprocessor-symbol-file cur)
4feec2f5	217	;; Setup the core macro header
62a81506 CY	218	(setq semantic-lex-c-preprocessor-symbol-file (list cur)))
62a81506 CY	219	))))
4feec2f5 CY	220	(if (not (boundp 'semantic-lex-c-preprocessor-symbol-map))
	221	(setq semantic-lex-c-preprocessor-symbol-map nil))
	222	(dolist (D defines)
	223	(add-to-list 'semantic-lex-c-preprocessor-symbol-map D))
62a81506 CY	224	;; Needed for parsing OS X libc
	225	(when (eq system-type 'darwin)
	226	(add-to-list 'semantic-lex-c-preprocessor-symbol-map '("__i386__" . "")))
4feec2f5 CY	227	(when (featurep 'semantic/bovine/c)
	228	(semantic-c-reset-preprocessor-symbol-map))
	229	nil))
	230
4feec2f5	231	(provide 'semantic/bovine/gcc)
1fe1547a CY	232
	233	;; Local variables:
	234	;; generated-autoload-file: "../loaddefs.el"
1fe1547a CY	235	;; generated-autoload-load-name: "semantic/bovine/gcc"
	236	;; End:
	237
4feec2f5	238	;;; semantic/bovine/gcc.el ends here