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

   1 ;;; semantic-scm.el --- Semantic details for Scheme (guile)
   2
   3 ;;; Copyright (C) 2001, 2002, 2003, 2004 Eric M. Ludlam
   4
   5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
   6 ;; X-RCS: $Id: semantic-scm.el.upstream,v 1.1 2007-12-03 07:04:58 michaels Exp $
   7
   8 ;; This program is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation; either version 2, or (at your option)
  11 ;; any later version.
  12
  13 ;; This software is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  20 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  21 ;; Boston, MA 02110-1301, USA.
  22
  23 ;;; Commentary:
  24 ;;
  25 ;; Use the Semantic Bovinator for Scheme (guile)
  26
  27 (require 'semantic)
  28 (require 'semantic-scm-by)
  29 (require 'backquote)
  30
  31 (eval-when-compile
  32   (require 'document)
  33   (require 'semantic-format))
  34
  35 ;;; Code:
  36
  37 (defcustom semantic-default-scheme-path '("/usr/share/guile/")
  38   "Default set of include paths for scheme (guile) code.
  39 Used by `semantic-inc' to define an include path.  This should
  40 probably do some sort of search to see what is actually on the local
  41 machine."
  42   :group 'scheme
  43   :type '(repeat (string :tag "Path")))
  44
  45 (define-mode-local-override semantic-format-tag-prototype scheme-mode (tag)
  46   "Return a prototype for the Emacs Lisp nonterminal TAG."
  47   (let* ((tok (semantic-tag-class tag))
  48          (args (semantic-tag-components tag))
  49          )
  50     (if (eq tok 'function)
  51         (concat (semantic-tag-name tag) " ("
  52                 (mapconcat (lambda (a) a) args " ")
  53                 ")")
  54       (semantic-format-tag-prototype-default tag))))
  55
  56 (define-mode-local-override semantic-documentation-for-tag scheme-mode (tag &optional nosnarf)
  57   "Return the documentation string for TAG.
  58 Optional argument NOSNARF is ignored."
  59   (let ((d (semantic-tag-docstring tag)))
  60     (if (and d (> (length d) 0) (= (aref d 0) ?*))
  61         (substring d 1)
  62       d)))
  63
  64 (define-mode-local-override semantic-insert-foreign-tag scheme-mode (tag tagfile)
  65   "Insert TAG from TAGFILE at point.
  66 Attempts a simple prototype for calling or using TAG."
  67   (cond ((eq (semantic-tag-class tag) 'function)
  68          (insert "(" (semantic-tag-name tag) " )")
  69          (forward-char -1))
  70         (t
  71          (insert (semantic-tag-name tag)))))
  72
  73 (define-lex semantic-scheme-lexer
  74   "A simple lexical analyzer that handles simple buffers.
  75 This lexer ignores comments and whitespace, and will return
  76 syntax as specified by the syntax table."
  77   semantic-lex-ignore-whitespace
  78   semantic-lex-ignore-newline
  79   semantic-lex-symbol-or-keyword
  80   semantic-lex-charquote
  81   semantic-lex-paren-or-list
  82   semantic-lex-close-paren
  83   semantic-lex-string
  84   semantic-lex-ignore-comments
  85   semantic-lex-punctuation
  86   semantic-lex-default-action)
  87
  88 ;;;###autoload
  89 (defun semantic-default-scheme-setup ()
  90   "Setup hook function for Emacs Lisp files and Semantic."
  91   (semantic-scm-by--install-parser)
  92   (setq semantic-symbol->name-assoc-list '( (variable . "Variables")
  93                                             ;;(type     . "Types")
  94                                             (function . "Functions")
  95                                             (include  . "Loads")
  96                                             (package  . "DefineModule"))
  97         imenu-create-index-function 'semantic-create-imenu-index
  98         semantic-dependency-include-path semantic-default-scheme-path
  99         imenu-create-index-function 'semantic-create-imenu-index
 100         document-comment-start ";;"
 101         document-comment-line-prefix ";;"
 102         document-comment-end "\n"
 103         )
 104   (setq semantic-lex-analyzer #'semantic-scheme-lexer)
 105   )
 106
 107 ;;;###autoload
 108 (add-hook 'scheme-mode-hook 'semantic-default-scheme-setup)
 109
 110 (provide 'semantic-scm)
 111
 112 ;;; semantic-scm.el ends here