Initial Commit
[temp.git] / site-lisp / cedet-1.0pre4 / semantic / bovine / semantic-el.el
blobe8073e6979d8d86a249b7373a7415c34cc81198d
1 ;;; semantic-el.el --- Semantic details for Emacs Lisp
3 ;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007 Eric M. Ludlam
5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
6 ;; X-RCS: $Id: semantic-el.el,v 1.39 2007/03/08 04:11:20 zappo Exp $
8 ;; This file is not part of GNU Emacs.
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.
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.
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.
25 ;;; Commentary:
27 ;; Use the Semantic Bovinator for Emacs Lisp
29 (require 'semantic)
30 (require 'semantic-bovine)
31 (require 'backquote)
32 (require 'find-func)
33 (eval-when-compile
34 (require 'semantic-imenu)
37 ;;; Code:
39 ;;; Lexer
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)
57 ;;; Parser
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)
77 ;; We got the basics of a single tag.
78 (append tag (list start end))))))))
80 "Top level bovination table for elisp.")
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)))
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)
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)))))
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)))
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)))
143 (defvar semantic-elisp-store-documentation-in-tag nil
144 "*When non-nil, store documentation strings in the created tags.")
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)))
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:
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)
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)))))
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)
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.
196 (semantic-tag-new-code (format "%S" (car form)) nil)
197 ))))
199 ;;; Form parsers
201 (semantic-elisp-setup-form-parser
202 (lambda (form start end)
203 (semantic-tag-new-function
204 (symbol-name (nth 2 form))
206 '("form" "start" "end")
207 :form-parser t
209 semantic-elisp-setup-form-parser)
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
225 (semantic-elisp-setup-form-parser
226 (lambda (form start end)
227 (semantic-tag-new-function
228 (symbol-name (nth 1 form))
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)
235 defun
236 defun*
237 defsubst
238 defmacro
239 define-overload
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))
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)
255 defvar
256 defconst
257 defcustom
258 defface
259 defimage
260 defezimage
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
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))
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)
291 defmethod
292 defgeneric
295 (semantic-elisp-setup-form-parser
296 (lambda (form start end)
297 (semantic-tag-new-function
298 (symbol-name (nth 1 form))
300 (semantic-elisp-desymbolify (nth 2 form))
302 defadvice
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))))
320 defclass
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)
337 defstruct
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))
348 define-lex
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))
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))
362 define-mode-overload-implementation ;; obsoleted
363 define-mode-local-override
366 (semantic-elisp-setup-form-parser
367 (lambda (form start end)
368 (semantic-tag-new-variable
369 (symbol-name (nth 2 form))
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))
376 defvar-mode-local
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))
387 :directory (nth 2 form))))
388 require
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
402 ;;; Mode setup
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")))
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 ""))
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 ""))))
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)))
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)))
469 (when d
470 (concat
471 (substitute-command-keys
472 (if (and (> (length d) 0) (= (aref d 0) ?*))
473 (substring d 1)
475 (semantic-emacs-lisp-overridable-doc tag)
476 (semantic-emacs-lisp-obsoleted-doc tag)))))
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))
486 (insert (semantic-tag-name tag)))))
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))))
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))
511 ;;; Context parsing
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))
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)))
564 (up-list -1)))
565 (nreverse vars)))
567 (define-mode-local-override semantic-end-of-command emacs-lisp-mode
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)))
575 (define-mode-local-override semantic-beginning-of-command emacs-lisp-mode
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)))
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)))
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.
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))
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))))
631 (error t)))
633 ;; We are ok, so get it.
634 (list fun))
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))))
668 (if lastodd (list lastodd))
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)))
686 ;; DEFAULT- nothing
687 (t nil))
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)
702 (error nil))
703 (setq count (1+ count)))
704 (cond ((= count 0)
706 (t (1- count))))
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))
730 (error '(variable)))
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")))
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 ")"))
751 (semantic-format-tag-abbreviate-default tag parent color)))))
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 ")")))
773 (semantic-format-tag-prototype-default tag parent color)))))
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))
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))
787 (defvar-mode-local emacs-lisp-mode semantic-lex-analyzer
788 'semantic-emacs-lisp-lexer)
790 (defvar-mode-local emacs-lisp-mode semantic--parse-table
791 semantic--elisp-parse-table)
793 (defvar-mode-local emacs-lisp-mode semantic-function-argument-separator
794 " ")
796 (defvar-mode-local emacs-lisp-mode semantic-function-argument-separation-character
797 " ")
799 (defvar-mode-local emacs-lisp-mode semantic-symbol->name-assoc-list
801 (type . "Types")
802 (variable . "Variables")
803 (function . "Defuns")
804 (include . "Requires")
805 (package . "Provides")
808 (defvar-mode-local emacs-lisp-mode imenu-create-index-function
809 'semantic-create-imenu-index)
811 (define-child-mode lisp-mode emacs-lisp-mode
812 "Make `lisp-mode' inherits mode local behavior from `emacs-lisp-mode'.")
814 ;;;###autoload
815 (defun semantic-default-elisp-setup ()
816 "Setup hook function for Emacs Lisp files and Semantic."
819 ;;;###autoload
820 (add-hook 'emacs-lisp-mode-hook 'semantic-default-elisp-setup)
822 ;;; LISP MODE
824 ;; @TODO: Lisp supports syntaxes that Emacs Lisp does not.
825 ;; Write a Lisp only parser someday.
827 ;; See this syntax:
828 ;; (defun foo () /#A)
830 ;;;###autoload
831 (add-hook 'lisp-mode-hook 'semantic-default-elisp-setup)
833 ;;;###autoload
834 (eval-after-load "semanticdb"
835 '(require 'semanticdb-el)
838 (provide 'semantic-el)
840 ;;; semantic-el.el ends here