Hi Klaus,
[...]
> IMHO the alias-like-taggers have still no disadvantage and give
> even more flexibility (reusing taggers defined as lambda...see
> above)
[...]
That argument convinced me. Following is a patch that implements all
that ;-)
I just changed the term "tagger" by "form parser", which is IMO more
accurate.
So now there is two new macros that you should be interested in:
- `semantic-elisp-setup-form-parser' to install a new form parser for
given symbols.
- `semantic-elisp-reuse-form-parser' to reuse an existing form parser
for given symbols.
Typically in ECB you could use:
(semantic-elisp-reuse-form-parser defvar defecb-multicache)
If all is fine with you, I will commit that change.
As usual I appreciated much your help :-)
Thanks!
David
2004-09-21 David Ponce <david@...>
=09* cedet/semantic/bovine/semantic-el.el
=09(semantic-emacs-lisp-lexer): Move.
=09(semantic-elisp-reuse-form-parser): New function.
=09(semantic-elisp-setup-form-parser): New function.
=09(semantic-elisp-use-read): Use it.
=09(eval-and-compile, eval-when-compile, defun, defun*, defsubst)
=09(defmacro, define-overload, defvar, defconst, defcustom)
=09(defface, defimage, autoload, defmethod, defgeneric, defadvice)
=09(defclass, defstruct, define-lex)
=09(define-mode-overload-implementation, define-mode-local-override)
=09(defvar-mode-local, require, provide): Setup form parsers.
Index: semantic-el.el
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /cvsroot/cedet/cedet/semantic/bovine/semantic-el.el,v
retrieving revision 1.29
diff -c -r1.29 semantic-el.el
*** semantic-el.el=0924 Jun 2004 00:22:19 -0000=091.29
--- semantic-el.el=0921 Sep 2004 08:39:49 -0000
***************
*** 35,40 ****
--- 35,61 ----
)
=20
;;; Code:
+ =0C
+ ;;; Lexer
+ ;;
+ (define-lex semantic-emacs-lisp-lexer
+ "A simple lexical analyzer for Emacs Lisp.
+ This lexer ignores comments and whitespace, and will return
+ syntax as specified by the syntax table."
+ semantic-lex-ignore-whitespace
+ semantic-lex-ignore-newline
+ semantic-lex-number
+ semantic-lex-symbol-or-keyword
+ semantic-lex-charquote
+ semantic-lex-paren-or-list
+ semantic-lex-close-paren
+ semantic-lex-string
+ semantic-lex-ignore-comments
+ semantic-lex-punctuation
+ semantic-lex-default-action)
+ =0C
+ ;;; Parser
+ ;;
(defvar semantic--elisp-parse-table
`((bovine-toplevel
(semantic-list
***************
*** 118,293 ****
(when semantic-elisp-store-documentation-in-tag
(semantic-elisp-form-to-doc-string str)))
=20
(defun semantic-elisp-use-read (sl)
"Use `read' on the semantic list SL.
Return a bovination list to use."
! (let* ((rt (read (buffer-substring (car sl) (cdr sl)))) ; read text
! =09 (ts (car rt)) ; type symbol
! =09 (tss (nth 1 rt))
! =09 (ss (if (not (listp tss)) tss
! =09 (if (eq (car tss) 'quote)
! =09=09 (nth 1 tss)
! =09=09 (car tss))))
! =09 (sn (format "%S" ss))
! =09 )
(cond
! ((listp ts)
! ;; If the first elt is a list, then it is some arbitrary code.
! (semantic-tag-new-code "anonymous" nil))
! ((or (eq ts 'eval-and-compile)
! =09 (eq ts 'eval-when-compile))
! ;; Eval and compile can be wrapped around definitions, such as in
! ;; eieio.el, so splice it's parts back into the main list.
! (condition-case foo
! =09 (semantic-parse-region (car sl) (cdr sl) nil 1)
! =09(error (message "MUNGE: %S" foo)
! =09 nil))
)
! ((or (eq ts 'defvar)
! =09 (eq ts 'defconst)
! =09 (eq ts 'defcustom)
! =09 (eq ts 'defface)
! =09 (eq ts 'defimage))
! (let ((doc (semantic-elisp-form-to-doc-string (nth 3 rt))))
! =09;; Variables and constants
! =09(semantic-tag-new-variable
! =09 sn nil (nth 2 rt)
! =09 :user-visible-flag (and doc
! =09=09=09 (> (length doc) 0)
! =09=09=09 (=3D (aref doc 0) ?*))
! =09 :constant-flag (if (eq ts 'defconst) t nil)
! =09 :documentation (semantic-elisp-do-doc doc)
! =09 )
! =09))
! ((or (eq ts 'defun)
! =09 (eq ts 'defun*)
! =09 (eq ts 'defsubst)
! =09 (eq ts 'defmacro)
! =09 (eq ts 'define-overload)
! =09 )
! ;; functions and macros
(semantic-tag-new-function
! sn nil (semantic-elisp-desymbolify (nth 2 rt))
! :user-visible-flag (equal (car-safe (nth 4 rt)) 'interactive)
! :documentation (semantic-elisp-do-doc (nth 3 rt))
! :overloadable (eq ts 'define-overload)
! )
! )
! ((eq ts 'autoload)
(semantic-tag-new-function
! (format "%S" (car (cdr (car (cdr rt)))))
nil nil
! :user-visible-flag (and (nth 4 rt)
! =09=09=09 (not (eq (nth 4 rt) 'nil)))
:prototype-flag t
! :documentation (semantic-elisp-do-doc (nth 3 rt)))
! )
! ((or (eq ts 'defmethod)
! =09 (eq ts 'defgeneric))
! ;; methods
! (let* ((a2 (nth 2 rt))
! =09 (a3 (nth 3 rt))
! =09 (args (if (listp a2) a2 a3))
! =09 (doc (nth (if (listp a2) 3 4) rt)))
! =09(semantic-tag-new-function
! =09 sn nil
! =09 (if (listp (car args))
! =09 (cons (symbol-name (car (car args)))
! =09=09 (semantic-elisp-desymbolify (cdr args)))
! =09 (semantic-elisp-desymbolify (cdr args)))
! =09 :parent (symbol-name
! =09=09 (if (listp (car args)) (car (cdr (car args)))))
! =09 :documentation (semantic-elisp-do-doc doc)
! =09 )))
! ((eq ts 'defadvice)
! ;; Advice
(semantic-tag-new-function
! sn nil (semantic-elisp-desymbolify (nth 2 rt))
! )
! ;; (nth 3 rt) doc string
! )
! ((eq ts 'defclass)
! ;; classes
! (let ((docpart (nthcdr 4 rt)))
=09(semantic-tag-new-type
! =09 sn "class"
! =09 (semantic-elisp-clos-args-to-semantic (nth 3 rt))
! =09 (semantic-elisp-desymbolify (nth 2 rt))
=09 :typemodifiers (semantic-elisp-desymbolify
! =09=09=09 (if (not (stringp docpart))
! =09=09=09 docpart))
! =09 :documentation
! =09 (semantic-elisp-do-doc
! =09 (if (stringp (car docpart))
! =09 (car docpart)
! =09 (car (cdr (member :documentation docpart)))))
! =09 )
! =09))
! ((eq ts 'defstruct)
! ;; structs
(semantic-tag-new-type
! sn "struct" (semantic-elisp-desymbolify (nthcdr 2 rt))
! nil ;(semantic-elisp-desymbolify (nth 2 rt))
! )
! ;; (nth 4 rt) doc string
! )
! ;; Now about a few Semantic specials?
! ((eq ts 'define-lex)
(semantic-tag-new-function
! sn nil nil
:lexical-analyzer-flag t
! :documentation (semantic-elisp-do-doc (nth 2 rt))
! )
! )
! ((memq ts '( define-mode-overload-implementation
! define-mode-local-override ))
! (let ((args (nth 3 rt))
! =09 )
=09(semantic-tag-new-function
! =09 sn nil
! =09 (when (listp args) (semantic-elisp-desymbolify args))
=09 :override-function-flag t
! =09 :parent (format "%S" (nth 2 rt))
! =09 :documentation (semantic-elisp-do-doc (nth 4 rt))
! =09 )
! =09))
! ((eq ts 'defvar-mode-local)
(semantic-tag-new-variable
! (format "%S" (nth 2 rt)) nil
! (nth 3 rt) ; default value
:override-variable-flag t
! :parent sn
! :documentation (semantic-elisp-do-doc (nth 4 rt))
! )
! )
! ;; Now for other stuff
! ((eq ts 'require)
! (semantic-tag-new-include
! sn nil :directory (nth 2 rt)))
! ((eq ts 'provide)
! (semantic-tag-new-package
! sn (nth 3 rt)))
! (t
! ;; Other stuff
! (semantic-tag-new-code (symbol-name ts) nil)
! ))))
=20
! (define-lex semantic-emacs-lisp-lexer
! "A simple lexical analyzer for Emacs Lisp.
! This lexer ignores comments and whitespace, and will return
! syntax as specified by the syntax table."
! semantic-lex-ignore-whitespace
! semantic-lex-ignore-newline
! semantic-lex-number
! semantic-lex-symbol-or-keyword
! semantic-lex-charquote
! semantic-lex-paren-or-list
! semantic-lex-close-paren
! semantic-lex-string
! semantic-lex-ignore-comments
! semantic-lex-punctuation
! semantic-lex-default-action)
=20
(define-mode-local-override semantic-find-dependency
emacs-lisp-mode (tag)
"Find the file BUFFER depends on described by TAG."
--- 139,376 ----
(when semantic-elisp-store-documentation-in-tag
(semantic-elisp-form-to-doc-string str)))
=20
+ (defmacro semantic-elisp-setup-form-parser (parser &rest symbols)
+ "Install the function PARSER as the form parser for SYMBOLS.
+ SYMBOLS is a list of symbols identifying the forms to parse.
+ PARSER is called on every forms whose first element (car FORM) is
+ found in SYMBOLS. It is passed the parameters FORM, START, END,
+ where:
+=20
+ - FORM is an Elisp form read from the current buffer.
+ - START and END are the beginning and end location of the
+ corresponding data in the current buffer."
+ (let ((sym (make-symbol "sym")))
+ `(dolist (,sym ',symbols)
+ (put ,sym 'semantic-elisp-form-parser #',parser))))
+ (put 'semantic-elisp-setup-form-parser 'lisp-indent-function 1)
+=20
+ (defmacro semantic-elisp-reuse-form-parser (symbol &rest symbols)
+ "Reuse the form parser of SYMBOL for forms identified by SYMBOLS.
+ See also `semantic-elisp-setup-form-parser'."
+ (let ((parser (make-symbol "parser"))
+ (sym (make-symbol "sym")))
+ `(let ((,parser (get ',symbol 'semantic-elisp-form-parser)))
+ (or ,parser
+ (signal 'wrong-type-argument
+ '(semantic-elisp-form-parser ,symbol)))
+ (dolist (,sym ',symbols)
+ (put ,sym 'semantic-elisp-form-parser ,parser)))))
+=20
(defun semantic-elisp-use-read (sl)
"Use `read' on the semantic list SL.
Return a bovination list to use."
! (let* ((start (car sl))
! (end (cdr sl))
! (form (read (buffer-substring start end))))
(cond
! ;; If the first elt is a list, then it is some arbitrary code.
! ((listp (car form))
! (semantic-tag-new-code "anonymous" nil)
)
! ;; A special form parser is provided, use it.
! ((and (car form) (symbolp (car form))
! (get (car form) 'semantic-elisp-form-parser))
! (funcall (get (car form) 'semantic-elisp-form-parser)
! form start end))
! ;; Produce a generic code tag by default.
! (t
! (semantic-tag-new-code (format "%S" (car form)) nil)
! ))))
! =0C
! ;;; Form parsers
! ;;
! (semantic-elisp-setup-form-parser
! (lambda (form start end)
! (condition-case foo
! (semantic-parse-region start end nil 1)
! (error (message "MUNGE: %S" foo)
! nil)))
! eval-and-compile
! eval-when-compile
! )
!=20
! (semantic-elisp-setup-form-parser
! (lambda (form start end)
(semantic-tag-new-function
! (symbol-name (nth 1 form))
! nil
! (semantic-elisp-desymbolify (nth 2 form))
! :user-visible-flag (eq (car-safe (nth 4 form)) 'interactive)
! :documentation (semantic-elisp-do-doc (nth 3 form))
! :overloadable (eq (car form) 'define-overload)
! ))
! defun
! defun*
! defsubst
! defmacro
! define-overload
! )
!=20
! (semantic-elisp-setup-form-parser
! (lambda (form start end)
! (let ((doc (semantic-elisp-form-to-doc-string (nth 3 form))))
! (semantic-tag-new-variable
! (symbol-name (nth 1 form))
! nil
! (nth 2 form)
! :user-visible-flag (and doc
! (> (length doc) 0)
! (=3D (aref doc 0) ?*))
! :constant-flag (eq (car form) 'defconst)
! :documentation (semantic-elisp-do-doc doc)
! )))
! defvar
! defconst
! defcustom
! defface
! defimage
! )
!=20
! (semantic-elisp-setup-form-parser
! (lambda (form start end)
(semantic-tag-new-function
! (symbol-name (cadr (cadr form)))
nil nil
! :user-visible-flag (and (nth 4 form)
! (not (eq (nth 4 form) 'nil)))
:prototype-flag t
! :documentation (semantic-elisp-do-doc (nth 3 form))))
! autoload
! )
!=20
! (semantic-elisp-setup-form-parser
! (lambda (form start end)
! (let* ((a2 (nth 2 form))
! (a3 (nth 3 form))
! (args (if (listp a2) a2 a3))
! (doc (nth (if (listp a2) 3 4) form)))
! (semantic-tag-new-function
! (symbol-name (nth 1 form))
! nil
! (if (listp (car args))
! (cons (symbol-name (caar args))
! (semantic-elisp-desymbolify (cdr args)))
! (semantic-elisp-desymbolify (cdr args)))
! :parent (symbol-name (if (listp (car args)) (cadr (car args))))
! :documentation (semantic-elisp-do-doc doc)
! )))
! defmethod
! defgeneric
! )
!=20
! (semantic-elisp-setup-form-parser
! (lambda (form start end)
(semantic-tag-new-function
! (symbol-name (nth 1 form))
! nil
! (semantic-elisp-desymbolify (nth 2 form))
! ))
! defadvice
! )
!=20
! (semantic-elisp-setup-form-parser
! (lambda (form start end)
! (let ((docpart (nthcdr 4 form)))
=09(semantic-tag-new-type
! =09 (symbol-name (nth 1 form))
! "class"
! =09 (semantic-elisp-clos-args-to-semantic (nth 3 form))
! =09 (semantic-elisp-desymbolify (nth 2 form))
=09 :typemodifiers (semantic-elisp-desymbolify
! =09=09=09 (unless (stringp (car docpart)) docpart))
! =09 :documentation (semantic-elisp-do-doc
! (if (stringp (car docpart))
! (car docpart)
! (cadr (member :documentation docpart))))
! =09 )))
! defclass
! )
!=20
! (semantic-elisp-setup-form-parser
! (lambda (form start end)
(semantic-tag-new-type
! (symbol-name (car (nth 1 form)))
! "struct"
! (semantic-elisp-desymbolify (nthcdr 2 form))
! nil ;(semantic-elisp-desymbolify (nth 2 form))
! ))
! defstruct
! )
!=20
! (semantic-elisp-setup-form-parser
! (lambda (form start end)
(semantic-tag-new-function
! (symbol-name (nth 1 form))
! nil nil
:lexical-analyzer-flag t
! :documentation (semantic-elisp-do-doc (nth 2 form))
! ))
! define-lex
! )
!=20
! (semantic-elisp-setup-form-parser
! (lambda (form start end)
! (let ((args (nth 3 form)))
=09(semantic-tag-new-function
! =09 (symbol-name (nth 1 form))
! nil
! =09 (and (listp args) (semantic-elisp-desymbolify args))
=09 :override-function-flag t
! =09 :parent (symbol-name (nth 2 form))
! =09 :documentation (semantic-elisp-do-doc (nth 4 form))
! =09 )))
! define-mode-overload-implementation
! define-mode-local-override
! )
!=20
! (semantic-elisp-setup-form-parser
! (lambda (form start end)
(semantic-tag-new-variable
! (symbol-name (nth 2 form))
! nil
! (nth 3 form) ; default value
:override-variable-flag t
! :parent (symbol-name (nth 1 form))
! :documentation (semantic-elisp-do-doc (nth 4 form))
! ))
! defvar-mode-local
! )
=20
! (semantic-elisp-setup-form-parser
! (lambda (form start end)
! (let ((name (nth 1 form)))
! (semantic-tag-new-include
! (symbol-name (if (eq (car-safe name) 'quote)
! (nth 1 name)
! name))
! nil
! :directory (nth 2 form))))
! require
! )
=20
+ (semantic-elisp-setup-form-parser
+ (lambda (form start end)
+ (let ((name (nth 1 form)))
+ (semantic-tag-new-package
+ (symbol-name (if (eq (car-safe name) 'quote)
+ (nth 1 name)
+ name))
+ (nth 3 form))))
+ provide
+ )
+ =0C
+ ;;; Mode setup
+ ;;
(define-mode-local-override semantic-find-dependency
emacs-lisp-mode (tag)
"Find the file BUFFER depends on described by TAG."
***************
*** 515,522 ****
=09 (point (point)))
;; We should never get lists from here.
(if fn (setq fn (car fn)))
! (cond=20
! ;; SETQ=20
((and fn (or (string=3D fn "setq") (string=3D fn "set")))
=09(save-excursion
=09 (condition-case nil
--- 598,605 ----
=09 (point (point)))
;; We should never get lists from here.
(if fn (setq fn (car fn)))
! (cond
! ;; SETQ
((and fn (or (string=3D fn "setq") (string=3D fn "set")))
=09(save-excursion
=09 (condition-case nil
***************
*** 541,547 ****
=09 (error nil))))
;; This obscure thing finds let statements.
((condition-case nil
! =09 (and=20
=09 (save-excursion
=09 (up-list -2)
=09 (looking-at "(("))
--- 624,630 ----
=09 (error nil))))
;; This obscure thing finds let statements.
((condition-case nil
! =09 (and
=09 (save-excursion
=09 (up-list -2)
=09 (looking-at "(("))
***************
*** 553,559 ****
=09 (semantic-beginning-of-command)
=09 ;; Use func finding code, since it is the same format.
=09 (semantic-ctxt-current-symbol)))
! ;;=20
;; DEFAULT- nothing
(t nil))
)))
--- 636,642 ----
=09 (semantic-beginning-of-command)
=09 ;; Use func finding code, since it is the same format.
=09 (semantic-ctxt-current-symbol)))
! ;;
;; DEFAULT- nothing
(t nil))
)))
***************
*** 620,626 ****
(concat "(" name ")"))
(t
(semantic-format-tag-abbreviate-default tag parent color)))))
! =20
(define-mode-local-override semantic-format-tag-prototype emacs-lisp-mode
(tag &optional parent color)
"Return a prototype string describing tag.
--- 703,709 ----
(concat "(" name ")"))
(t
(semantic-format-tag-abbreviate-default tag parent color)))))
!=20
(define-mode-local-override semantic-format-tag-prototype emacs-lisp-mode
(tag &optional parent color)
"Return a prototype string describing tag.
***************
*** 648,660 ****
"Return a concise prototype string describing tag.
See `semantic-format-tag-prototype' for Emacs Lisp for more details."
(semantic-format-tag-prototype tag parent color))
! =20
(define-mode-local-override semantic-format-tag-uml-prototype emacs-lisp-=
mode
(tag &optional parent color)
"Return a uml prototype string describing tag.
See `semantic-format-tag-prototype' for Emacs Lisp for more details."
(semantic-format-tag-prototype tag parent color))
! =20
(defvar-mode-local emacs-lisp-mode semantic-lex-analyzer
'semantic-emacs-lisp-lexer)
=20
--- 731,743 ----
"Return a concise prototype string describing tag.
See `semantic-format-tag-prototype' for Emacs Lisp for more details."
(semantic-format-tag-prototype tag parent color))
!=20
(define-mode-local-override semantic-format-tag-uml-prototype emacs-lisp-=
mode
(tag &optional parent color)
"Return a uml prototype string describing tag.
See `semantic-format-tag-prototype' for Emacs Lisp for more details."
(semantic-format-tag-prototype tag parent color))
!=20
(defvar-mode-local emacs-lisp-mode semantic-lex-analyzer
'semantic-emacs-lisp-lexer)
=20
|