lisp/cedet/semantic/bovine/make.el

   1 ;;; semantic/bovine/make.el --- Makefile parsing rules.
   2
   3 ;; Copyright (C) 2000-2004, 2008-2014 Free Software Foundation, Inc.
   4
   5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
   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 ;; Use the Semantic Bovinator to parse Makefiles.
  25 ;; Concocted as an experiment for nonstandard languages.
  26
  27 (require 'make-mode)
  28
  29 (require 'semantic)
  30 (require 'semantic/bovine)
  31 (require 'semantic/bovine/make-by)
  32 (require 'semantic/analyze)
  33 (require 'semantic/dep)
  34
  35 (declare-function semantic-analyze-possible-completions-default
  36                   "semantic/analyze/complete")
  37
  38 ;;; Code:
  39 (define-lex-analyzer semantic-lex-make-backslash-no-newline
  40   "Detect and create a beginning of line token (BOL)."
  41   (and (looking-at "\\(\\\\\n\\s-*\\)")
  42        ;; We have a \ at eol.  Push it as whitespace, but pretend
  43        ;; it never happened so we can skip the BOL tokenizer.
  44        (semantic-lex-push-token (semantic-lex-token 'whitespace
  45                                                     (match-beginning 1)
  46                                                     (match-end 1)))
  47        (goto-char (match-end 1))
  48        nil) ;; CONTINUE
  49    ;; We want to skip BOL, so move to the next condition.
  50    nil)
  51
  52 (define-lex-regex-analyzer semantic-lex-make-command
  53   "A command in a Makefile consists of a line starting with TAB, and ending at the newline."
  54   "^\\(\t\\)"
  55   (let ((start (match-end 0)))
  56     (while (progn (end-of-line)
  57                   (save-excursion (forward-char -1) (looking-at "\\\\")))
  58       (forward-char 1))
  59     (semantic-lex-push-token
  60      (semantic-lex-token 'shell-command start (point)))))
  61
  62 (define-lex-regex-analyzer semantic-lex-make-ignore-automake-conditional
  63   "An automake conditional seems to really bog down the parser.
  64 Ignore them."
  65   "^@\\(\\w\\|\\s_\\)+@"
  66   (setq semantic-lex-end-point (match-end 0)))
  67
  68 (define-lex semantic-make-lexer
  69   "Lexical analyzer for Makefiles."
  70   semantic-lex-beginning-of-line
  71   semantic-lex-make-ignore-automake-conditional
  72   semantic-lex-make-command
  73   semantic-lex-make-backslash-no-newline
  74   semantic-lex-whitespace
  75   semantic-lex-newline
  76   semantic-lex-symbol-or-keyword
  77   semantic-lex-charquote
  78   semantic-lex-paren-or-list
  79   semantic-lex-close-paren
  80   semantic-lex-string
  81   semantic-lex-ignore-comments
  82   semantic-lex-punctuation
  83   semantic-lex-default-action)
  84
  85 (defun semantic-make-expand-tag (tag)
  86   "Expand TAG into a list of equivalent tags, or nil."
  87   (let ((name (semantic-tag-name tag))
  88         xpand)
  89     ;(message "Expanding %S" name)
  90     ;(goto-char (semantic-tag-start tag))
  91     ;(sit-for 0)
  92     (if (and (consp name)
  93              (memq (semantic-tag-class tag) '(function include))
  94              (> (length name) 1))
  95         (while name
  96           (setq xpand (cons (semantic-tag-clone tag (car name)) xpand)
  97                 name  (cdr name)))
  98       ;; Else, only a single name.
  99       (when (consp name)
 100         (setcar tag (car name)))
 101       (setq xpand (list tag)))
 102     xpand))
 103
 104 (define-mode-local-override semantic-get-local-variables
 105   makefile-mode (&optional point)
 106   "Override `semantic-get-local-variables' so it does not throw an error.
 107 We never have local variables in Makefiles."
 108   nil)
 109
 110 (define-mode-local-override semantic-ctxt-current-class-list
 111   makefile-mode (&optional point)
 112   "List of classes that are valid to place at point."
 113   (let ((tag (semantic-current-tag)))
 114     (when tag
 115       (cond ((condition-case nil
 116                  (save-excursion
 117                    (condition-case nil (forward-sexp -1)
 118                      (error nil))
 119                    (forward-char -2)
 120                    (looking-at "\\$\\s("))
 121                (error nil))
 122              ;; We are in a variable reference
 123              '(variable))
 124             ((semantic-tag-of-class-p tag 'function)
 125              ;; Note: variables are handled above.
 126              '(function filename))
 127             ((semantic-tag-of-class-p tag 'variable)
 128              '(function filename))
 129             ))))
 130
 131 (define-mode-local-override semantic-format-tag-abbreviate
 132   makefile-mode (tag &optional parent color)
 133   "Return an abbreviated string describing tag for Makefiles."
 134   (let ((class (semantic-tag-class tag))
 135         (name (semantic-format-tag-name tag parent color))
 136         )
 137     (cond ((eq class 'function)
 138            (concat name ":"))
 139           ((eq class 'filename)
 140            (concat "./" name))
 141           (t
 142            (semantic-format-tag-abbreviate-default tag parent color)))))
 143
 144 (defvar-mode-local makefile-mode semantic-function-argument-separator
 145   " "
 146   "Separator used between dependencies to rules.")
 147
 148 (define-mode-local-override semantic-format-tag-prototype
 149   makefile-mode (tag &optional parent color)
 150   "Return a prototype string describing tag for Makefiles."
 151   (let* ((class (semantic-tag-class tag))
 152          (name (semantic-format-tag-name tag parent color))
 153          )
 154     (cond ((eq class 'function)
 155            (concat name ": "
 156                    (semantic--format-tag-arguments
 157                     (semantic-tag-function-arguments tag)
 158                     #'semantic-format-tag-prototype
 159                     color)))
 160           ((eq class 'filename)
 161            (concat "./" name))
 162           (t
 163            (semantic-format-tag-prototype-default tag parent color)))))
 164
 165 (define-mode-local-override semantic-format-tag-concise-prototype
 166   makefile-mode (tag &optional parent color)
 167   "Return a concise prototype string describing tag for Makefiles.
 168 This is the same as a regular prototype."
 169   (semantic-format-tag-prototype tag parent color))
 170
 171 (define-mode-local-override semantic-format-tag-uml-prototype
 172   makefile-mode (tag &optional parent color)
 173   "Return a UML prototype string describing tag for Makefiles.
 174 This is the same as a regular prototype."
 175   (semantic-format-tag-prototype tag parent color))
 176
 177 (define-mode-local-override semantic-analyze-possible-completions
 178   makefile-mode (context)
 179   "Return a list of possible completions in a Makefile.
 180 Uses default implementation, and also gets a list of filenames."
 181   (save-excursion
 182     (require 'semantic/analyze/complete)
 183     (set-buffer (oref context buffer))
 184     (let* ((normal (semantic-analyze-possible-completions-default context))
 185            (classes (oref context :prefixclass))
 186            (filetags nil))
 187       (when (memq 'filename classes)
 188         (let* ((prefix (car (oref context :prefix)))
 189                (completetext (cond ((semantic-tag-p prefix)
 190                                     (semantic-tag-name prefix))
 191                                    ((stringp prefix)
 192                                     prefix)
 193                                    ((stringp (car prefix))
 194                                     (car prefix))))
 195                (files (directory-files default-directory nil
 196                                        (concat "^" completetext))))
 197           (setq filetags (mapcar (lambda (f) (semantic-tag f 'filename))
 198                                  files))))
 199       ;; Return the normal completions found, plus any filenames
 200       ;; that match.
 201       (append normal filetags)
 202       )))
 203
 204 (defcustom-mode-local-semantic-dependency-system-include-path
 205   makefile-mode semantic-makefile-dependency-system-include-path
 206   nil
 207   "The system include path used by Makefiles language.")
 208
 209 ;;;###autoload
 210 (defun semantic-default-make-setup ()
 211   "Set up a Makefile buffer for parsing with semantic."
 212   (semantic-make-by--install-parser)
 213   (setq semantic-symbol->name-assoc-list '((variable . "Variables")
 214                                            (function . "Rules")
 215                                            (include . "Dependencies")
 216                                            ;; File is a meta-type created
 217                                            ;; to represent completions
 218                                            ;; but not actually parsed.
 219                                            (file . "File"))
 220         semantic-case-fold t
 221         semantic-tag-expand-function 'semantic-make-expand-tag
 222         semantic-lex-syntax-modifications '((?. "_")
 223                                             (?= ".")
 224                                             (?/ "_")
 225                                             (?$ ".")
 226                                             (?+ ".")
 227                                             (?\\ ".")
 228                                             )
 229         imenu-create-index-function 'semantic-create-imenu-index
 230         )
 231   (setq semantic-lex-analyzer #'semantic-make-lexer)
 232   )
 233
 234 (provide 'semantic/bovine/make)
 235
 236 ;; Local variables:
 237 ;; generated-autoload-file: "../loaddefs.el"
 238 ;; generated-autoload-load-name: "semantic/bovine/make"
 239 ;; End:
 240
 241 ;;; semantic/bovine/make.el ends here