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

;;; semantic/bovine/make.el --- Makefile parsing rules.

;;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2008
;;; 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 <http://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/make-by)
(require 'semantic/analyze)
(require 'semantic/format)

(eval-when-compile
  (require 'semantic/dep))

;;; 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
  "A command in a Makefile 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)
  "Return a list of possible completions in a Makefile.
Uses default implementation, and also gets a list of filenames."
  (save-excursion
    (set-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 langauge.")

;;;###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-feature: semantic/loaddefs
;; generated-autoload-load-name: "semantic/bovine/make"
;; End:

;;; semantic/bovine/make.el ends here
Commit	Line	Data
4feec2f5 CY	1	;;; semantic/bovine/make.el --- Makefile parsing rules.
	2
	3	;;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2008
	4	;;; Free Software Foundation, Inc.
	5
	6	;; Author: Eric M. Ludlam <zappo@gnu.org>
	7
	8	;; This file is part of GNU Emacs.
	9
	10	;; GNU Emacs is free software: you can redistribute it and/or modify
	11	;; it under the terms of the GNU General Public License as published by
	12	;; the Free Software Foundation, either version 3 of the License, or
	13	;; (at your option) any later version.
	14
	15	;; GNU Emacs is distributed in the hope that it will be useful,
	16	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	17	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	18	;; GNU General Public License for more details.
	19
	20	;; You should have received a copy of the GNU General Public License
	21	;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
	22
	23	;;; Commentary:
	24	;;
	25	;; Use the Semantic Bovinator to parse Makefiles.
	26	;; Concocted as an experiment for nonstandard languages.
	27
	28	(require 'make-mode)
	29
	30	(require 'semantic)
	31	(require 'semantic/bovine/make-by)
	32	(require 'semantic/analyze)
	33	(require 'semantic/format)
	34
	35	(eval-when-compile
	36	(require 'semantic/dep))
	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 ": "
a60f2e7b	156	(semantic--format-tag-arguments
4feec2f5 CY	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	(set-buffer (oref context buffer))
	183	(let* ((normal (semantic-analyze-possible-completions-default context))
	184	(classes (oref context :prefixclass))
	185	(filetags nil))
	186	(when (memq 'filename classes)
	187	(let* ((prefix (car (oref context :prefix)))
	188	(completetext (cond ((semantic-tag-p prefix)
	189	(semantic-tag-name prefix))
	190	((stringp prefix)
	191	prefix)
	192	((stringp (car prefix))
	193	(car prefix))))
	194	(files (directory-files default-directory nil
	195	(concat "^" completetext))))
	196	(setq filetags (mapcar (lambda (f) (semantic-tag f 'filename))
	197	files))))
	198	;; Return the normal completions found, plus any filenames
	199	;; that match.
	200	(append normal filetags)
	201	)))
	202
	203	(defcustom-mode-local-semantic-dependency-system-include-path
	204	makefile-mode semantic-makefile-dependency-system-include-path
	205	nil
	206	"The system include path used by Makefiles langauge.")
	207
a60f2e7b	208	;;;###autoload
4feec2f5 CY	209	(defun semantic-default-make-setup ()
	210	"Set up a Makefile buffer for parsing with semantic."
	211	(semantic-make-by--install-parser)
	212	(setq semantic-symbol->name-assoc-list '((variable . "Variables")
	213	(function . "Rules")
	214	(include . "Dependencies")
	215	;; File is a meta-type created
	216	;; to represent completions
	217	;; but not actually parsed.
	218	(file . "File"))
	219	semantic-case-fold t
	220	semantic-tag-expand-function 'semantic-make-expand-tag
	221	semantic-lex-syntax-modifications '((?. "_")
	222	(?= ".")
	223	(?/ "_")
	224	(?$ ".")
	225	(?+ ".")
	226	(?\\ ".")
	227	)
	228	imenu-create-index-function 'semantic-create-imenu-index
	229	)
	230	(setq semantic-lex-analyzer #'semantic-make-lexer)
	231	)
	232
4feec2f5 CY	233	(provide 'semantic/bovine/make)
4feec2f5 CY	234
a60f2e7b CY	235	;; Local variables:
	236	;; generated-autoload-file: "../loaddefs.el"
	237	;; generated-autoload-feature: semantic/loaddefs
	238	;; generated-autoload-load-name: "semantic/bovine/make"
	239	;; End:
	240
4feec2f5	241	;;; semantic/bovine/make.el ends here