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