diff options
Diffstat (limited to 'lisp/cedet/semantic/tag.el')
| -rw-r--r-- | lisp/cedet/semantic/tag.el | 80 |
1 files changed, 36 insertions, 44 deletions
diff --git a/lisp/cedet/semantic/tag.el b/lisp/cedet/semantic/tag.el index 85defe4f2c0..b6386d71db0 100644 --- a/lisp/cedet/semantic/tag.el +++ b/lisp/cedet/semantic/tag.el @@ -1,4 +1,4 @@ -;;; semantic/tag.el --- tag creation and access +;;; semantic/tag.el --- Tag creation and access -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2005, 2007-2021 Free Software Foundation, Inc. @@ -229,6 +229,28 @@ See also the function `semantic-ctxt-current-mode'." (require 'semantic/ctxt) (semantic-ctxt-current-mode))))) +;; Is this function still necessary? +(defun semantic-tag-make-plist (args) + "Create a property list with ARGS. +Args is a property list of the form (KEY1 VALUE1 ... KEYN VALUEN). +Where KEY is a symbol, and VALUE is the value for that symbol. +The return value will be a new property list, with these KEY/VALUE +pairs eliminated: + + - KEY associated to nil VALUE. + - KEY associated to an empty string VALUE. + - KEY associated to a zero VALUE." + (let (plist key val) + (while args + (setq key (car args) + val (nth 1 args) + args (nthcdr 2 args)) + (or (member val '("" nil)) + (and (numberp val) (zerop val)) + (setq plist (cons key (cons val plist))))) + ;; It is not useful to reverse the new plist. + plist)) + (defsubst semantic--tag-attributes-cdr (tag) "Return the cons cell whose car is the ATTRIBUTES part of TAG. That function is for internal use only." @@ -441,28 +463,6 @@ class to store those methods." ;;; Tag creation ;; -;; Is this function still necessary? -(defun semantic-tag-make-plist (args) - "Create a property list with ARGS. -Args is a property list of the form (KEY1 VALUE1 ... KEYN VALUEN). -Where KEY is a symbol, and VALUE is the value for that symbol. -The return value will be a new property list, with these KEY/VALUE -pairs eliminated: - - - KEY associated to nil VALUE. - - KEY associated to an empty string VALUE. - - KEY associated to a zero VALUE." - (let (plist key val) - (while args - (setq key (car args) - val (nth 1 args) - args (nthcdr 2 args)) - (or (member val '("" nil)) - (and (numberp val) (zerop val)) - (setq plist (cons key (cons val plist))))) - ;; It is not useful to reverse the new plist. - plist)) - (defsubst semantic-tag (name class &rest attributes) "Create a generic semantic tag. NAME is a string representing the name of this tag. @@ -478,7 +478,7 @@ TYPE is a string or semantic tag representing the type of this variable. Optional DEFAULT-VALUE is a string representing the default value of this variable. ATTRIBUTES is a list of additional attributes belonging to this tag." - (apply 'semantic-tag name 'variable + (apply #'semantic-tag name 'variable :type type :default-value default-value attributes)) @@ -490,7 +490,7 @@ TYPE is a string or semantic tag representing the type of this function. ARG-LIST is a list of strings or semantic tags representing the arguments of this function. ATTRIBUTES is a list of additional attributes belonging to this tag." - (apply 'semantic-tag name 'function + (apply #'semantic-tag name 'function :type type :arguments arg-list attributes)) @@ -513,7 +513,7 @@ This slot can be interesting because the form: is a valid parent where there is no explicit parent, and only an interface. ATTRIBUTES is a list of additional attributes belonging to this tag." - (apply 'semantic-tag name 'type + (apply #'semantic-tag name 'type :type type :members members :superclasses (car parents) @@ -526,7 +526,7 @@ NAME is the name of this include. SYSTEM-FLAG represents that we were able to identify this include as belonging to the system, as opposed to belonging to the local project. ATTRIBUTES is a list of additional attributes belonging to this tag." - (apply 'semantic-tag name 'include + (apply #'semantic-tag name 'include :system-flag system-flag attributes)) @@ -536,7 +536,7 @@ NAME is the name of this package. DETAIL is extra information about this package, such as a location where it can be found. ATTRIBUTES is a list of additional attributes belonging to this tag." - (apply 'semantic-tag name 'package + (apply #'semantic-tag name 'package :detail detail attributes)) @@ -545,7 +545,7 @@ ATTRIBUTES is a list of additional attributes belonging to this tag." NAME is a name for this code. DETAIL is extra information about the code. ATTRIBUTES is a list of additional attributes belonging to this tag." - (apply 'semantic-tag name 'code + (apply #'semantic-tag name 'code :detail detail attributes)) @@ -685,7 +685,7 @@ FILTER takes TAG as an argument, and should return a `semantic-tag'. It is safe for FILTER to modify the input tag and return it." (when (not filter) (setq filter 'identity)) (when (not (semantic-tag-p tag)) - (signal 'wrong-type-argument (list tag 'semantic-tag-p))) + (signal 'wrong-type-argument (list tag #'semantic-tag-p))) (let ((ol (semantic-tag-overlay tag)) (fn (semantic-tag-file-name tag))) (funcall filter (list (semantic-tag-name tag) @@ -937,7 +937,7 @@ NAME is a name for this alias. META-TAG-CLASS is the class of the tag this tag is an alias. VALUE is the aliased definition. ATTRIBUTES is a list of additional attributes belonging to this tag." - (apply 'semantic-tag name 'alias + (apply #'semantic-tag name 'alias :aliasclass meta-tag-class :definition value attributes)) @@ -1038,25 +1038,17 @@ See `semantic-tag-bounds'." (defmacro semantic-with-buffer-narrowed-to-current-tag (&rest body) "Execute BODY with the buffer narrowed to the current tag." + (declare (indent 0) (debug t)) `(save-restriction (semantic-narrow-to-tag (semantic-current-tag)) ,@body)) -(put 'semantic-with-buffer-narrowed-to-current-tag 'lisp-indent-function 0) -(add-hook 'edebug-setup-hook - (lambda () - (def-edebug-spec semantic-with-buffer-narrowed-to-current-tag - (def-body)))) (defmacro semantic-with-buffer-narrowed-to-tag (tag &rest body) "Narrow to TAG, and execute BODY." + (declare (indent 1) (debug t)) `(save-restriction (semantic-narrow-to-tag ,tag) ,@body)) -(put 'semantic-with-buffer-narrowed-to-tag 'lisp-indent-function 1) -(add-hook 'edebug-setup-hook - (lambda () - (def-edebug-spec semantic-with-buffer-narrowed-to-tag - (def-body)))) ;;; Tag Hooks ;; @@ -1101,7 +1093,7 @@ For any given situation, additional ARGS may be passed." (condition-case err ;; If a hook bombs, ignore it! Usually this is tied into ;; some sort of critical system. - (apply 'run-hook-with-args 'semantic--tag-hook-value arglist) + (apply #'run-hook-with-args 'semantic--tag-hook-value arglist) (error (message "Error: %S" err))))) ;;; Tags and Overlays @@ -1112,7 +1104,7 @@ For any given situation, additional ARGS may be passed." (defsubst semantic--tag-unlink-list-from-buffer (tags) "Convert TAGS from using an overlay to using an overlay proxy. This function is for internal use only." - (mapcar 'semantic--tag-unlink-from-buffer tags)) + (mapcar #'semantic--tag-unlink-from-buffer tags)) (defun semantic--tag-unlink-from-buffer (tag) "Convert TAG from using an overlay to using an overlay proxy. @@ -1133,7 +1125,7 @@ This function is for internal use only." (defsubst semantic--tag-link-list-to-buffer (tags) "Convert TAGS from using an overlay proxy to using an overlay. This function is for internal use only." - (mapc 'semantic--tag-link-to-buffer tags)) + (mapc #'semantic--tag-link-to-buffer tags)) (defun semantic--tag-link-to-buffer (tag) "Convert TAG from using an overlay proxy to using an overlay. |