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

   1 ;;; semantic-el.el --- Semantic details for Emacs Lisp
   2
   3 ;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007 Eric M. Ludlam
   4
   5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
   6 ;; X-RCS: $Id: semantic-el.el,v 1.2 2007-12-03 07:04:56 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 for Emacs Lisp
  28
  29 (require 'semantic)
  30 (require 'semantic-bovine)
  31 (require 'backquote)
  32 (require 'find-func)
  33 (eval-when-compile
  34   (require 'semantic-imenu)
  35   )
  36
  37 ;;; Code:
  38 \f
  39 ;;; Lexer
  40 ;;
  41 (define-lex semantic-emacs-lisp-lexer
  42   "A simple lexical analyzer for Emacs Lisp.
  43 This lexer ignores comments and whitespace, and will return
  44 syntax as specified by the syntax table."
  45   semantic-lex-ignore-whitespace
  46   semantic-lex-ignore-newline
  47   semantic-lex-number
  48   semantic-lex-symbol-or-keyword
  49   semantic-lex-charquote
  50   semantic-lex-paren-or-list
  51   semantic-lex-close-paren
  52   semantic-lex-string
  53   semantic-lex-ignore-comments
  54   semantic-lex-punctuation
  55   semantic-lex-default-action)
  56 \f
  57 ;;; Parser
  58 ;;
  59 (defvar semantic--elisp-parse-table
  60   `((bovine-toplevel
  61      (semantic-list
  62       ,(lambda (vals start end)
  63          (let ((tag (semantic-elisp-use-read (car vals))))
  64            (cond
  65             ((and (listp tag) (semantic-tag-p (car tag)))
  66              ;; We got a list of tags back.  This list is
  67              ;; returned here in the correct order, but this
  68              ;; list gets reversed later, putting the correctly ordered
  69              ;; items into reverse order later.
  70              (nreverse tag))
  71             ((semantic--tag-expanded-p tag)
  72              ;; At this point, if `semantic-elisp-use-read' returned an
  73              ;; already expanded tag (from definitions parsed inside an
  74              ;; eval and compile wrapper), just pass it!
  75              tag)
  76             (t
  77              ;; We got the basics of a single tag.
  78              (append tag (list start end))))))))
  79     )
  80   "Top level bovination table for elisp.")
  81
  82 (defun semantic-elisp-desymbolify (arglist)
  83   "Convert symbols to strings for ARGLIST."
  84   (let ((out nil))
  85     (while arglist
  86       (setq out
  87             (cons
  88              (if (symbolp (car arglist))
  89                  (symbol-name (car arglist))
  90                (if (and (listp (car arglist))
  91                         (symbolp (car (car arglist))))
  92                    (symbol-name (car (car arglist)))
  93                  (format "%S" (car arglist))))
  94              out)
  95             arglist (cdr arglist)))
  96     (nreverse out)))
  97
  98 (defun semantic-elisp-clos-slot-property-string (slot property)
  99   "For SLOT, a string representing PROPERTY."
 100   (let ((p (member property slot)))
 101     (if (not p)
 102         nil
 103       (setq p (cdr p))
 104       (cond
 105        ((stringp (car p))
 106         (car p))
 107        ((or (symbolp (car p)) (listp (car p)))
 108         (format "%S" (car p)))
 109        (t nil)))))
 110
 111 (defun semantic-elisp-clos-args-to-semantic (partlist)
 112   "Convert a list of CLOS class slot PARTLIST to `variable' tags."
 113   (let (vars part v)
 114     (while partlist
 115       (setq part (car partlist)
 116             partlist (cdr partlist)
 117             v (semantic-tag-new-variable
 118                (symbol-name (car part))
 119                (semantic-elisp-clos-slot-property-string part :type)
 120                (semantic-elisp-clos-slot-property-string part :initform)
 121                ;; Attributes
 122                :protection (semantic-elisp-clos-slot-property-string
 123                             part :protection)
 124                :static-flag (equal (semantic-elisp-clos-slot-property-string
 125                                     part :allocation)
 126                                    ":class")
 127                :documentation (semantic-elisp-clos-slot-property-string
 128                                part :documentation))
 129             vars (cons v vars)))
 130     (nreverse vars)))
 131
 132 (defun semantic-elisp-form-to-doc-string (form)
 133   "After reading a form FORM, covert it to a doc string.
 134 For Emacs Lisp, sometimes that string is non-existant.
 135 Sometimes it is a form which is evaluated at compile time, permitting
 136 compound strings."
 137   (cond ((stringp form) form)
 138         ((and (listp form) (eq (car form) 'concat)
 139               (stringp (nth 1 form)))
 140          (nth 1 form))
 141         (t nil)))
 142
 143 (defvar semantic-elisp-store-documentation-in-tag nil
 144   "*When non-nil, store documentation strings in the created tags.")
 145
 146 (defun semantic-elisp-do-doc (str)
 147   "Return STR as a documentation string IF they are enabled."
 148   (when semantic-elisp-store-documentation-in-tag
 149     (semantic-elisp-form-to-doc-string str)))
 150
 151 (defmacro semantic-elisp-setup-form-parser (parser &rest symbols)
 152   "Install the function PARSER as the form parser for SYMBOLS.
 153 SYMBOLS is a list of symbols identifying the forms to parse.
 154 PARSER is called on every forms whose first element (car FORM) is
 155 found in SYMBOLS.  It is passed the parameters FORM, START, END,
 156 where:
 157
 158 - FORM is an Elisp form read from the current buffer.
 159 - START and END are the beginning and end location of the
 160   corresponding data in the current buffer."
 161   (let ((sym (make-symbol "sym")))
 162     `(dolist (,sym ',symbols)
 163        (put ,sym 'semantic-elisp-form-parser #',parser))))
 164 (put 'semantic-elisp-setup-form-parser 'lisp-indent-function 1)
 165
 166 (defmacro semantic-elisp-reuse-form-parser (symbol &rest symbols)
 167   "Reuse the form parser of SYMBOL for forms identified by SYMBOLS.
 168 See also `semantic-elisp-setup-form-parser'."
 169   (let ((parser (make-symbol "parser"))
 170         (sym (make-symbol "sym")))
 171     `(let ((,parser (get ',symbol 'semantic-elisp-form-parser)))
 172        (or ,parser
 173            (signal 'wrong-type-argument
 174                    '(semantic-elisp-form-parser ,symbol)))
 175        (dolist (,sym ',symbols)
 176          (put ,sym 'semantic-elisp-form-parser ,parser)))))
 177
 178 (defun semantic-elisp-use-read (sl)
 179   "Use `read' on the semantic list SL.
 180 Return a bovination list to use."
 181   (let* ((start (car sl))
 182          (end   (cdr sl))
 183          (form  (read (buffer-substring start end))))
 184     (cond
 185      ;; If the first elt is a list, then it is some arbitrary code.
 186      ((listp (car form))
 187       (semantic-tag-new-code "anonymous" nil)
 188       )
 189      ;; A special form parser is provided, use it.
 190      ((and (car form) (symbolp (car form))
 191            (get (car form) 'semantic-elisp-form-parser))
 192       (funcall (get (car form) 'semantic-elisp-form-parser)
 193                form start end))
 194      ;; Produce a generic code tag by default.
 195      (t
 196       (semantic-tag-new-code (format "%S" (car form)) nil)
 197       ))))
 198 \f
 199 ;;; Form parsers
 200 ;;
 201 (semantic-elisp-setup-form-parser
 202     (lambda (form start end)
 203       (semantic-tag-new-function
 204        (symbol-name (nth 2 form))
 205        nil
 206        '("form" "start" "end")
 207        :form-parser t
 208        ))
 209   semantic-elisp-setup-form-parser)
 210
 211 (semantic-elisp-setup-form-parser
 212     (lambda (form start end)
 213       (let ((tags
 214              (condition-case foo
 215                  (semantic-parse-region start end nil 1)
 216                (error (message "MUNGE: %S" foo)
 217                       nil))))
 218         (if (semantic-tag-p (car-safe tags))
 219             tags
 220           (semantic-tag-new-code (format "%S" (car form)) nil))))
 221   eval-and-compile
 222   eval-when-compile
 223   )
 224
 225 (semantic-elisp-setup-form-parser
 226     (lambda (form start end)
 227       (semantic-tag-new-function
 228        (symbol-name (nth 1 form))
 229        nil
 230        (semantic-elisp-desymbolify (nth 2 form))
 231        :user-visible-flag (eq (car-safe (nth 4 form)) 'interactive)
 232        :documentation (semantic-elisp-do-doc (nth 3 form))
 233        :overloadable (eq (car form) 'define-overload)
 234        ))
 235   defun
 236   defun*
 237   defsubst
 238   defmacro
 239   define-overload
 240   )
 241
 242 (semantic-elisp-setup-form-parser
 243     (lambda (form start end)
 244       (let ((doc (semantic-elisp-form-to-doc-string (nth 3 form))))
 245         (semantic-tag-new-variable
 246          (symbol-name (nth 1 form))
 247          nil
 248          (nth 2 form)
 249          :user-visible-flag (and doc
 250                                  (> (length doc) 0)
 251                                  (= (aref doc 0) ?*))
 252          :constant-flag (eq (car form) 'defconst)
 253          :documentation (semantic-elisp-do-doc doc)
 254          )))
 255   defvar
 256   defconst
 257   defcustom
 258   defface
 259   defimage
 260   defezimage
 261   )
 262
 263 (semantic-elisp-setup-form-parser
 264     (lambda (form start end)
 265       (semantic-tag-new-function
 266        (symbol-name (cadr (cadr form)))
 267        nil nil
 268        :user-visible-flag (and (nth 4 form)
 269                                (not (eq (nth 4 form) 'nil)))
 270        :prototype-flag t
 271        :documentation (semantic-elisp-do-doc (nth 3 form))))
 272   autoload
 273   )
 274
 275 (semantic-elisp-setup-form-parser
 276     (lambda (form start end)
 277       (let* ((a2 (nth 2 form))
 278              (a3 (nth 3 form))
 279              (args (if (listp a2) a2 a3))
 280              (doc (nth (if (listp a2) 3 4) form)))
 281         (semantic-tag-new-function
 282          (symbol-name (nth 1 form))
 283          nil
 284          (if (listp (car args))
 285              (cons (symbol-name (caar args))
 286                    (semantic-elisp-desymbolify (cdr args)))
 287            (semantic-elisp-desymbolify (cdr args)))
 288          :parent (if (listp (car args)) (symbol-name (cadr (car args))) nil)
 289          :documentation (semantic-elisp-do-doc doc)
 290          )))
 291   defmethod
 292   defgeneric
 293   )
 294
 295 (semantic-elisp-setup-form-parser
 296     (lambda (form start end)
 297       (semantic-tag-new-function
 298        (symbol-name (nth 1 form))
 299        nil
 300        (semantic-elisp-desymbolify (nth 2 form))
 301        ))
 302   defadvice
 303   )
 304
 305 (semantic-elisp-setup-form-parser
 306     (lambda (form start end)
 307       (let ((docpart (nthcdr 4 form)))
 308         (semantic-tag-new-type
 309          (symbol-name (nth 1 form))
 310          "class"
 311          (semantic-elisp-clos-args-to-semantic (nth 3 form))
 312          (semantic-elisp-desymbolify (nth 2 form))
 313          :typemodifiers (semantic-elisp-desymbolify
 314                          (unless (stringp (car docpart)) docpart))
 315          :documentation (semantic-elisp-do-doc
 316                          (if (stringp (car docpart))
 317                              (car docpart)
 318                            (cadr (member :documentation docpart))))
 319          )))
 320   defclass
 321   )
 322
 323 (semantic-elisp-setup-form-parser
 324     (lambda (form start end)
 325       (let ((slots (nthcdr 2 form)))
 326         ;; Skip doc string if present.
 327         (and (stringp (car slots))
 328              (setq slots (cdr slots)))
 329         (semantic-tag-new-type
 330          (symbol-name (if (consp (nth 1 form))
 331                           (car (nth 1 form))
 332                         (nth 1 form)))
 333          "struct"
 334          (semantic-elisp-desymbolify slots)
 335          (cons nil nil)
 336          )))
 337   defstruct
 338   )
 339
 340 (semantic-elisp-setup-form-parser
 341     (lambda (form start end)
 342       (semantic-tag-new-function
 343        (symbol-name (nth 1 form))
 344        nil nil
 345        :lexical-analyzer-flag t
 346        :documentation (semantic-elisp-do-doc (nth 2 form))
 347        ))
 348   define-lex
 349   )
 350
 351 (semantic-elisp-setup-form-parser
 352     (lambda (form start end)
 353       (let ((args (nth 3 form)))
 354         (semantic-tag-new-function
 355          (symbol-name (nth 1 form))
 356          nil
 357          (and (listp args) (semantic-elisp-desymbolify args))
 358          :override-function-flag t
 359          :parent (symbol-name (nth 2 form))
 360          :documentation (semantic-elisp-do-doc (nth 4 form))
 361          )))
 362   define-mode-overload-implementation ;; obsoleted
 363   define-mode-local-override
 364   )
 365
 366 (semantic-elisp-setup-form-parser
 367     (lambda (form start end)
 368       (semantic-tag-new-variable
 369        (symbol-name (nth 2 form))
 370        nil
 371        (nth 3 form)                     ; default value
 372        :override-variable-flag t
 373        :parent (symbol-name (nth 1 form))
 374        :documentation (semantic-elisp-do-doc (nth 4 form))
 375        ))
 376   defvar-mode-local
 377   )
 378
 379 (semantic-elisp-setup-form-parser
 380     (lambda (form start end)
 381       (let ((name (nth 1 form)))
 382         (semantic-tag-new-include
 383          (symbol-name (if (eq (car-safe name) 'quote)
 384                           (nth 1 name)
 385                         name))
 386          nil
 387          :directory (nth 2 form))))
 388   require
 389   )
 390
 391 (semantic-elisp-setup-form-parser
 392     (lambda (form start end)
 393       (let ((name (nth 1 form)))
 394         (semantic-tag-new-package
 395          (symbol-name (if (eq (car-safe name) 'quote)
 396                           (nth 1 name)
 397                         name))
 398          (nth 3 form))))
 399   provide
 400   )
 401 \f
 402 ;;; Mode setup
 403 ;;
 404 (define-mode-local-override semantic-dependency-tag-file
 405   emacs-lisp-mode (tag)
 406   "Find the file BUFFER depends on described by TAG."
 407   (let ((f (file-name-sans-extension
 408             (locate-library (semantic-tag-name tag)))))
 409     (concat f ".el")))
 410
 411 (defun semantic-emacs-lisp-overridable-doc (tag)
 412   "Return the documentation string generated for overloadable functions.
 413 Fetch the item for TAG.  Only returns info about what symbols can be
 414 used to perform the override."
 415   (if (and (eq (semantic-tag-class tag) 'function)
 416            (semantic-tag-get-attribute tag :overloadable))
 417       ;; Calc the doc to use for the overloadable symbols.
 418       (overload-docstring-extension (intern (semantic-tag-name tag)))
 419     ""))
 420
 421 (defun semantic-emacs-lisp-obsoleted-doc (tag)
 422   "Indicate that TAG is a new name that has obsoleted  some old name.
 423 Unfortunately, this requires that the tag in question has been loaded
 424 into Emacs Lisp's memory."
 425   (let ((obsoletethis (intern-soft (semantic-tag-name tag)))
 426         (obsoletor nil))
 427     ;; This asks if our tag is available in the Emacs name space for querying.
 428     (when obsoletethis
 429       (mapatoms (lambda (a)
 430                   (let ((oi (get a 'byte-obsolete-info)))
 431                     (if (and oi (eq (car oi) obsoletethis))
 432                         (setq obsoletor a)))))
 433       (if obsoletor
 434           (format "\n@obsolete{%s,%s}" obsoletor (semantic-tag-name tag))
 435         ""))))
 436
 437 (define-mode-local-override semantic-documentation-for-tag
 438   emacs-lisp-mode (tag &optional nosnarf)
 439   "Return the documentation string for TAG.
 440 Optional argument NOSNARF is ignored."
 441   (let ((d (semantic-tag-docstring tag)))
 442     (when (not d)
 443       (cond ((semantic-tag-buffer tag)
 444              ;; Doc isn't in the tag itself.  Lets pull it out of the
 445              ;; sources.
 446              (let ((semantic-elisp-store-documentation-in-tag t))
 447                (setq tag (with-current-buffer (semantic-tag-buffer tag)
 448                            (goto-char (semantic-tag-start tag))
 449                            (semantic-elisp-use-read
 450                             ;; concoct a lexical token.
 451                             (cons (semantic-tag-start tag)
 452                                   (semantic-tag-end tag))))
 453                      d (semantic-tag-docstring tag))))
 454             ;; The tag may be the result of a system search.
 455             ((intern-soft (semantic-tag-name tag))
 456              (let ((sym (intern-soft (semantic-tag-name tag))))
 457                ;; Query into the global table o stuff.
 458                (cond ((eq (semantic-tag-class tag) 'function)
 459                       (setq d (documentation sym)))
 460                      (t
 461                       (setq d (documentation-property
 462                                sym 'variable-documentation)))))
 463              ;; Label it as system doc.. perhaps just for debugging
 464              ;; purposes.
 465              (if d (setq d (concat "Sytem Doc: \n" d)))
 466              ))
 467       )
 468
 469     (when d
 470       (concat
 471        (substitute-command-keys
 472         (if (and (> (length d) 0) (= (aref d 0) ?*))
 473             (substring d 1)
 474           d))
 475        (semantic-emacs-lisp-overridable-doc tag)
 476        (semantic-emacs-lisp-obsoleted-doc tag)))))
 477
 478 (define-mode-local-override semantic-insert-foreign-tag
 479   emacs-lisp-mode (tag tagfile)
 480   "Insert TAG from TAGFILE at point.
 481 Attempts a simple prototype for calling or using TAG."
 482   (cond ((semantic-tag-of-class-p tag 'function)
 483          (insert "(" (semantic-tag-name tag) " )")
 484          (forward-char -1))
 485         (t
 486          (insert (semantic-tag-name tag)))))
 487
 488 (define-mode-local-override semantic-tag-protection
 489   emacs-lisp-mode (tag &optional parent)
 490   "Return the protection of TAG in PARENT.
 491 Override function for `semantic-tag-protection'."
 492   (let ((prot (semantic-tag-get-attribute tag :protection)))
 493     (cond
 494      ;; If a protection is not specified, AND there is a parent
 495      ;; data type, then it is public.
 496      ((and (not prot) parent) 'public)
 497      ((string= prot ":public") 'public)
 498      ((string= prot "public") 'public)
 499      ((string= prot ":private") 'private)
 500      ((string= prot "private") 'private)
 501      ((string= prot ":protected") 'protected)
 502      ((string= prot "protected") 'protected))))
 503
 504 (define-mode-local-override semantic-tag-static-p
 505   emacs-lisp-mode (tag &optional parent)
 506   "Return non-nil if TAG is static in PARENT class.
 507 Overrides `semantic-nonterminal-static'."
 508   ;; This can only be true (theoretically) in a class where it is assigned.
 509   (semantic-tag-get-attribute tag :static-flag))
 510
 511 ;;; Context parsing
 512 ;;
 513 ;; Emacs lisp is very different from C,C++ which most context parsing
 514 ;; functions are written.  Support them here.
 515 (define-mode-local-override semantic-up-context emacs-lisp-mode
 516   (&optional point bounds-type)
 517   "Move up one context in an Emacs Lisp function.
 518 A Context in many languages is a block with it's own local variables.
 519 In Emacs, we will move up lists and stop when one starts with one of
 520 the following context specifiers:
 521   `let', `let*', `defun', `with-slots'
 522 Returns non-nil it is not possible to go up a context."
 523   (let ((last-up (semantic-up-context-default)))
 524   (while
 525       (and (not (looking-at
 526                  "(\\(let\\*?\\|def\\(un\\|method\\|generic\\|\
 527 define-mode-overload\\)\
 528 \\|with-slots\\)"))
 529            (not last-up))
 530     (setq last-up (semantic-up-context-default)))
 531   last-up))
 532
 533
 534 (define-mode-local-override semantic-get-local-variables emacs-lisp-mode
 535   (&optional point)
 536   "Return a list of local variables for POINT.
 537 Scan backwards from point at each successive function.  For all occurances
 538 of `let' or `let*', grab those variable names."
 539   (let* ((vars nil)
 540          (fn nil))
 541     (save-excursion
 542       (while (setq fn (car (semantic-ctxt-current-function)))
 543         (when (member fn '("let" "let*"))
 544           ;; Snarf variables
 545           (up-list -1)
 546           (forward-char 1)
 547           (forward-word 1)
 548           (skip-chars-forward "* \t\n")
 549           (let ((varlst (read (buffer-substring (point)
 550                                                 (save-excursion
 551                                                   (forward-sexp 1)
 552                                                   (point))))))
 553             (while varlst
 554               (let* ((oneelt (car varlst))
 555                      (name (if (symbolp oneelt)
 556                                oneelt
 557                              (car oneelt))))
 558                 (setq vars (cons (semantic-tag-new-variable
 559                                   (symbol-name name)
 560                                   nil nil)
 561                                  vars)))
 562               (setq varlst (cdr varlst)))
 563             ))
 564         (up-list -1)))
 565     (nreverse vars)))
 566
 567 (define-mode-local-override semantic-end-of-command emacs-lisp-mode
 568   ()
 569   "Move cursor to the end of the current command.
 570 In emacs lisp this is easilly defined by parenthisis bounding."
 571   (condition-case nil
 572       (up-list 1)
 573     (error nil)))
 574
 575 (define-mode-local-override semantic-beginning-of-command emacs-lisp-mode
 576   ()
 577   "Move cursor to the beginning of the current command.
 578 In emacs lisp this is easilly defined by parenthisis bounding."
 579   (condition-case nil
 580       (progn
 581         (up-list -1)
 582         (forward-char 1))
 583     (error nil)))
 584
 585 (define-mode-local-override semantic-ctxt-current-symbol emacs-lisp-mode
 586   (&optional point)
 587   "List the symbol under point."
 588   (save-excursion
 589     (if point (goto-char point))
 590     (require 'thingatpt)
 591     (let ((sym (thing-at-point 'symbol)))
 592       (if sym (list sym)))
 593     ))
 594
 595 (define-mode-local-override semantic-ctxt-current-function emacs-lisp-mode
 596   (&optional point)
 597   "Return a string which is the current function being called."
 598   (save-excursion
 599     (if point (goto-char point) (setq point (point)))
 600     ;; (semantic-beginning-of-command)
 601     (if (condition-case nil
 602             (and (save-excursion
 603                    (up-list -2)
 604                    (looking-at "(("))
 605                  (save-excursion
 606                    (up-list -3)
 607                    (looking-at "(let")))
 608           (error nil))
 609         ;; This is really a let statement, not a function.
 610         nil
 611       (let ((fun (condition-case nil
 612                      (save-excursion
 613                        (up-list -1)
 614                        (forward-char 1)
 615                        (buffer-substring-no-properties
 616                         (point) (progn (forward-sexp 1)
 617                                        (point))))
 618                    (error nil))
 619                  ))
 620         (when fun
 621           ;; Do not return FUN IFF the cursor is on FUN.
 622           ;; Huh?  Thats because if cursor is on fun, it is
 623           ;; the current symbol, and not the current function.
 624           (if (save-excursion
 625                 (condition-case nil
 626                     (progn (forward-sexp -1)
 627                            (and
 628                             (looking-at (regexp-quote fun))
 629                             (<= point (+ (point) (length fun))))
 630                            )
 631                   (error t)))
 632               nil
 633             ;; We are ok, so get it.
 634             (list fun))
 635           ))
 636       )))
 637
 638 (define-mode-local-override semantic-ctxt-current-assignment emacs-lisp-mode
 639   (&optional point)
 640   "What is the variable being assigned into at POINT?"
 641   (save-excursion
 642     (if point (goto-char point))
 643     (let ((fn (semantic-ctxt-current-function point))
 644           (point (point)))
 645       ;; We should never get lists from here.
 646       (if fn (setq fn (car fn)))
 647       (cond
 648        ;; SETQ
 649        ((and fn (or (string= fn "setq") (string= fn "set")))
 650         (save-excursion
 651           (condition-case nil
 652               (let ((count 0)
 653                     (lastodd nil)
 654                     (start nil))
 655                 (up-list -1)
 656                 (down-list 1)
 657                 (forward-sexp 1)
 658                 ;; Skip over sexp until we pass point.
 659                 (while (< (point) point)
 660                   (setq count (1+ count))
 661                   (forward-comment 1)
 662                   (setq start (point))
 663                   (forward-sexp 1)
 664                   (if (= (% count 2) 1)
 665                       (setq lastodd
 666                             (buffer-substring-no-properties start (point))))
 667                   )
 668                 (if lastodd (list lastodd))
 669                 )
 670             (error nil))))
 671        ;; This obscure thing finds let statements.
 672        ((condition-case nil
 673             (and
 674              (save-excursion
 675                (up-list -2)
 676                (looking-at "(("))
 677              (save-excursion
 678                (up-list -3)
 679                (looking-at "(let")))
 680           (error nil))
 681         (save-excursion
 682           (semantic-beginning-of-command)
 683           ;; Use func finding code, since it is the same format.
 684           (semantic-ctxt-current-symbol)))
 685        ;;
 686        ;; DEFAULT- nothing
 687        (t nil))
 688       )))
 689
 690 (define-mode-local-override semantic-ctxt-current-argument emacs-lisp-mode
 691   (&optional point)
 692   "Return the index into the argument the cursor is in, or nil."
 693   (save-excursion
 694     (if point (goto-char point))
 695     (if (looking-at "\\<\\w")
 696         (forward-char 1))
 697     (let ((count 0))
 698       (while (condition-case nil
 699                  (progn
 700                    (forward-sexp -1)
 701                    t)
 702                (error nil))
 703         (setq count (1+ count)))
 704       (cond ((= count 0)
 705              0)
 706             (t (1- count))))
 707     ))
 708
 709 (define-mode-local-override semantic-ctxt-current-class-list emacs-lisp-mode
 710   (&optional point)
 711   "Return a list of tag classes allowed at POINT.
 712 Emacs Lisp knows much more about the class of the tag needed to perform
 713 completion than some langauges.  We distincly know if we are to be
 714 a function name, variable name, or any type of symbol.  We could identify
 715 fields and such to, but that is for some other day."
 716   (save-excursion
 717     (if point (goto-char point))
 718     (setq point (point))
 719     (condition-case nil
 720         (let ((count 0))
 721           (up-list -1)
 722           (forward-char 1)
 723           (while (< (point) point)
 724             (setq count (1+ count))
 725             (forward-sexp 1))
 726           (if (= count 1)
 727               '(function)
 728             '(variable))
 729           )
 730       (error '(variable)))
 731     ))
 732
 733 (define-mode-local-override semantic-tag-include-filename emacs-lisp-mode
 734   (tag)
 735   "Return the name of the tag with .el appended.
 736 If there is a detail, prepend that directory."
 737   (let ((name (semantic-tag-name tag))
 738         (detail (semantic-tag-get-attribute tag :directory)))
 739     (concat (expand-file-name name detail) ".el")))
 740
 741 (define-mode-local-override semantic-format-tag-abbreviate emacs-lisp-mode
 742   (tag &optional parent color)
 743   "Return an abbreviated string describing tag."
 744   (let ((class (semantic-tag-class tag))
 745         (name (semantic-format-tag-name tag parent color))
 746         str)
 747     (cond
 748      ((eq class 'function)
 749       (concat "(" name ")"))
 750      (t
 751       (semantic-format-tag-abbreviate-default tag parent color)))))
 752
 753 (define-mode-local-override semantic-format-tag-prototype emacs-lisp-mode
 754   (tag &optional parent color)
 755   "Return a prototype string describing tag.
 756 In Emacs Lisp, a prototype for something may start (autoload ...).
 757 This is certainly not expected if this is used to display a summary.
 758 Make up something else.  When we go to write something that needs
 759 a real Emacs Lisp protype, we can fix it then."
 760   (let ((class (semantic-tag-class tag))
 761         (name (semantic-format-tag-name tag parent color))
 762         str)
 763     (cond
 764      ((eq class 'function)
 765       (let* ((args  (semantic-tag-function-arguments tag))
 766              (argstr (semantic--format-tag-arguments args
 767                                                      #'identity
 768                                                      color)))
 769         (concat "(" name (if args " " "")
 770                 argstr
 771                 ")")))
 772      (t
 773       (semantic-format-tag-prototype-default tag parent color)))))
 774
 775 (define-mode-local-override semantic-format-tag-concise-prototype emacs-lisp-mode
 776   (tag &optional parent color)
 777   "Return a concise prototype string describing tag.
 778 See `semantic-format-tag-prototype' for Emacs Lisp for more details."
 779   (semantic-format-tag-prototype tag parent color))
 780
 781 (define-mode-local-override semantic-format-tag-uml-prototype emacs-lisp-mode
 782   (tag &optional parent color)
 783   "Return a uml prototype string describing tag.
 784 See `semantic-format-tag-prototype' for Emacs Lisp for more details."
 785   (semantic-format-tag-prototype tag parent color))
 786
 787 (defvar-mode-local emacs-lisp-mode semantic-lex-analyzer
 788   'semantic-emacs-lisp-lexer)
 789
 790 (defvar-mode-local emacs-lisp-mode semantic--parse-table
 791   semantic--elisp-parse-table)
 792
 793 (defvar-mode-local emacs-lisp-mode semantic-function-argument-separator
 794   " ")
 795
 796 (defvar-mode-local emacs-lisp-mode semantic-function-argument-separation-character
 797   " ")
 798
 799 (defvar-mode-local emacs-lisp-mode semantic-symbol->name-assoc-list
 800   '(
 801     (type     . "Types")
 802     (variable . "Variables")
 803     (function . "Defuns")
 804     (include  . "Requires")
 805     (package  . "Provides")
 806     ))
 807
 808 (defvar-mode-local emacs-lisp-mode imenu-create-index-function
 809   'semantic-create-imenu-index)
 810
 811 (define-child-mode lisp-mode emacs-lisp-mode
 812   "Make `lisp-mode' inherits mode local behavior from `emacs-lisp-mode'.")
 813
 814 ;;;###autoload
 815 (defun semantic-default-elisp-setup ()
 816   "Setup hook function for Emacs Lisp files and Semantic."
 817   )
 818
 819 ; ;;;###autoload
 820 (add-hook 'emacs-lisp-mode-hook 'semantic-default-elisp-setup)
 821
 822 ;;; LISP MODE
 823 ;;
 824 ;; @TODO: Lisp supports syntaxes that Emacs Lisp does not.
 825 ;;        Write a Lisp only parser someday.
 826 ;;
 827 ;; See this syntax:
 828 ;; (defun foo () /#A)
 829 ;;
 830 ; ;;;###autoload
 831 (add-hook 'lisp-mode-hook 'semantic-default-elisp-setup)
 832
 833 ; ;;;###autoload
 834 (eval-after-load "semanticdb"
 835   '(require 'semanticdb-el)
 836   )
 837
 838 (provide 'semantic-el)
 839
 840 ;;; semantic-el.el ends here