code.delx.au - gnu-emacs/blob - lisp/cedet/semantic/bovine/gcc.el

   1 ;;; semantic/bovine/gcc.el --- gcc querying special code for the C parser
   2
   3 ;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
   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
  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")
  32
  33 ;;; Code:
  34
  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."
  39   ;; $ gcc -v
  40   ;;
  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))
  45     (with-current-buffer buff
  46       (erase-buffer)
  47       (setenv "LC_ALL" "C")
  48       (condition-case nil
  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 "~/")))
  52            (condition-case nil
  53                (setq err (apply 'call-process gcc-cmd options))
  54              (error ;; gcc doesn't exist???
  55               nil)))))
  56       (setenv "LC_ALL" old-lc-messages)
  57       (prog1
  58           (if (zerop err)
  59               (buffer-string)
  60             err)
  61         (kill-buffer buff)))))
  62
  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."
  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 (and (file-accessible-directory-p path)
  90                            (file-name-absolute-p path))
  91                   (add-to-list 'inc-path
  92                                (expand-file-name path)
  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:
 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.")
 144
 145 ;;;###autoload
 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          (cpp-options `("-E" "-dM" "-x" "c++" ,null-device))
 152          (query (let ((q (apply 'semantic-gcc-query "cpp" cpp-options)))
 153                   (if (stringp q)
 154                       q
 155                     ;; `cpp' command in `semantic-gcc-setup' doesn't work on
 156                     ;; Mac, try `gcc'.
 157                     (apply 'semantic-gcc-query "gcc" cpp-options))))
 158          (defines (if (stringp query)
 159                       (semantic-cpp-defs query)
 160                     (message (concat "Could not query gcc for defines. "
 161                                      "Maybe g++ is not installed."))
 162                     nil))
 163          (ver (cdr (assoc 'version fields)))
 164          (host (or (cdr (assoc 'target fields))
 165                    (cdr (assoc '--target fields))
 166                    (cdr (assoc '--host fields))))
 167          ;; (prefix (cdr (assoc '--prefix fields)))
 168          ;; gcc output supplied paths
 169          ;; FIXME: Where are `c-include-path' and `c++-include-path' used?
 170          (c-include-path (semantic-gcc-get-include-paths "c"))
 171          (c++-include-path (semantic-gcc-get-include-paths "c++"))
 172          (gcc-exe (locate-file "gcc" exec-path exec-suffixes 'executable))
 173          )
 174     ;; Remember so we don't have to call GCC twice.
 175     (setq semantic-gcc-setup-data fields)
 176     (when (and (not c-include-path) gcc-exe)
 177       ;; Fallback to guesses
 178       (let* ( ;; gcc include dirs
 179              (gcc-root (expand-file-name ".." (file-name-directory gcc-exe)))
 180              (gcc-include (expand-file-name "include" gcc-root))
 181              (gcc-include-c++ (expand-file-name "c++" gcc-include))
 182              (gcc-include-c++-ver (expand-file-name ver gcc-include-c++))
 183              (gcc-include-c++-ver-host (expand-file-name host gcc-include-c++-ver)))
 184         (setq c-include-path
 185               ;; Replace cl-function remove-if-not.
 186               (delq nil (mapcar (lambda (d)
 187                                   (if (file-accessible-directory-p d) d))
 188                                 (list "/usr/include" gcc-include))))
 189         (setq c++-include-path
 190               (delq nil (mapcar (lambda (d)
 191                                   (if (file-accessible-directory-p d) d))
 192                                 (list "/usr/include"
 193                                       gcc-include
 194                                       gcc-include-c++
 195                                       gcc-include-c++-ver
 196                                       gcc-include-c++-ver-host))))))
 197
 198     ;;; Fix-me: I think this part might have been a misunderstanding, but I am not sure.
 199     ;; If this option is specified, try it both with and without prefix, and with and without host
 200     ;; (if (assoc '--with-gxx-include-dir fields)
 201     ;;     (let ((gxx-include-dir (cdr (assoc '--with-gxx-include-dir fields))))
 202     ;;       (nconc try-paths (list gxx-include-dir
 203     ;;                              (concat prefix gxx-include-dir)
 204     ;;                              (concat gxx-include-dir "/" host)
 205     ;;                              (concat prefix gxx-include-dir "/" host)))))
 206
 207     ;; Now setup include paths etc
 208     (dolist (D (semantic-gcc-get-include-paths "c"))
 209       (semantic-add-system-include D 'c-mode))
 210     (dolist (D (semantic-gcc-get-include-paths "c++"))
 211       (semantic-add-system-include D 'c++-mode)
 212       (let ((cppconfig (list (concat D "/bits/c++config.h") (concat D "/sys/cdefs.h")
 213                              (concat D "/features.h"))))
 214         (dolist (cur cppconfig)
 215           ;; Presumably there will be only one of these files in the try-paths list...
 216           (when (file-readable-p cur)
 217           ;; Add it to the symbol file
 218           (if (boundp 'semantic-lex-c-preprocessor-symbol-file)
 219               ;; Add to the core macro header list
 220               (add-to-list 'semantic-lex-c-preprocessor-symbol-file cur)
 221             ;; Setup the core macro header
 222             (setq semantic-lex-c-preprocessor-symbol-file (list cur)))
 223           ))))
 224     (if (not (boundp 'semantic-lex-c-preprocessor-symbol-map))
 225         (setq semantic-lex-c-preprocessor-symbol-map nil))
 226     (dolist (D defines)
 227       (add-to-list 'semantic-lex-c-preprocessor-symbol-map D))
 228     ;; Needed for parsing OS X libc
 229     (when (eq system-type 'darwin)
 230       (add-to-list 'semantic-lex-c-preprocessor-symbol-map '("__i386__" . "")))
 231     (when (featurep 'semantic/bovine/c)
 232       (semantic-c-reset-preprocessor-symbol-map))
 233     nil))
 234
 235 (provide 'semantic/bovine/gcc)
 236
 237 ;; Local variables:
 238 ;; generated-autoload-file: "../loaddefs.el"
 239 ;; generated-autoload-load-name: "semantic/bovine/gcc"
 240 ;; End:
 241
 242 ;;; semantic/bovine/gcc.el ends here