Spelling fixes for "does not exists".
[emacs.git] / lisp / cedet / semantic / bovine / el.el
blob0bbe3c61d76de76c57ba68b8b5c3bbc47f7db5b5
1 ;;; semantic/bovine/el.el --- Semantic details for Emacs Lisp
3 ;; Copyright (C) 1999-2005, 2007-2013 Free Software Foundation, Inc.
5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
7 ;; This file is part of GNU Emacs.
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.
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.
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/>.
22 ;;; Commentary:
24 ;; Use the Semantic Bovinator for Emacs Lisp
26 (require 'semantic)
27 (require 'semantic/bovine)
28 (require 'find-func)
30 (require 'semantic/ctxt)
31 (require 'semantic/format)
32 (require 'thingatpt)
34 ;;; Code:
36 ;;; Lexer
38 (define-lex semantic-emacs-lisp-lexer
39 "A simple lexical analyzer for Emacs Lisp.
40 This lexer ignores comments and whitespace, and will return
41 syntax as specified by the syntax table."
42 semantic-lex-ignore-whitespace
43 semantic-lex-ignore-newline
44 semantic-lex-number
45 semantic-lex-symbol-or-keyword
46 semantic-lex-charquote
47 semantic-lex-paren-or-list
48 semantic-lex-close-paren
49 semantic-lex-string
50 semantic-lex-ignore-comments
51 semantic-lex-punctuation
52 semantic-lex-default-action)
54 ;;; Parser
56 (defvar semantic--elisp-parse-table
57 `((bovine-toplevel
58 (semantic-list
59 ,(lambda (vals start end)
60 (let ((tag (semantic-elisp-use-read (car vals))))
61 (cond
62 ((and (listp tag) (semantic-tag-p (car tag)))
63 ;; We got a list of tags back. This list is
64 ;; returned here in the correct order, but this
65 ;; list gets reversed later, putting the correctly ordered
66 ;; items into reverse order later.
67 (nreverse tag))
68 ((semantic--tag-expanded-p tag)
69 ;; At this point, if `semantic-elisp-use-read' returned an
70 ;; already expanded tag (from definitions parsed inside an
71 ;; eval and compile wrapper), just pass it!
72 tag)
74 ;; We got the basics of a single tag.
75 (append tag (list start end))))))))
77 "Top level bovination table for elisp.")
79 (defun semantic-elisp-desymbolify (arglist)
80 "Convert symbols to strings for ARGLIST."
81 (let ((out nil))
82 (while arglist
83 (setq out
84 (cons
85 (if (symbolp (car arglist))
86 (symbol-name (car arglist))
87 (if (and (listp (car arglist))
88 (symbolp (car (car arglist))))
89 (symbol-name (car (car arglist)))
90 (format "%S" (car arglist))))
91 out)
92 arglist (cdr arglist)))
93 (nreverse out)))
95 (defun semantic-elisp-desymbolify-args (arglist)
96 "Convert symbols to strings for ARGLIST."
97 (let ((in (semantic-elisp-desymbolify arglist))
98 (out nil))
99 (dolist (T in)
100 (when (not (string-match "^&" T))
101 (push T out)))
102 (nreverse out)))
104 (defun semantic-elisp-clos-slot-property-string (slot property)
105 "For SLOT, a string representing PROPERTY."
106 (let ((p (member property slot)))
107 (if (not p)
109 (setq p (cdr p))
110 (cond
111 ((stringp (car p))
112 (car p))
113 ((or (symbolp (car p))
114 (listp (car p))
115 (numberp (car p)))
116 (format "%S" (car p)))
117 (t nil)))))
119 (defun semantic-elisp-clos-args-to-semantic (partlist)
120 "Convert a list of CLOS class slot PARTLIST to `variable' tags."
121 (let (vars part v)
122 (while partlist
123 (setq part (car partlist)
124 partlist (cdr partlist)
125 v (semantic-tag-new-variable
126 (symbol-name (car part))
127 (semantic-elisp-clos-slot-property-string part :type)
128 (semantic-elisp-clos-slot-property-string part :initform)
129 ;; Attributes
130 :protection (semantic-elisp-clos-slot-property-string
131 part :protection)
132 :static-flag (equal (semantic-elisp-clos-slot-property-string
133 part :allocation)
134 ":class")
135 :documentation (semantic-elisp-clos-slot-property-string
136 part :documentation))
137 vars (cons v vars)))
138 (nreverse vars)))
140 (defun semantic-elisp-form-to-doc-string (form)
141 "After reading a form FORM, convert it to a doc string.
142 For Emacs Lisp, sometimes that string is non-existent.
143 Sometimes it is a form which is evaluated at compile time, permitting
144 compound strings."
145 (cond ((stringp form) form)
146 ((and (listp form) (eq (car form) 'concat)
147 (stringp (nth 1 form)))
148 (nth 1 form))
149 (t nil)))
151 (defvar semantic-elisp-store-documentation-in-tag nil
152 "*When non-nil, store documentation strings in the created tags.")
154 (defun semantic-elisp-do-doc (str)
155 "Return STR as a documentation string IF they are enabled."
156 (when semantic-elisp-store-documentation-in-tag
157 (semantic-elisp-form-to-doc-string str)))
159 (defmacro semantic-elisp-setup-form-parser (parser &rest symbols)
160 "Install the function PARSER as the form parser for SYMBOLS.
161 SYMBOLS is a list of symbols identifying the forms to parse.
162 PARSER is called on every forms whose first element (car FORM) is
163 found in SYMBOLS. It is passed the parameters FORM, START, END,
164 where:
166 - FORM is an Elisp form read from the current buffer.
167 - START and END are the beginning and end location of the
168 corresponding data in the current buffer."
169 (let ((sym (make-symbol "sym")))
170 `(dolist (,sym ',symbols)
171 (put ,sym 'semantic-elisp-form-parser #',parser))))
172 (put 'semantic-elisp-setup-form-parser 'lisp-indent-function 1)
174 (defmacro semantic-elisp-reuse-form-parser (symbol &rest symbols)
175 "Reuse the form parser of SYMBOL for forms identified by SYMBOLS.
176 See also `semantic-elisp-setup-form-parser'."
177 (let ((parser (make-symbol "parser"))
178 (sym (make-symbol "sym")))
179 `(let ((,parser (get ',symbol 'semantic-elisp-form-parser)))
180 (or ,parser
181 (signal 'wrong-type-argument
182 '(semantic-elisp-form-parser ,symbol)))
183 (dolist (,sym ',symbols)
184 (put ,sym 'semantic-elisp-form-parser ,parser)))))
186 (defun semantic-elisp-use-read (sl)
187 "Use `read' on the semantic list SL.
188 Return a bovination list to use."
189 (let* ((start (car sl))
190 (end (cdr sl))
191 (form (read (buffer-substring-no-properties start end))))
192 (cond
193 ;; If the first elt is a list, then it is some arbitrary code.
194 ((listp (car form))
195 (semantic-tag-new-code "anonymous" nil)
197 ;; A special form parser is provided, use it.
198 ((and (car form) (symbolp (car form))
199 (get (car form) 'semantic-elisp-form-parser))
200 (funcall (get (car form) 'semantic-elisp-form-parser)
201 form start end))
202 ;; Produce a generic code tag by default.
204 (semantic-tag-new-code (format "%S" (car form)) nil)
205 ))))
207 ;;; Form parsers
209 (semantic-elisp-setup-form-parser
210 (lambda (form start end)
211 (semantic-tag-new-function
212 (symbol-name (nth 2 form))
214 '("form" "start" "end")
215 :form-parser t
217 semantic-elisp-setup-form-parser)
219 (semantic-elisp-setup-form-parser
220 (lambda (form start end)
221 (let ((tags
222 (condition-case foo
223 (semantic-parse-region start end nil 1)
224 (error (message "MUNGE: %S" foo)
225 nil))))
226 (if (semantic-tag-p (car-safe tags))
227 tags
228 (semantic-tag-new-code (format "%S" (car form)) nil))))
229 eval-and-compile
230 eval-when-compile
233 (semantic-elisp-setup-form-parser
234 (lambda (form start end)
235 (semantic-tag-new-function
236 (symbol-name (nth 1 form))
238 (semantic-elisp-desymbolify-args (nth 2 form))
239 :user-visible-flag (eq (car-safe (nth 4 form)) 'interactive)
240 :documentation (semantic-elisp-do-doc (nth 3 form))
241 :overloadable (or (eq (car form) 'define-overload)
242 (eq (car form) 'define-overloadable-function))
244 defun
245 defun*
246 defsubst
247 defmacro
248 define-overload ;; @todo - remove after cleaning up semantic.
249 define-overloadable-function
252 (semantic-elisp-setup-form-parser
253 (lambda (form start end)
254 (let ((doc (semantic-elisp-form-to-doc-string (nth 3 form))))
255 (semantic-tag-new-variable
256 (symbol-name (nth 1 form))
258 (nth 2 form)
259 :user-visible-flag (and doc
260 (> (length doc) 0)
261 (= (aref doc 0) ?*))
262 :constant-flag (eq (car form) 'defconst)
263 :documentation (semantic-elisp-do-doc doc)
265 defvar
266 defconst
267 defcustom
270 (semantic-elisp-setup-form-parser
271 (lambda (form start end)
272 (let ((doc (semantic-elisp-form-to-doc-string (nth 3 form))))
273 (semantic-tag-new-variable
274 (symbol-name (nth 1 form))
275 "face"
276 (nth 2 form)
277 :user-visible-flag (and doc
278 (> (length doc) 0)
279 (= (aref doc 0) ?*))
280 :documentation (semantic-elisp-do-doc doc)
282 defface
286 (semantic-elisp-setup-form-parser
287 (lambda (form start end)
288 (let ((doc (semantic-elisp-form-to-doc-string (nth 3 form))))
289 (semantic-tag-new-variable
290 (symbol-name (nth 1 form))
291 "image"
292 (nth 2 form)
293 :user-visible-flag (and doc
294 (> (length doc) 0)
295 (= (aref doc 0) ?*))
296 :documentation (semantic-elisp-do-doc doc)
298 defimage
299 defezimage
303 (semantic-elisp-setup-form-parser
304 (lambda (form start end)
305 (let ((doc (semantic-elisp-form-to-doc-string (nth 3 form))))
306 (semantic-tag
307 (symbol-name (nth 1 form))
308 'customgroup
309 :value (nth 2 form)
310 :user-visible-flag t
311 :documentation (semantic-elisp-do-doc doc)
313 defgroup
317 (semantic-elisp-setup-form-parser
318 (lambda (form start end)
319 (semantic-tag-new-function
320 (symbol-name (cadr (cadr form)))
321 nil nil
322 :user-visible-flag (and (nth 4 form)
323 (not (eq (nth 4 form) 'nil)))
324 :prototype-flag t
325 :documentation (semantic-elisp-do-doc (nth 3 form))))
326 autoload
329 (semantic-elisp-setup-form-parser
330 (lambda (form start end)
331 (let* ((a2 (nth 2 form))
332 (a3 (nth 3 form))
333 (args (if (listp a2) a2 a3))
334 (doc (nth (if (listp a2) 3 4) form)))
335 (semantic-tag-new-function
336 (symbol-name (nth 1 form))
338 (if (listp (car args))
339 (cons (symbol-name (caar args))
340 (semantic-elisp-desymbolify-args (cdr args)))
341 (semantic-elisp-desymbolify-args (cdr args)))
342 :parent (if (listp (car args)) (symbol-name (cadr (car args))) nil)
343 :documentation (semantic-elisp-do-doc doc)
345 defmethod
346 defgeneric
349 (semantic-elisp-setup-form-parser
350 (lambda (form start end)
351 (semantic-tag-new-function
352 (symbol-name (nth 1 form))
354 (semantic-elisp-desymbolify (nth 2 form))
356 defadvice
359 (semantic-elisp-setup-form-parser
360 (lambda (form start end)
361 (let ((docpart (nthcdr 4 form)))
362 (semantic-tag-new-type
363 (symbol-name (nth 1 form))
364 "class"
365 (semantic-elisp-clos-args-to-semantic (nth 3 form))
366 (semantic-elisp-desymbolify (nth 2 form))
367 :typemodifiers (semantic-elisp-desymbolify
368 (unless (stringp (car docpart)) docpart))
369 :documentation (semantic-elisp-do-doc
370 (if (stringp (car docpart))
371 (car docpart)
372 (cadr (member :documentation docpart))))
374 defclass
377 (semantic-elisp-setup-form-parser
378 (lambda (form start end)
379 (let ((slots (nthcdr 2 form)))
380 ;; Skip doc string if present.
381 (and (stringp (car slots))
382 (setq slots (cdr slots)))
383 (semantic-tag-new-type
384 (symbol-name (if (consp (nth 1 form))
385 (car (nth 1 form))
386 (nth 1 form)))
387 "struct"
388 (semantic-elisp-desymbolify slots)
389 (cons nil nil)
391 defstruct
394 (semantic-elisp-setup-form-parser
395 (lambda (form start end)
396 (semantic-tag-new-function
397 (symbol-name (nth 1 form))
398 nil nil
399 :lexical-analyzer-flag t
400 :documentation (semantic-elisp-do-doc (nth 2 form))
402 define-lex
405 (semantic-elisp-setup-form-parser
406 (lambda (form start end)
407 (let ((args (nth 3 form)))
408 (semantic-tag-new-function
409 (symbol-name (nth 1 form))
411 (and (listp args) (semantic-elisp-desymbolify args))
412 :override-function-flag t
413 :parent (symbol-name (nth 2 form))
414 :documentation (semantic-elisp-do-doc (nth 4 form))
416 define-mode-overload-implementation ;; obsoleted
417 define-mode-local-override
420 (semantic-elisp-setup-form-parser
421 (lambda (form start end)
422 (semantic-tag-new-variable
423 (symbol-name (nth 2 form))
425 (nth 3 form) ; default value
426 :override-variable-flag t
427 :parent (symbol-name (nth 1 form))
428 :documentation (semantic-elisp-do-doc (nth 4 form))
430 defvar-mode-local
433 (semantic-elisp-setup-form-parser
434 (lambda (form start end)
435 (let ((name (nth 1 form)))
436 (semantic-tag-new-include
437 (symbol-name (if (eq (car-safe name) 'quote)
438 (nth 1 name)
439 name))
441 :directory (nth 2 form))))
442 require
445 (semantic-elisp-setup-form-parser
446 (lambda (form start end)
447 (let ((name (nth 1 form)))
448 (semantic-tag-new-package
449 (symbol-name (if (eq (car-safe name) 'quote)
450 (nth 1 name)
451 name))
452 (nth 3 form))))
453 provide
456 ;;; Mode setup
458 (define-mode-local-override semantic-dependency-tag-file
459 emacs-lisp-mode (tag)
460 "Find the file BUFFER depends on described by TAG."
461 (if (fboundp 'find-library-name)
462 (condition-case nil
463 ;; Try an Emacs 22 fcn. This throws errors.
464 (find-library-name (semantic-tag-name tag))
465 (error
466 (message "semantic: cannot find source file %s"
467 (semantic-tag-name tag))))
468 ;; No handy function available. (Older Emacsen)
469 (let* ((lib (locate-library (semantic-tag-name tag)))
470 (name (if lib (file-name-sans-extension lib) nil))
471 (nameel (concat name ".el")))
472 (cond
473 ((and name (file-exists-p nameel)) nameel)
474 ((and name (file-exists-p (concat name ".el.gz")))
475 ;; This is the linux distro case.
476 (concat name ".el.gz"))
477 ;; Source file does not exist.
478 (name
479 (message "semantic: cannot find source file %s" (concat name ".el")))
481 nil)))))
483 ;;; DOC Strings
485 (defun semantic-emacs-lisp-overridable-doc (tag)
486 "Return the documentation string generated for overloadable functions.
487 Fetch the item for TAG. Only returns info about what symbols can be
488 used to perform the override."
489 (if (and (eq (semantic-tag-class tag) 'function)
490 (semantic-tag-get-attribute tag :overloadable))
491 ;; Calc the doc to use for the overloadable symbols.
492 (overload-docstring-extension (intern (semantic-tag-name tag)))
493 ""))
495 (defun semantic-emacs-lisp-obsoleted-doc (tag)
496 "Indicate that TAG is a new name that has obsoleted some old name.
497 Unfortunately, this requires that the tag in question has been loaded
498 into Emacs Lisp's memory."
499 (let ((obsoletethis (intern-soft (semantic-tag-name tag)))
500 (obsoleter nil))
501 ;; This asks if our tag is available in the Emacs name space for querying.
502 (when obsoletethis
503 (mapatoms (lambda (a)
504 (let ((oi (get a 'byte-obsolete-info)))
505 (if (and oi (eq (car oi) obsoletethis))
506 (setq obsoleter a)))))
507 (if obsoleter
508 (format "\n@obsolete{%s,%s}" obsoleter (semantic-tag-name tag))
509 ""))))
511 (define-mode-local-override semantic-documentation-for-tag
512 emacs-lisp-mode (tag &optional nosnarf)
513 "Return the documentation string for TAG.
514 Optional argument NOSNARF is ignored."
515 (let ((d (semantic-tag-docstring tag)))
516 (when (not d)
517 (cond ((semantic-tag-with-position-p tag)
518 ;; Doc isn't in the tag itself. Let's pull it out of the
519 ;; sources.
520 (let ((semantic-elisp-store-documentation-in-tag t))
521 (setq tag (with-current-buffer (semantic-tag-buffer tag)
522 (goto-char (semantic-tag-start tag))
523 (semantic-elisp-use-read
524 ;; concoct a lexical token.
525 (cons (semantic-tag-start tag)
526 (semantic-tag-end tag))))
527 d (semantic-tag-docstring tag))))
528 ;; The tag may be the result of a system search.
529 ((intern-soft (semantic-tag-name tag))
530 (let ((sym (intern-soft (semantic-tag-name tag))))
531 ;; Query into the global table o stuff.
532 (cond ((eq (semantic-tag-class tag) 'function)
533 (setq d (documentation sym)))
535 (setq d (documentation-property
536 sym 'variable-documentation)))))
537 ;; Label it as system doc. perhaps just for debugging
538 ;; purposes.
539 (if d (setq d (concat "System Doc: \n" d)))
543 (when d
544 (concat
545 (substitute-command-keys
546 (if (and (> (length d) 0) (= (aref d 0) ?*))
547 (substring d 1)
549 (semantic-emacs-lisp-overridable-doc tag)
550 (semantic-emacs-lisp-obsoleted-doc tag)))))
552 ;;; Tag Features
554 (define-mode-local-override semantic-tag-include-filename emacs-lisp-mode
555 (tag)
556 "Return the name of the tag with .el appended.
557 If there is a detail, prepend that directory."
558 (let ((name (semantic-tag-name tag))
559 (detail (semantic-tag-get-attribute tag :directory)))
560 (concat (expand-file-name name detail) ".el")))
562 (define-mode-local-override semantic-insert-foreign-tag
563 emacs-lisp-mode (tag)
564 "Insert TAG at point.
565 Attempts a simple prototype for calling or using TAG."
566 (cond ((semantic-tag-of-class-p tag 'function)
567 (insert "(" (semantic-tag-name tag) " )")
568 (forward-char -1))
570 (insert (semantic-tag-name tag)))))
572 (define-mode-local-override semantic-tag-protection
573 emacs-lisp-mode (tag &optional parent)
574 "Return the protection of TAG in PARENT.
575 Override function for `semantic-tag-protection'."
576 (let ((prot (semantic-tag-get-attribute tag :protection)))
577 (cond
578 ;; If a protection is not specified, AND there is a parent
579 ;; data type, then it is public.
580 ((and (not prot) parent) 'public)
581 ((string= prot ":public") 'public)
582 ((string= prot "public") 'public)
583 ((string= prot ":private") 'private)
584 ((string= prot "private") 'private)
585 ((string= prot ":protected") 'protected)
586 ((string= prot "protected") 'protected))))
588 (define-mode-local-override semantic-tag-static-p
589 emacs-lisp-mode (tag &optional parent)
590 "Return non-nil if TAG is static in PARENT class.
591 Overrides `semantic-nonterminal-static'."
592 ;; This can only be true (theoretically) in a class where it is assigned.
593 (semantic-tag-get-attribute tag :static-flag))
595 ;;; Context parsing
597 ;; Emacs lisp is very different from C,C++ which most context parsing
598 ;; functions are written. Support them here.
599 (define-mode-local-override semantic-up-context emacs-lisp-mode
600 (&optional point bounds-type)
601 "Move up one context in an Emacs Lisp function.
602 A Context in many languages is a block with its own local variables.
603 In Emacs, we will move up lists and stop when one starts with one of
604 the following context specifiers:
605 `let', `let*', `defun', `with-slots'
606 Returns non-nil it is not possible to go up a context."
607 (let ((last-up (semantic-up-context-default)))
608 (while
609 (and (not (looking-at
610 "(\\(let\\*?\\|def\\(un\\|method\\|generic\\|\
611 define-mode-overload\\)\
612 \\|with-slots\\)"))
613 (not last-up))
614 (setq last-up (semantic-up-context-default)))
615 last-up))
618 (define-mode-local-override semantic-ctxt-current-function emacs-lisp-mode
619 (&optional point same-as-symbol-return)
620 "Return a string which is the current function being called."
621 (save-excursion
622 (if point (goto-char point) (setq point (point)))
623 ;; (semantic-beginning-of-command)
624 (if (condition-case nil
625 (and (save-excursion
626 (up-list -2)
627 (looking-at "(("))
628 (save-excursion
629 (up-list -3)
630 (looking-at "(let")))
631 (error nil))
632 ;; This is really a let statement, not a function.
634 (let ((fun (condition-case nil
635 (save-excursion
636 (up-list -1)
637 (forward-char 1)
638 (buffer-substring-no-properties
639 (point) (progn (forward-sexp 1)
640 (point))))
641 (error nil))
643 (when fun
644 ;; Do not return FUN IFF the cursor is on FUN.
645 ;; Huh? Thats because if cursor is on fun, it is
646 ;; the current symbol, and not the current function.
647 (if (save-excursion
648 (condition-case nil
649 (progn (forward-sexp -1)
650 (and
651 (looking-at (regexp-quote fun))
652 (<= point (+ (point) (length fun))))
654 (error t)))
655 ;; Go up and try again.
656 same-as-symbol-return
657 ;; We are ok, so get it.
658 (list fun))
663 (define-mode-local-override semantic-get-local-variables emacs-lisp-mode
664 (&optional point)
665 "Return a list of local variables for POINT.
666 Scan backwards from point at each successive function. For all occurrences
667 of `let' or `let*', grab those variable names."
668 (let* ((vars nil)
669 (fn nil))
670 (save-excursion
671 (while (setq fn (car (semantic-ctxt-current-function-emacs-lisp-mode
672 (point) (list t))))
673 (cond
674 ((eq fn t)
675 nil)
676 ((member fn '("let" "let*" "with-slots"))
677 ;; Snarf variables
678 (up-list -1)
679 (forward-char 1)
680 (forward-symbol 1)
681 (skip-chars-forward "* \t\n")
682 (let ((varlst (read (buffer-substring-no-properties
683 (point)
684 (save-excursion
685 (forward-sexp 1)
686 (point))))))
687 (while varlst
688 (let* ((oneelt (car varlst))
689 (name (if (symbolp oneelt)
690 oneelt
691 (car oneelt))))
692 (setq vars (cons (semantic-tag-new-variable
693 (symbol-name name)
694 nil nil)
695 vars)))
696 (setq varlst (cdr varlst)))
698 ((string= fn "lambda")
699 ;; Snart args...
700 (up-list -1)
701 (forward-char 1)
702 (forward-word 1)
703 (skip-chars-forward "* \t\n")
704 (let ((arglst (read (buffer-substring-no-properties
705 (point)
706 (save-excursion
707 (forward-sexp 1)
708 (point))))))
709 (while arglst
710 (let* ((name (car arglst)))
711 (when (/= ?& (aref (symbol-name name) 0))
712 (setq vars (cons (semantic-tag-new-variable
713 (symbol-name name)
714 nil nil)
715 vars))))
716 (setq arglst (cdr arglst)))
719 (up-list -1)))
720 (nreverse vars)))
722 (define-mode-local-override semantic-end-of-command emacs-lisp-mode
724 "Move cursor to the end of the current command.
725 In Emacs Lisp this is easily defined by parenthesis bounding."
726 (condition-case nil
727 (up-list 1)
728 (error nil)))
730 (define-mode-local-override semantic-beginning-of-command emacs-lisp-mode
732 "Move cursor to the beginning of the current command.
733 In Emacs Lisp this is easily defined by parenthesis bounding."
734 (condition-case nil
735 (progn
736 (up-list -1)
737 (forward-char 1))
738 (error nil)))
740 (define-mode-local-override semantic-ctxt-current-symbol emacs-lisp-mode
741 (&optional point)
742 "List the symbol under point."
743 (save-excursion
744 (if point (goto-char point))
745 (require 'thingatpt)
746 (let ((sym (thing-at-point 'symbol)))
747 (if sym (list sym)))
751 (define-mode-local-override semantic-ctxt-current-assignment emacs-lisp-mode
752 (&optional point)
753 "What is the variable being assigned into at POINT?"
754 (save-excursion
755 (if point (goto-char point))
756 (let ((fn (semantic-ctxt-current-function point))
757 (point (point)))
758 ;; We should never get lists from here.
759 (if fn (setq fn (car fn)))
760 (cond
761 ;; SETQ
762 ((and fn (or (string= fn "setq") (string= fn "set")))
763 (save-excursion
764 (condition-case nil
765 (let ((count 0)
766 (lastodd nil)
767 (start nil))
768 (up-list -1)
769 (down-list 1)
770 (forward-sexp 1)
771 ;; Skip over sexp until we pass point.
772 (while (< (point) point)
773 (setq count (1+ count))
774 (forward-comment 1)
775 (setq start (point))
776 (forward-sexp 1)
777 (if (= (% count 2) 1)
778 (setq lastodd
779 (buffer-substring-no-properties start (point))))
781 (if lastodd (list lastodd))
783 (error nil))))
784 ;; This obscure thing finds let statements.
785 ((condition-case nil
786 (and
787 (save-excursion
788 (up-list -2)
789 (looking-at "(("))
790 (save-excursion
791 (up-list -3)
792 (looking-at "(let")))
793 (error nil))
794 (save-excursion
795 (semantic-beginning-of-command)
796 ;; Use func finding code, since it is the same format.
797 (semantic-ctxt-current-symbol)))
799 ;; DEFAULT- nothing
800 (t nil))
803 (define-mode-local-override semantic-ctxt-current-argument emacs-lisp-mode
804 (&optional point)
805 "Return the index into the argument the cursor is in, or nil."
806 (save-excursion
807 (if point (goto-char point))
808 (if (looking-at "\\<\\w")
809 (forward-char 1))
810 (let ((count 0))
811 (while (condition-case nil
812 (progn
813 (forward-sexp -1)
815 (error nil))
816 (setq count (1+ count)))
817 (cond ((= count 0)
819 (t (1- count))))
822 (define-mode-local-override semantic-ctxt-current-class-list emacs-lisp-mode
823 (&optional point)
824 "Return a list of tag classes allowed at POINT.
825 Emacs Lisp knows much more about the class of the tag needed to perform
826 completion than some languages. We distinctly know if we are to be a
827 function name, variable name, or any type of symbol. We could identify
828 fields and such to, but that is for some other day."
829 (save-excursion
830 (if point (goto-char point))
831 (setq point (point))
832 (condition-case nil
833 (let ((count 0))
834 (up-list -1)
835 (forward-char 1)
836 (while (< (point) point)
837 (setq count (1+ count))
838 (forward-sexp 1))
839 (if (= count 1)
840 '(function)
841 '(variable))
843 (error '(variable)))
846 ;;; Formatting
848 (define-mode-local-override semantic-format-tag-abbreviate emacs-lisp-mode
849 (tag &optional parent color)
850 "Return an abbreviated string describing tag."
851 (let ((class (semantic-tag-class tag))
852 (name (semantic-format-tag-name tag parent color))
854 (cond
855 ((eq class 'function)
856 (concat "(" name ")"))
858 (semantic-format-tag-abbreviate-default tag parent color)))))
860 (define-mode-local-override semantic-format-tag-prototype emacs-lisp-mode
861 (tag &optional parent color)
862 "Return a prototype string describing tag.
863 In Emacs Lisp, a prototype for something may start (autoload ...).
864 This is certainly not expected if this is used to display a summary.
865 Make up something else. When we go to write something that needs
866 a real Emacs Lisp prototype, we can fix it then."
867 (let ((class (semantic-tag-class tag))
868 (name (semantic-format-tag-name tag parent color))
870 (cond
871 ((eq class 'function)
872 (let* ((args (semantic-tag-function-arguments tag))
873 (argstr (semantic--format-tag-arguments args
874 #'identity
875 color)))
876 (concat "(" name (if args " " "")
877 argstr
878 ")")))
880 (semantic-format-tag-prototype-default tag parent color)))))
882 (define-mode-local-override semantic-format-tag-concise-prototype emacs-lisp-mode
883 (tag &optional parent color)
884 "Return a concise prototype string describing tag.
885 See `semantic-format-tag-prototype' for Emacs Lisp for more details."
886 (semantic-format-tag-prototype tag parent color))
888 (define-mode-local-override semantic-format-tag-uml-prototype emacs-lisp-mode
889 (tag &optional parent color)
890 "Return a uml prototype string describing tag.
891 See `semantic-format-tag-prototype' for Emacs Lisp for more details."
892 (semantic-format-tag-prototype tag parent color))
894 ;;; IA Commands
896 (define-mode-local-override semantic-ia-insert-tag
897 emacs-lisp-mode (tag)
898 "Insert TAG into the current buffer based on completion."
899 ;; This function by David <de_bb@...> is a tweaked version of the original.
900 (insert (semantic-tag-name tag))
901 (let ((tt (semantic-tag-class tag))
902 (args (semantic-tag-function-arguments tag)))
903 (cond ((eq tt 'function)
904 (if args
905 (insert " ")
906 (insert ")")))
907 (t nil))))
909 ;;; Lexical features and setup
911 (defvar-mode-local emacs-lisp-mode semantic-lex-analyzer
912 'semantic-emacs-lisp-lexer)
914 (defvar-mode-local emacs-lisp-mode semantic--parse-table
915 semantic--elisp-parse-table)
917 (defvar-mode-local emacs-lisp-mode semantic-function-argument-separator
918 " ")
920 (defvar-mode-local emacs-lisp-mode semantic-function-argument-separation-character
921 " ")
923 (defvar-mode-local emacs-lisp-mode semantic-symbol->name-assoc-list
925 (type . "Types")
926 (variable . "Variables")
927 (function . "Defuns")
928 (include . "Requires")
929 (package . "Provides")
932 (defvar-mode-local emacs-lisp-mode imenu-create-index-function
933 'semantic-create-imenu-index)
935 (defvar-mode-local emacs-lisp-mode semantic-stickyfunc-sticky-classes
936 '(function type variable)
937 "Add variables.
938 ELisp variables can be pretty long, so track this one too.")
940 (define-child-mode lisp-mode emacs-lisp-mode
941 "Make `lisp-mode' inherit mode local behavior from `emacs-lisp-mode'.")
943 ;;;###autoload
944 (defun semantic-default-elisp-setup ()
945 "Setup hook function for Emacs Lisp files and Semantic."
946 ;; This is here mostly to get this file loaded when a .el file is
947 ;; loaded into Emacs.
950 (add-hook 'emacs-lisp-mode-hook 'semantic-default-elisp-setup)
952 ;;; LISP MODE
954 ;; @TODO: Lisp supports syntaxes that Emacs Lisp does not.
955 ;; Write a Lisp only parser someday.
957 ;; See this syntax:
958 ;; (defun foo () /#A)
960 (add-hook 'lisp-mode-hook 'semantic-default-elisp-setup)
962 (eval-after-load "semantic/db"
963 '(require 'semantic/db-el)
967 (provide 'semantic/bovine/el)
969 ;; Local variables:
970 ;; generated-autoload-file: "../loaddefs.el"
971 ;; generated-autoload-load-name: "semantic/bovine/el"
972 ;; End:
974 ;;; semantic/bovine/el.el ends here