cgit.sxemacs.org Git - packages/blob - xemacs-packages/semantic/semanticdb-el.el

   1 ;;; semanticdb-el.el --- Semantic database extensions for Emacs Lisp
   2
   3 ;;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Eric M. Ludlam
   4
   5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
   6 ;; Keywords: tags
   7 ;; X-RCS: $Id: semanticdb-el.el,v 1.1 2007-11-26 15:10:46 michaels Exp $
   8
   9 ;; This file is not part of GNU Emacs.
  10
  11 ;; Semanticdb is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; This software is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25 ;;
  26 ;;; Commentary:
  27 ;;
  28 ;; There are a lot of Emacs Lisp functions and variables available for
  29 ;; the asking.  This adds on to the semanticdb programming interface to
  30 ;; allow all loaded Emacs Lisp functions to be queried via semanticdb.
  31 ;;
  32 ;; This allows you to use programs written for Semantic using the database
  33 ;; to also work in Emacs Lisp with no compromises.
  34 ;;
  35
  36 (require 'semanticdb-search)
  37 (eval-when-compile
  38   ;; For generic function searching.
  39   (require 'eieio)
  40   (require 'eieio-opt)
  41   (require 'eieio-base)
  42   )
  43 ;;; Code:
  44
  45 ;;; Classes:
  46 (defclass semanticdb-table-emacs-lisp (semanticdb-search-results-table)
  47   ((major-mode :initform emacs-lisp-mode)
  48    )
  49   "A table for returning search results from Emacs.")
  50
  51 (defclass semanticdb-project-database-emacs-lisp
  52   (semanticdb-project-database eieio-singleton)
  53   ((new-table-class :initform semanticdb-table-emacs-lisp
  54                     :type class
  55                     :documentation
  56                     "New tables created for this database are of this class.")
  57    )
  58   "Database representing Emacs core.")
  59
  60 ;; Create the database, and add it to searchable databases for Emacs Lisp mode.
  61 (defvar-mode-local emacs-lisp-mode semanticdb-project-system-databases
  62   (list
  63    (semanticdb-project-database-emacs-lisp "Emacs"))
  64   "Search Emacs core for symbols.")
  65
  66 (defvar-mode-local emacs-lisp-mode semanticdb-find-default-throttle
  67   '(project omniscience)
  68   "Search project files, then search this omniscience database.
  69 It is not necessary to to system or recursive searching because of
  70 the omniscience database.")
  71
  72 ;;; Filename based methods
  73 ;;
  74 (defmethod semanticdb-get-database-tables ((obj semanticdb-project-database-emacs-lisp))
  75   "For an Emacs Lisp database, there are no explicit tables.
  76 Create one of our special tables that can act as an intermediary."
  77   ;; We need to return something since there is always the "master table"
  78   ;; The table can then answer file name type questions.
  79   (when (not (slot-boundp obj 'tables))
  80     (let ((newtable (semanticdb-table-emacs-lisp "Emacs System Table")))
  81       (oset obj tables (list newtable))
  82       (oset newtable parent-db obj)
  83       (oset newtable tags nil)
  84       ))
  85   (call-next-method))
  86
  87 (defmethod semanticdb-file-table ((obj semanticdb-project-database-emacs-lisp) filename)
  88   "From OBJ, return FILENAME's associated table object.
  89 For Emacs Lisp, creates a specialized table."
  90   (car (semanticdb-get-database-tables obj))
  91   )
  92
  93 (defmethod semanticdb-get-tags ((table semanticdb-table-emacs-lisp ))
  94   "Return the list of tags belonging to TABLE."
  95   ;; specialty table ?  Probably derive tags at request time.
  96   nil)
  97
  98 (defmethod semanticdb-equivalent-mode ((table semanticdb-table-emacs-lisp) &optional buffer)
  99   "Return non-nil if TABLE's mode is equivalent to BUFFER.
 100 Equivalent modes are specified by by `semantic-equivalent-major-modes'
 101 local variable."
 102   (save-excursion
 103     (set-buffer buffer)
 104     (eq (or mode-local-active-mode major-mode) 'emacs-lisp-mode)))
 105
 106 ;;; Conversion
 107 ;;
 108 (defmethod semanticdb-normalize-tags ((obj semanticdb-table-emacs-lisp) tags)
 109   "Convert tags, originating from Emacs OBJ, into standardized form.
 110 If Emacs cannot resolve this symbol to a particular file, then just
 111 return the TAGS."
 112   ;; @TODO - Lets do this.  We could find the tag's source file
 113   ;;         using the help system, for example.
 114   tags)
 115
 116 (defun semanticdb-elisp-sym-function-arglist (sym)
 117   "Get the argument list for SYM.
 118 Deal with all different forms of function.
 119 This was snarfed out of eldoc."
 120   (let* ((prelim-def
 121           (let ((sd (and (fboundp sym)
 122                          (symbol-function sym))))
 123             (and (symbolp sd)
 124                  (condition-case err
 125                      (setq sd (indirect-function sym))
 126                    (error (setq sd nil))))
 127             sd))
 128          (def (if (eq (car-safe prelim-def) 'macro)
 129                   (cdr prelim-def)
 130                 prelim-def))
 131          (arglist (cond ((null def) nil)
 132                         ((byte-code-function-p def)
 133                          ;; This is an eieio compatibility function.
 134                          ;; We depend on EIEIO, so use this.
 135                          (eieio-compiled-function-arglist def))
 136                         ((eq (car-safe def) 'lambda)
 137                          (nth 1 def))
 138                         (t nil))))
 139     arglist))
 140
 141 (defun semanticdb-elisp-sym->tag (sym &optional toktype)
 142   "Convert SYM into a semantic tag.
 143 TOKTYPE is a hint to the type of tag desired."
 144   (if (stringp sym)
 145       (setq sym (intern-soft sym)))
 146   (when sym
 147     (cond ((and (eq toktype 'function) (fboundp sym))
 148            (semantic-tag-new-function
 149             (symbol-name sym)
 150             nil ;; return type
 151             (semantic-elisp-desymbolify
 152              (semanticdb-elisp-sym-function-arglist sym)) ;; arg-list
 153             :user-visible-flag (condition-case nil
 154                                    (interactive-form sym)
 155                                  (error nil))
 156             ))
 157           ((and (eq toktype 'variable) (boundp sym))
 158            (semantic-tag-new-variable
 159             (symbol-name sym)
 160             nil ;; type
 161             nil ;; value - ignore for now
 162             ))
 163           ((and (eq toktype 'type) (class-p sym))
 164            (semantic-tag-new-type
 165             (symbol-name sym)
 166             "class"
 167             (semantic-elisp-desymbolify
 168              (aref (class-v semanticdb-project-database)
 169                    class-public-a)) ;; slots
 170             (semantic-elisp-desymbolify (class-parents sym)) ;; parents
 171             ))
 172           ((not toktype)
 173            ;; Figure it out on our own.
 174            (cond ((class-p sym)
 175                   (semanticdb-elisp-sym->tag sym 'type))
 176                  ((fboundp sym)
 177                   (semanticdb-elisp-sym->tag sym 'function))
 178                  ((boundp sym)
 179                   (semanticdb-elisp-sym->tag sym 'variable))
 180                  (t nil))
 181            )
 182           (t nil))))
 183
 184 ;;; Search Overrides
 185 ;;
 186 (defvar semanticdb-elisp-mapatom-collector nil
 187   "Variable used to collect mapatoms output.")
 188
 189 (defmethod semanticdb-find-tags-by-name-method
 190   ((table semanticdb-table-emacs-lisp) name &optional tags)
 191   "Find all tags name NAME in TABLE.
 192 Uses `inter-soft' to match NAME to emacs symbols.
 193 Return a list of tags."
 194   (if tags (call-next-method)
 195     ;; No need to search.  Use `intern-soft' which does the same thing for us.
 196     (let* ((sym (intern-soft name))
 197            (fun (semanticdb-elisp-sym->tag sym 'function))
 198            (var (semanticdb-elisp-sym->tag sym 'variable))
 199            (typ (semanticdb-elisp-sym->tag sym 'type))
 200            (taglst nil)
 201            )
 202       (when (or fun var typ)
 203         ;; If the symbol is any of these things, build the search table.
 204         (when var       (setq taglst (cons var taglst)))
 205         (when typ       (setq taglst (cons typ taglst)))
 206         (when fun       (setq taglst (cons fun taglst)))
 207         taglst
 208         ))))
 209
 210 (defmethod semanticdb-find-tags-by-name-regexp-method
 211   ((table semanticdb-table-emacs-lisp) regex &optional tags)
 212   "Find all tags with name matching REGEX in TABLE.
 213 Optional argument TAGS is a list of tags to search.
 214 Uses `apropos-internal' to find matches.
 215 Return a list of tags."
 216   (if tags (call-next-method)
 217     (delq nil (mapcar 'semanticdb-elisp-sym->tag
 218                       (apropos-internal regex)))))
 219
 220 (defmethod semanticdb-find-tags-for-completion-method
 221   ((table semanticdb-table-emacs-lisp) prefix &optional tags)
 222   "In TABLE, find all occurances of tags matching PREFIX.
 223 Optional argument TAGS is a list of tags to search.
 224 Returns a table of all matching tags."
 225   (if tags (call-next-method)
 226     (delq nil (mapcar 'semanticdb-elisp-sym->tag
 227                       (all-completions prefix obarray)))))
 228
 229 (defmethod semanticdb-find-tags-by-class-method
 230   ((table semanticdb-table-emacs-lisp) class &optional tags)
 231   "In TABLE, find all occurances of tags of CLASS.
 232 Optional argument TAGS is a list of tags to search.
 233 Returns a table of all matching tags."
 234   (if tags (call-next-method)
 235     ;; We could implement this, but it could be massy.
 236     nil))
 237
 238 ;;; Deep Searches
 239 ;;
 240 ;; For Emacs Lisp deep searches are like top level searches.
 241 (defmethod semanticdb-deep-find-tags-by-name-method
 242   ((table semanticdb-table-emacs-lisp) name &optional tags)
 243   "Find all tags name NAME in TABLE.
 244 Optional argument TAGS is a list of tags to search.
 245 Like `semanticdb-find-tags-by-name-method' for Emacs Lisp."
 246   (semanticdb-find-tags-by-name-method table name tags))
 247
 248 (defmethod semanticdb-deep-find-tags-by-name-regexp-method
 249   ((table semanticdb-table-emacs-lisp) regex &optional tags)
 250   "Find all tags with name matching REGEX in TABLE.
 251 Optional argument TAGS is a list of tags to search.
 252 Like `semanticdb-find-tags-by-name-method' for Emacs Lisp."
 253   (semanticdb-find-tags-by-name-regexp-method table regex tags))
 254
 255 (defmethod semanticdb-deep-find-tags-for-completion-method
 256   ((table semanticdb-table-emacs-lisp) prefix &optional tags)
 257   "In TABLE, find all occurances of tags matching PREFIX.
 258 Optional argument TAGS is a list of tags to search.
 259 Like `semanticdb-find-tags-for-completion-method' for Emacs Lisp."
 260   (semanticdb-find-tags-for-completion-method table prefix tags))
 261
 262 ;;; Advanced Searches
 263 ;;
 264 (defmethod semanticdb-find-tags-external-children-of-type-method
 265   ((table semanticdb-table-emacs-lisp) type &optional tags)
 266   "Find all nonterminals which are child elements of TYPE
 267 Optional argument TAGS is a list of tags to search.
 268 Return a list of tags."
 269   (if tags (call-next-method)
 270     ;; EIEIO is the only time this matters
 271     (when (featurep 'eieio)
 272       (let* ((class (intern-soft type))
 273              (taglst (when class
 274                        (delq nil
 275                              (mapcar 'semanticdb-elisp-sym->tag
 276                                      ;; Fancy eieio function that knows all about
 277                                      ;; built in methods belonging to CLASS.
 278                                      (eieio-all-generic-functions class)))))
 279              )
 280         taglst))))
 281
 282 (provide 'semanticdb-el)
 283
 284 ;;; semanticdb-el.el ends here