summaryrefslogtreecommitdiff
path: root/lisp/cedet/semantic/bovine/make.el
blob: bb579cfde3fd77f5f7c87b8ec44bc8adb9999c6b (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
;;; semantic/bovine/make.el --- Makefile parsing rules.  -*- lexical-binding: t; -*-

;; Copyright (C) 2000-2004, 2008-2021 Free Software Foundation, Inc.

;; Author: Eric M. Ludlam <zappo@gnu.org>

;; 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 <https://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; Use the Semantic Bovinator to parse Makefiles.
;; Concocted as an experiment for nonstandard languages.

(require 'make-mode)

(require 'semantic)
(require 'semantic/bovine)
(require 'semantic/bovine/make-by)
(require 'semantic/analyze)
(require 'semantic/dep)

(declare-function semantic-analyze-possible-completions-default
		  "semantic/analyze/complete")

;;; Code:
(define-lex-analyzer semantic-lex-make-backslash-no-newline
  "Detect and create a beginning of line token (BOL)."
  (and (looking-at "\\(\\\\\n\\s-*\\)")
       ;; We have a \ at eol.  Push it as whitespace, but pretend
       ;; it never happened so we can skip the BOL tokenizer.
       (semantic-lex-push-token (semantic-lex-token 'whitespace
						    (match-beginning 1)
						    (match-end 1)))
       (goto-char (match-end 1))
       nil) ;; CONTINUE
   ;; We want to skip BOL, so move to the next condition.
   nil)

(define-lex-regex-analyzer semantic-lex-make-command
  "Regexp for a command in a Makefile.
It consists of a line starting with TAB, and ending at the newline."
  "^\\(\t\\)"
  (let ((start (match-end 0)))
    (while (progn (end-of-line)
		  (save-excursion (forward-char -1) (looking-at "\\\\")))
      (forward-char 1))
    (semantic-lex-push-token
     (semantic-lex-token 'shell-command start (point)))))

(define-lex-regex-analyzer semantic-lex-make-ignore-automake-conditional
  "An automake conditional seems to really bog down the parser.
Ignore them."
  "^@\\(\\w\\|\\s_\\)+@"
  (setq semantic-lex-end-point (match-end 0)))

(define-lex semantic-make-lexer
  "Lexical analyzer for Makefiles."
  semantic-lex-beginning-of-line
  semantic-lex-make-ignore-automake-conditional
  semantic-lex-make-command
  semantic-lex-make-backslash-no-newline
  semantic-lex-whitespace
  semantic-lex-newline
  semantic-lex-symbol-or-keyword
  semantic-lex-charquote
  semantic-lex-paren-or-list
  semantic-lex-close-paren
  semantic-lex-string
  semantic-lex-ignore-comments
  semantic-lex-punctuation
  semantic-lex-default-action)

(defun semantic-make-expand-tag (tag)
  "Expand TAG into a list of equivalent tags, or nil."
  (let ((name (semantic-tag-name tag))
        xpand)
    ;(message "Expanding %S" name)
    ;(goto-char (semantic-tag-start tag))
    ;(sit-for 0)
    (if (and (consp name)
	     (memq (semantic-tag-class tag) '(function include))
	     (> (length name) 1))
	(while name
	  (setq xpand (cons (semantic-tag-clone tag (car name)) xpand)
		name  (cdr name)))
      ;; Else, only a single name.
      (when (consp name)
	(setcar tag (car name)))
      (setq xpand (list tag)))
    xpand))

(define-mode-local-override semantic-get-local-variables
  makefile-mode (&optional _point)
  "Override `semantic-get-local-variables' so it does not throw an error.
We never have local variables in Makefiles."
  nil)

(define-mode-local-override semantic-ctxt-current-class-list
  makefile-mode (&optional _point)
  "List of classes that are valid to place at point."
  (let ((tag (semantic-current-tag)))
    (when tag
      (cond ((condition-case nil
		 (save-excursion
		   (condition-case nil (forward-sexp -1)
		     (error nil))
		   (forward-char -2)
		   (looking-at "\\$\\s("))
	       (error nil))
	     ;; We are in a variable reference
	     '(variable))
	    ((semantic-tag-of-class-p tag 'function)
	     ;; Note: variables are handled above.
	     '(function filename))
	    ((semantic-tag-of-class-p tag 'variable)
	     '(function filename))
	    ))))

(define-mode-local-override semantic-format-tag-abbreviate
  makefile-mode (tag &optional parent color)
  "Return an abbreviated string describing tag for Makefiles."
  (let ((class (semantic-tag-class tag))
	(name (semantic-format-tag-name tag parent color))
	)
    (cond ((eq class 'function)
	   (concat name ":"))
	  ((eq class 'filename)
	   (concat "./" name))
	  (t
	   (semantic-format-tag-abbreviate-default tag parent color)))))

(defvar-mode-local makefile-mode semantic-function-argument-separator
  " "
  "Separator used between dependencies to rules.")

(define-mode-local-override semantic-format-tag-prototype
  makefile-mode (tag &optional parent color)
  "Return a prototype string describing tag for Makefiles."
  (let* ((class (semantic-tag-class tag))
	 (name (semantic-format-tag-name tag parent color))
	 )
    (cond ((eq class 'function)
	   (concat name ": "
		   (semantic--format-tag-arguments
		    (semantic-tag-function-arguments tag)
		    #'semantic-format-tag-prototype
		    color)))
	  ((eq class 'filename)
	   (concat "./" name))
	  (t
	   (semantic-format-tag-prototype-default tag parent color)))))

(define-mode-local-override semantic-format-tag-concise-prototype
  makefile-mode (tag &optional parent color)
  "Return a concise prototype string describing tag for Makefiles.
This is the same as a regular prototype."
  (semantic-format-tag-prototype tag parent color))

(define-mode-local-override semantic-format-tag-uml-prototype
  makefile-mode (tag &optional parent color)
  "Return a UML prototype string describing tag for Makefiles.
This is the same as a regular prototype."
  (semantic-format-tag-prototype tag parent color))

(define-mode-local-override semantic-analyze-possible-completions
  makefile-mode (context &rest _flags)
  "Return a list of possible completions in a Makefile.
Uses default implementation, and also gets a list of filenames."
  (require 'semantic/analyze/complete)
  (with-current-buffer (oref context buffer)
    (let* ((normal (semantic-analyze-possible-completions-default context))
	   (classes (oref context prefixclass))
	   (filetags nil))
      (when (memq 'filename classes)
	(let* ((prefix (car (oref context prefix)))
	       (completetext (cond ((semantic-tag-p prefix)
				    (semantic-tag-name prefix))
				   ((stringp prefix)
				    prefix)
				   ((stringp (car prefix))
				    (car prefix))))
	       (files (directory-files default-directory nil
				       (concat "^" completetext))))
	  (setq filetags (mapcar (lambda (f) (semantic-tag f 'filename))
				 files))))
      ;; Return the normal completions found, plus any filenames
      ;; that match.
      (append normal filetags)
      )))

(defcustom-mode-local-semantic-dependency-system-include-path
  makefile-mode semantic-makefile-dependency-system-include-path
  nil
  "The system include path used by Makefiles language.")

;;;###autoload
(defun semantic-default-make-setup ()
  "Set up a Makefile buffer for parsing with semantic."
  (semantic-make-by--install-parser)
  (setq semantic-symbol->name-assoc-list '((variable . "Variables")
                                           (function . "Rules")
                                           (include . "Dependencies")
					   ;; File is a meta-type created
					   ;; to represent completions
					   ;; but not actually parsed.
					   (file . "File"))
        semantic-case-fold t
        semantic-tag-expand-function #'semantic-make-expand-tag
        semantic-lex-syntax-modifications '((?. "_")
                                            (?= ".")
                                            (?/ "_")
                                            (?$ ".")
                                            (?+ ".")
                                            (?\\ ".")
                                            )
        imenu-create-index-function #'semantic-create-imenu-index
        )
  (setq semantic-lex-analyzer #'semantic-make-lexer)
  )

(provide 'semantic/bovine/make)

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

;;; semantic/bovine/make.el ends here