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

   1 ;;; semantic/bovine/scm.el --- Semantic details for Scheme (guile)
   2
   3 ;;; Copyright (C) 2001-2004, 2008-2011  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 for Scheme (guile)
  25
  26 (require 'semantic)
  27 (require 'semantic/bovine/scm-by)
  28 (require 'semantic/format)
  29 (require 'semantic/dep)
  30
  31 ;;; Code:
  32
  33 (defcustom-mode-local-semantic-dependency-system-include-path
  34   scheme-mode semantic-default-scheme-path
  35   '("/usr/share/guile/")
  36   "Default set of include paths for scheme (guile) code.
  37 This should probably do some sort of search to see what is
  38 actually on the local machine.")
  39
  40 (define-mode-local-override semantic-format-tag-prototype scheme-mode (tag)
  41   "Return a prototype for the Emacs Lisp nonterminal TAG."
  42   (let* ((tok (semantic-tag-class tag))
  43          (args (semantic-tag-components tag))
  44          )
  45     (if (eq tok 'function)
  46         (concat (semantic-tag-name tag) " ("
  47                 (mapconcat (lambda (a) a) args " ")
  48                 ")")
  49       (semantic-format-tag-prototype-default tag))))
  50
  51 (define-mode-local-override semantic-documentation-for-tag scheme-mode (tag &optional nosnarf)
  52   "Return the documentation string for TAG.
  53 Optional argument NOSNARF is ignored."
  54   (let ((d (semantic-tag-docstring tag)))
  55     (if (and d (> (length d) 0) (= (aref d 0) ?*))
  56         (substring d 1)
  57       d)))
  58
  59 (define-mode-local-override semantic-insert-foreign-tag scheme-mode (tag tagfile)
  60   "Insert TAG from TAGFILE at point.
  61 Attempts a simple prototype for calling or using TAG."
  62   (cond ((eq (semantic-tag-class tag) 'function)
  63          (insert "(" (semantic-tag-name tag) " )")
  64          (forward-char -1))
  65         (t
  66          (insert (semantic-tag-name tag)))))
  67
  68 ;; Note: Analyzer from Henry S. Thompson
  69 (define-lex-regex-analyzer semantic-lex-scheme-symbol
  70   "Detect and create symbol and keyword tokens."
  71   "\\(\\sw\\([:]\\|\\sw\\|\\s_\\)+\\)"
  72   ;; (message (format "symbol: %s" (match-string 0)))
  73   (semantic-lex-push-token
  74    (semantic-lex-token
  75     (or (semantic-lex-keyword-p (match-string 0)) 'symbol)
  76     (match-beginning 0) (match-end 0))))
  77
  78
  79 (define-lex semantic-scheme-lexer
  80   "A simple lexical analyzer that handles simple buffers.
  81 This lexer ignores comments and whitespace, and will return
  82 syntax as specified by the syntax table."
  83   semantic-lex-ignore-whitespace
  84   semantic-lex-ignore-newline
  85   semantic-lex-scheme-symbol
  86   semantic-lex-charquote
  87   semantic-lex-paren-or-list
  88   semantic-lex-close-paren
  89   semantic-lex-string
  90   semantic-lex-ignore-comments
  91   semantic-lex-punctuation
  92   semantic-lex-number
  93   semantic-lex-default-action)
  94
  95 ;;;###autoload
  96 (defun semantic-default-scheme-setup ()
  97   "Setup hook function for Emacs Lisp files and Semantic."
  98   (semantic-scm-by--install-parser)
  99   (setq semantic-symbol->name-assoc-list '( (variable . "Variables")
 100                                             ;;(type     . "Types")
 101                                             (function . "Functions")
 102                                             (include  . "Loads")
 103                                             (package  . "DefineModule"))
 104         imenu-create-index-function 'semantic-create-imenu-index
 105         imenu-create-index-function 'semantic-create-imenu-index
 106         )
 107   (setq semantic-lex-analyzer #'semantic-scheme-lexer)
 108   )
 109
 110 (provide 'semantic/bovine/scm)
 111
 112 ;; Local variables:
 113 ;; generated-autoload-file: "../loaddefs.el"
 114 ;; generated-autoload-load-name: "semantic/bovine/scm"
 115 ;; End:
 116
 117 ;;; semantic/bovine/scm.el ends here