cgit.sxemacs.org Git - packages/blob - xemacs-packages/semantic/bovine/semantic-make.el.upstream

   1 ;;; semantic-make.el --- Makefile parsing rules.
   2
   3 ;; Copyright (C) 2000, 2001, 2002, 2003, 2004 Eric M. Ludlam
   4
   5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
   6 ;; X-RCS: $Id: semantic-make.el.upstream,v 1.1 2007-12-03 07:04:57 michaels Exp $
   7
   8 ;; This file is not part of GNU Emacs.
   9
  10 ;; Semantic-ex 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 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; This software 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; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Commentary:
  26 ;;
  27 ;; Use the Semantic Bovinator to parse Makefiles.
  28 ;; Concocted as an experiment for nonstandard languages.
  29
  30 (require 'semantic)
  31 (require 'semantic-make-by)
  32 (require 'backquote)
  33
  34 (eval-when-compile
  35   (require 'semantic-format)
  36   (require 'semantic-analyze)
  37   )
  38
  39 ;;; Code:
  40
  41 (define-lex-simple-regex-analyzer semantic-lex-make-backslash-newline
  42   "A line ending with a \ continues to the next line and is treated as whitespace."
  43   "\\(\\\\\n\\s-*\\)" 'whitespace 1)
  44
  45 (define-lex-regex-analyzer semantic-lex-make-command
  46   "A command in a Makefile consists of a line starting with TAB, and ending at the newline."
  47   "^\\(\t\\)"
  48   (let ((start (match-end 0)))
  49     (while (progn (end-of-line)
  50                   (save-excursion (forward-char -1) (looking-at "\\\\")))
  51       (forward-char 1))
  52     (semantic-lex-push-token
  53      (semantic-lex-token 'shell-command start (point)))))
  54
  55 (define-lex semantic-make-lexer
  56   "Lexical analyzer for Makefiles."
  57   semantic-lex-make-command
  58   semantic-lex-make-backslash-newline
  59   semantic-lex-whitespace
  60   semantic-lex-newline
  61   semantic-lex-symbol-or-keyword
  62   semantic-lex-charquote
  63   semantic-lex-paren-or-list
  64   semantic-lex-close-paren
  65   semantic-lex-string
  66   semantic-lex-ignore-comments
  67   semantic-lex-punctuation
  68   semantic-lex-default-action)
  69
  70 (defun semantic-make-expand-tag (tag)
  71   "Expand TAG into a list of equivalent tags, or nil."
  72   (let ((name (semantic-tag-name tag))
  73         xpand)
  74     (and (consp name)
  75          (memq (semantic-tag-class tag) '(function include))
  76          (while name
  77            (setq xpand (cons (semantic-tag-clone tag (car name)) xpand)
  78                  name  (cdr name))))
  79     xpand))
  80
  81 (define-mode-local-override semantic-get-local-variables
  82   makefile-mode (&optional point)
  83   "Override `semantic-get-local-variables' so it does not throw an error.
  84 We never have local variables in Makefiles."
  85   nil)
  86
  87 (define-mode-local-override semantic-ctxt-current-class-list
  88   makefile-mode (&optional point)
  89   "List of classes that are valid to place at point."
  90   (let ((tag (semantic-current-tag)))
  91     (when tag
  92       (cond ((condition-case nil
  93                  (save-excursion
  94                    (condition-case nil (forward-sexp -1)
  95                      (error nil))
  96                    (forward-char -2)
  97                    (looking-at "\\$\\s("))
  98                (error nil))
  99              ;; We are in a variable reference
 100              '(variable))
 101             ((semantic-tag-of-class-p tag 'function)
 102              ;; Note: variables are handled above.
 103              '(function filename))
 104             ((semantic-tag-of-class-p tag 'variable)
 105              '(function filename))
 106             ))))
 107
 108 (define-mode-local-override semantic-format-tag-abbreviate
 109   makefile-mode (tag &optional parent color)
 110   "Return an abbreviated string describing tag for Makefiles."
 111   (let ((class (semantic-tag-class tag))
 112         (name (semantic-format-tag-name tag parent color))
 113         )
 114     (cond ((eq class 'function)
 115            (concat name ":"))
 116           ((eq class 'filename)
 117            (concat "./" name))
 118           (t
 119            (semantic-format-tag-abbreviate-default tag parent color)))))
 120
 121 (defvar-mode-local makefile-mode semantic-function-argument-separator
 122   " "
 123   "Separator used between dependencies to rules.")
 124
 125 (define-mode-local-override semantic-format-tag-prototype
 126   makefile-mode (tag &optional parent color)
 127   "Return a prototype string describing tag for Makefiles."
 128   (let* ((class (semantic-tag-class tag))
 129          (name (semantic-format-tag-name tag parent color))
 130          )
 131     (cond ((eq class 'function)
 132            (concat name ": "
 133                    (semantic--format-tag-arguments
 134                     (semantic-tag-function-arguments tag)
 135                     #'semantic-format-tag-prototype
 136                     color)))
 137           ((eq class 'filename)
 138            (concat "./" name))
 139           (t
 140            (semantic-format-tag-prototype-default tag parent color)))))
 141
 142 (define-mode-local-override semantic-format-tag-concise-prototype
 143   makefile-mode (tag &optional parent color)
 144   "Return a concise prototype string describing tag for Makefiles.
 145 This is the same as a regular prototype."
 146   (semantic-format-tag-prototype tag parent color))
 147
 148 (define-mode-local-override semantic-format-tag-uml-prototype
 149   makefile-mode (tag &optional parent color)
 150   "Return a UML prototype string describing tag for Makefiles.
 151 This is the same as a regular prototype."
 152   (semantic-format-tag-prototype tag parent color))
 153
 154 (define-mode-local-override semantic-analyze-possible-completions
 155   makefile-mode (context)
 156   "Return a list of possible completions in a Makefile.
 157 Uses default implementation, and also gets a list of filenames."
 158   (save-excursion
 159     (set-buffer (oref context buffer))
 160     (let* ((normal (semantic-analyze-possible-completions-default context))
 161            (classes (oref context :prefixclass))
 162            (filetags nil))
 163       (when (memq 'filename classes)
 164         (let* ((prefix (car (oref context :prefix)))
 165                (completetext (cond ((semantic-tag-p prefix)
 166                                     (semantic-tag-name prefix))
 167                                    ((stringp prefix)
 168                                     prefix)
 169                                    ((stringp (car prefix))
 170                                     (car prefix))))
 171                (files (directory-files default-directory nil
 172                                        (concat "^" completetext))))
 173           (setq filetags (mapcar (lambda (f) (semantic-tag f 'filename))
 174                                  files))))
 175       ;; Return the normal completions found, plus any filenames
 176       ;; that match.
 177       (append normal filetags)
 178       )))
 179
 180
 181 ;;;###autoload
 182 (defun semantic-default-make-setup ()
 183   "Set up a Makefile buffer for parsing with semantic."
 184   (semantic-make-by--install-parser)
 185   (setq semantic-symbol->name-assoc-list '((variable . "Variables")
 186                                            (function . "Rules")
 187                                            (include . "Dependencies")
 188                                            ;; File is a meta-type created
 189                                            ;; to represent completions
 190                                            ;; but not actually parsed.
 191                                            (file . "File"))
 192         semantic-case-fold t
 193         semantic-tag-expand-function 'semantic-make-expand-tag
 194         semantic-lex-syntax-modifications '((?. "_")
 195                                             (?= ".")
 196                                             (?/ "_")
 197                                             (?$ ".")
 198                                             (?+ ".")
 199                                             (?\\ ".")
 200                                             )
 201         imenu-create-index-function 'semantic-create-imenu-index
 202         )
 203   (setq semantic-lex-analyzer #'semantic-make-lexer)
 204   )
 205
 206 ;;;###autoload
 207 (add-hook 'makefile-mode-hook 'semantic-default-make-setup)
 208
 209 (provide 'semantic-make)
 210
 211 ;;; semantic-make.el ends here