diff options
Diffstat (limited to 'lisp/cedet/semantic')
75 files changed, 1584 insertions, 1725 deletions
diff --git a/lisp/cedet/semantic/analyze.el b/lisp/cedet/semantic/analyze.el index c0a054dafc3..1a4be11c789 100644 --- a/lisp/cedet/semantic/analyze.el +++ b/lisp/cedet/semantic/analyze.el @@ -1,4 +1,4 @@ -;;; semantic/analyze.el --- Analyze semantic tags against local context +;;; semantic/analyze.el --- Analyze semantic tags against local context -*- lexical-binding: t; -*- ;; Copyright (C) 2000-2005, 2007-2021 Free Software Foundation, Inc. @@ -167,7 +167,7 @@ of the parent function.") ;; Simple methods against the context classes. ;; (cl-defmethod semantic-analyze-type-constraint - ((context semantic-analyze-context) &optional desired-type) + ((_context semantic-analyze-context) &optional desired-type) "Return a type constraint for completing :prefix in CONTEXT. Optional argument DESIRED-TYPE may be a non-type tag to analyze." (when (semantic-tag-p desired-type) @@ -344,8 +344,8 @@ This function knows of flags: (setq tagtype (cons tmptype tagtype)) (when miniscope (let ((rawscope - (apply 'append - (mapcar 'semantic-tag-type-members tagtype)))) + (apply #'append + (mapcar #'semantic-tag-type-members tagtype)))) (oset miniscope fullscope rawscope))) ) (setq s (cdr s))) @@ -437,6 +437,8 @@ to provide a large number of non-cached analysis for filtering symbols." (:override))) ) +(defvar semantic--prefixtypes) + (defun semantic-analyze-current-symbol-default (analyzehookfcn position) "Call ANALYZEHOOKFCN on the analyzed symbol at POSITION." (let* ((semantic-analyze-error-stack nil) @@ -453,14 +455,14 @@ to provide a large number of non-cached analysis for filtering symbols." (catch 'unfindable ;; If debug on error is on, allow debugging in this fcn. (setq prefix (semantic-analyze-find-tag-sequence - prefix scope 'prefixtypes 'unfindable))) + prefix scope 'semantic--prefixtypes 'unfindable))) ;; Debug on error is off. Capture errors and move on (condition-case err ;; NOTE: This line is duplicated in ;; semantic-analyzer-debug-global-symbol ;; You will need to update both places. (setq prefix (semantic-analyze-find-tag-sequence - prefix scope 'prefixtypes)) + prefix scope 'semantic--prefixtypes)) (error (semantic-analyze-push-error err)))) ;;(message "Analysis took %.2f sec" (semantic-elapsed-time LLstart nil)) @@ -531,7 +533,7 @@ Returns an object based on symbol `semantic-analyze-context'." (bounds (nth 2 prefixandbounds)) ;; @todo - vv too early to really know this answer! vv (prefixclass (semantic-ctxt-current-class-list)) - (prefixtypes nil) + (semantic--prefixtypes nil) (scope (semantic-calculate-scope position)) (function nil) (fntag nil) @@ -611,13 +613,13 @@ Returns an object based on symbol `semantic-analyze-context'." (if debug-on-error (catch 'unfindable (setq prefix (semantic-analyze-find-tag-sequence - prefix scope 'prefixtypes 'unfindable)) + prefix scope 'semantic--prefixtypes 'unfindable)) ;; If there's an alias, dereference it and analyze ;; sequence again. (when (setq newseq (semantic-analyze-dereference-alias prefix)) (setq prefix (semantic-analyze-find-tag-sequence - newseq scope 'prefixtypes 'unfindable)))) + newseq scope 'semantic--prefixtypes 'unfindable)))) ;; Debug on error is off. Capture errors and move on (condition-case err ;; NOTE: This line is duplicated in @@ -625,11 +627,11 @@ Returns an object based on symbol `semantic-analyze-context'." ;; You will need to update both places. (progn (setq prefix (semantic-analyze-find-tag-sequence - prefix scope 'prefixtypes)) + prefix scope 'semantic--prefixtypes)) (when (setq newseq (semantic-analyze-dereference-alias prefix)) (setq prefix (semantic-analyze-find-tag-sequence - newseq scope 'prefixtypes)))) + newseq scope 'semantic--prefixtypes)))) (error (semantic-analyze-push-error err)))) ) @@ -650,7 +652,7 @@ Returns an object based on symbol `semantic-analyze-context'." :prefix prefix :prefixclass prefixclass :bounds bounds - :prefixtypes prefixtypes + :prefixtypes semantic--prefixtypes :errors semantic-analyze-error-stack))) ;; No function, try assignment @@ -670,7 +672,7 @@ Returns an object based on symbol `semantic-analyze-context'." :bounds bounds :prefix prefix :prefixclass prefixclass - :prefixtypes prefixtypes + :prefixtypes semantic--prefixtypes :errors semantic-analyze-error-stack))) ;; TODO: Identify return value condition. @@ -686,7 +688,7 @@ Returns an object based on symbol `semantic-analyze-context'." :bounds bounds :prefix prefix :prefixclass prefixclass - :prefixtypes prefixtypes + :prefixtypes semantic--prefixtypes :errors semantic-analyze-error-stack))) (t (setq context-return nil)) @@ -750,7 +752,7 @@ Some useful functions are found in `semantic-format-tag-functions'." :group 'semantic :type semantic-format-tag-custom-list) -(defun semantic-analyze-princ-sequence (sequence &optional prefix buff) +(defun semantic-analyze-princ-sequence (sequence &optional prefix _buff) "Send the tag SEQUENCE to standard out. Use PREFIX as a label. Use BUFF as a source of override methods." diff --git a/lisp/cedet/semantic/analyze/complete.el b/lisp/cedet/semantic/analyze/complete.el index e8139ab1aea..ccf405d62e2 100644 --- a/lisp/cedet/semantic/analyze/complete.el +++ b/lisp/cedet/semantic/analyze/complete.el @@ -1,4 +1,4 @@ -;;; semantic/analyze/complete.el --- Smart Completions +;;; semantic/analyze/complete.el --- Smart Completions -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. @@ -45,7 +45,7 @@ "For the tag TYPE, return any constant symbols of TYPE. Used as options when completing.") -(defun semantic-analyze-type-constants-default (type) +(defun semantic-analyze-type-constants-default (_type) "Do nothing with TYPE." nil) @@ -54,7 +54,7 @@ Used as options when completing.") (let ((origc tags)) ;; Accept only tags that are of the datatype specified by ;; the desired classes. - (setq tags (apply 'nconc ;; All input lists are permutable. + (setq tags (apply #'nconc ;; All input lists are permutable. (mapcar (lambda (class) (semantic-find-tags-by-class class origc)) classlist))) @@ -109,6 +109,8 @@ in a buffer." (when (called-interactively-p 'any) (error "Buffer was not parsed by Semantic.")))) +(defvar semantic--prefixtypes) + (defun semantic-analyze-possible-completions-default (context &optional flags) "Default method for producing smart completions. Argument CONTEXT is an object specifying the locally derived context. @@ -121,14 +123,14 @@ FLAGS can be any number of: (desired-type (semantic-analyze-type-constraint a)) (desired-class (oref a prefixclass)) (prefix (oref a prefix)) - (prefixtypes (oref a prefixtypes)) + (semantic--prefixtypes (oref a prefixtypes)) (completetext nil) (completetexttype nil) (scope (oref a scope)) (localvar (when scope (oref scope localvar))) (origc nil) (c nil) - (any nil) + ;; (any nil) (do-typeconstraint (not (memq 'no-tc flags))) (do-longprefix (not (memq 'no-longprefix flags))) (do-unique (not (memq 'no-unique flags))) @@ -138,7 +140,7 @@ FLAGS can be any number of: ;; If we are not doing the long prefix, shorten all the key ;; elements. (setq prefix (list (car (reverse prefix))) - prefixtypes nil)) + semantic--prefixtypes nil)) ;; Calculate what our prefix string is so that we can ;; find all our matching text. @@ -155,7 +157,7 @@ FLAGS can be any number of: ;; The prefixtypes should always be at least 1 less than ;; the prefix since the type is never looked up for the last ;; item when calculating a sequence. - (setq completetexttype (car (reverse prefixtypes))) + (setq completetexttype (car (reverse semantic--prefixtypes))) (when (or (not completetexttype) (not (and (semantic-tag-p completetexttype) (eq (semantic-tag-class completetexttype) 'type)))) diff --git a/lisp/cedet/semantic/analyze/debug.el b/lisp/cedet/semantic/analyze/debug.el index 4947368757e..69b3b9c8328 100644 --- a/lisp/cedet/semantic/analyze/debug.el +++ b/lisp/cedet/semantic/analyze/debug.el @@ -1,6 +1,6 @@ -;;; semantic/analyze/debug.el --- Debug the analyzer +;;; semantic/analyze/debug.el --- Debug the analyzer -*- lexical-binding: t; -*- -;;; Copyright (C) 2008-2021 Free Software Foundation, Inc. +;; Copyright (C) 2008-2021 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> @@ -109,11 +109,11 @@ Argument COMP are possible completions here." (condition-case err (with-current-buffer origbuf (let* ((position (or (cdr-safe (oref ctxt bounds)) (point))) - (prefixtypes nil) ; Used as type return + ;; (semantic--prefixtypes nil) ; Used as type return (scope (semantic-calculate-scope position)) ) (semantic-analyze-find-tag-sequence - (list prefix "") scope 'prefixtypes) + (list prefix "") scope) ;; 'semantic--prefixtypes ) ) (error (setq finderr err))) @@ -149,7 +149,7 @@ path was setup incorrectly.\n") (semantic-analyzer-debug-add-buttons) )) -(defun semantic-analyzer-debug-missing-datatype (ctxt idx comp) +(defun semantic-analyzer-debug-missing-datatype (ctxt idx _comp) "Debug why we can't find a datatype entry for CTXT prefix at IDX. Argument COMP are possible completions here." (let* ((prefixitem (nth idx (oref ctxt prefix))) @@ -593,19 +593,20 @@ Look for key expressions, and add push-buttons near them." (setq-local semantic-analyzer-debug-orig orig-buffer) ;; First, add do-in buttons to recommendations. (while (re-search-forward "^\\s-*M-x \\(\\(\\w\\|\\s_\\)+\\) " nil t) - (let ((fcn (match-string 1))) - (when (not (fboundp (intern-soft fcn))) + (let* ((fcn (match-string 1)) + (fsym (intern-soft fcn))) + (when (not (fboundp fsym)) (error "Help Err: Can't find %s" fcn)) (end-of-line) (insert " ") (insert-button "[ Do It ]" 'mouse-face 'custom-button-pressed-face 'do-fcn fcn - 'action `(lambda (arg) - (let ((M semantic-analyzer-debug-orig)) - (set-buffer (marker-buffer M)) - (goto-char M)) - (call-interactively (quote ,(intern-soft fcn)))))))) + 'action (lambda (_arg) + (let ((M semantic-analyzer-debug-orig)) + (set-buffer (marker-buffer M)) + (goto-char M)) + (call-interactively fsym)))))) ;; Do something else? ;; Clean up the mess (set-buffer-modified-p nil)))) diff --git a/lisp/cedet/semantic/analyze/fcn.el b/lisp/cedet/semantic/analyze/fcn.el index 10d11c33ebb..d47e8976e58 100644 --- a/lisp/cedet/semantic/analyze/fcn.el +++ b/lisp/cedet/semantic/analyze/fcn.el @@ -1,4 +1,4 @@ -;;; semantic/analyze/fcn.el --- Analyzer support functions. +;;; semantic/analyze/fcn.el --- Analyzer support functions. -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. @@ -55,7 +55,7 @@ Return the string representing the compound name.") (defun semantic-analyze-unsplit-name-default (namelist) "Concatenate the names in NAMELIST with a . between." - (mapconcat 'identity namelist ".")) + (mapconcat #'identity namelist ".")) ;;; SELECTING ;; diff --git a/lisp/cedet/semantic/analyze/refs.el b/lisp/cedet/semantic/analyze/refs.el index a39ff6f6736..31cbb9e1173 100644 --- a/lisp/cedet/semantic/analyze/refs.el +++ b/lisp/cedet/semantic/analyze/refs.el @@ -1,4 +1,4 @@ -;;; semantic/analyze/refs.el --- Analysis of the references between tags. +;;; semantic/analyze/refs.el --- Analysis of the references between tags. -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -296,7 +296,7 @@ Only works for tags in the global namespace." (let* ((classmatch (semantic-tag-class tag)) (RES (semanticdb-find-tags-collector - (lambda (table tags) + (lambda (_table tags) (semantic-find-tags-by-class classmatch tags) ;; @todo - Add parent check also. ) diff --git a/lisp/cedet/semantic/bovine.el b/lisp/cedet/semantic/bovine.el index 3bc0e4dd618..6be6dfd8dfd 100644 --- a/lisp/cedet/semantic/bovine.el +++ b/lisp/cedet/semantic/bovine.el @@ -1,4 +1,4 @@ -;;; semantic/bovine.el --- LL Parser/Analyzer core. +;;; semantic/bovine.el --- LL Parser/Analyzer core -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2004, 2006-2007, 2009-2021 Free Software ;; Foundation, Inc. @@ -41,7 +41,7 @@ ;;; Variables ;; -(defvar-local semantic-bovinate-nonterminal-check-obarray nil +(defvar-local semantic-bovinate-nonterminal-check-map nil "Obarray of streams already parsed for nonterminal symbols. Use this to detect infinite recursion during a parse.") @@ -54,6 +54,7 @@ Use this to detect infinite recursion during a parse.") "Create a lambda expression to return a list including RETURN-VAL. The return list is a lambda expression to be used in a bovine table." `(lambda (vals start end) + (ignore vals) (append ,@return-val (list start end)))) ;;; Semantic Bovination @@ -78,21 +79,18 @@ environment of `semantic-bovinate-stream'." (defun semantic-bovinate-nonterminal-check (stream nonterminal) "Check if STREAM not already parsed for NONTERMINAL. If so abort because an infinite recursive parse is suspected." - (or (vectorp semantic-bovinate-nonterminal-check-obarray) - (setq semantic-bovinate-nonterminal-check-obarray - (make-vector 13 nil))) - (let* ((nt (symbol-name nonterminal)) - (vs (symbol-value - (intern-soft - nt semantic-bovinate-nonterminal-check-obarray)))) + (or (hash-table-p semantic-bovinate-nonterminal-check-map) + (setq semantic-bovinate-nonterminal-check-map + (make-hash-table :test #'eq))) + (let* ((vs (gethash nonterminal semantic-bovinate-nonterminal-check-map))) (if (memq stream vs) ;; Always enter debugger to see the backtrace (let ((debug-on-signal t) (debug-on-error t)) - (setq semantic-bovinate-nonterminal-check-obarray nil) - (error "Infinite recursive parse suspected on %s" nt)) - (set (intern nt semantic-bovinate-nonterminal-check-obarray) - (cons stream vs))))) + (setq semantic-bovinate-nonterminal-check-map nil) + (error "Infinite recursive parse suspected on %s" nonterminal)) + (push stream + (gethash nonterminal semantic-bovinate-nonterminal-check-map))))) ;;;###autoload (defun semantic-bovinate-stream (stream &optional nonterminal) @@ -109,6 +107,9 @@ list of semantic tokens found." (or semantic--buffer-cache (semantic-bovinate-nonterminal-check stream nonterminal)) + ;; FIXME: `semantic-parse-region-c-mode' inspects `lse' to try and + ;; detect a recursive call (used with macroexpansion, to avoid inf-loops). + (with-suppressed-warnings ((lexical lse)) (defvar lse)) (let* ((table semantic--parse-table) (matchlist (cdr (assq nonterminal table))) (starting-stream stream) @@ -215,7 +216,8 @@ list of semantic tokens found." (setq cvl (cons (if (memq (semantic-lex-token-class lse) '(comment semantic-list)) - valdot val) cvl))) ;append unchecked value. + valdot val) + cvl))) ;append unchecked value. (setq end (semantic-lex-token-end lse)) ) (setq lte nil cvl nil)) ;No more matches, exit @@ -283,7 +285,7 @@ list of semantic tokens found." ;; Make it the default parser ;;;###autoload -(defalias 'semantic-parse-stream-default 'semantic-bovinate-stream) +(defalias 'semantic-parse-stream-default #'semantic-bovinate-stream) (provide 'semantic/bovine) diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el index fb551397381..e7ecb61513f 100644 --- a/lisp/cedet/semantic/bovine/c.el +++ b/lisp/cedet/semantic/bovine/c.el @@ -1,4 +1,4 @@ -;;; semantic/bovine/c.el --- Semantic details for C +;;; semantic/bovine/c.el --- Semantic details for C -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2021 Free Software Foundation, Inc. @@ -114,7 +114,8 @@ part of the preprocessor map.") "Reset the C preprocessor symbol map based on all input variables." (when (and semantic-mode (featurep 'semantic/bovine/c)) - (remove-hook 'mode-local-init-hook 'semantic-c-reset-preprocessor-symbol-map) + (remove-hook 'mode-local-init-hook + #'semantic-c-reset-preprocessor-symbol-map) ;; Initialize semantic-lex-spp-macro-symbol-obarray with symbols. (setq-mode-local c-mode semantic-lex-spp-macro-symbol-obarray @@ -154,7 +155,7 @@ part of the preprocessor map.") ;; Make sure the preprocessor symbols are set up when mode-local kicks ;; in. -(add-hook 'mode-local-init-hook 'semantic-c-reset-preprocessor-symbol-map) +(add-hook 'mode-local-init-hook #'semantic-c-reset-preprocessor-symbol-map) (defcustom semantic-lex-c-preprocessor-symbol-map nil "Table of C Preprocessor keywords used by the Semantic C lexer. @@ -237,8 +238,8 @@ Return the defined symbol as a special spp lex token." (skip-chars-forward " \t") (if (eolp) nil - (let* ((name (buffer-substring-no-properties - (match-beginning 1) (match-end 1))) + (let* (;; (name (buffer-substring-no-properties + ;; (match-beginning 1) (match-end 1))) (beginning-of-define (match-end 1)) (with-args (save-excursion (goto-char (match-end 0)) @@ -488,7 +489,7 @@ code to parse." (error nil)))) (let ((eval-form (condition-case err - (eval parsedtokelist) + (eval parsedtokelist t) (error (semantic-push-parser-warning (format "Hideif forms produced an error. Assuming false.\n%S" err) @@ -499,11 +500,11 @@ code to parse." (equal eval-form 0)));; ifdef line resulted in false ;; The if indicates to skip this preprocessor section - (let ((pt nil)) + (let () ;; (pt nil) (semantic-push-parser-warning (format "Skip %s" (buffer-substring-no-properties (point-at-bol) (point-at-eol))) (point-at-bol) (point-at-eol)) (beginning-of-line) - (setq pt (point)) + ;; (setq pt (point)) ;; This skips only a section of a conditional. Once that section ;; is opened, encountering any new #else or related conditional ;; should be skipped. @@ -818,7 +819,9 @@ MACRO expansion mode is handled through the nature of Emacs's non-lexical binding of variables. START, END, NONTERMINAL, DEPTH, and RETURNONERRORS are the same as for the parent." - (if (and (boundp 'lse) (or (/= start 1) (/= end (point-max)))) + ;; FIXME: We shouldn't depend on the internals of `semantic-bovinate-stream'. + (with-suppressed-warnings ((lexical lse)) (defvar lse)) + (if (and (boundp 'lse) (or (/= start (point-min)) (/= end (point-max)))) (let* ((last-lexical-token lse) (llt-class (semantic-lex-token-class last-lexical-token)) (llt-fakebits (car (cdr last-lexical-token))) @@ -926,7 +929,7 @@ the regular parser." (semantic-lex-init) (semantic-clear-toplevel-cache) (remove-hook 'semantic-lex-reset-functions - 'semantic-lex-spp-reset-hook t) + #'semantic-lex-spp-reset-hook t) ) ;; Get the macro symbol table right. (setq semantic-lex-spp-dynamic-macro-symbol-obarray spp-syms) @@ -970,7 +973,7 @@ the regular parser." ;; Notify about the debug (setq semantic-c-debug-mode-init-last-mode mm) - (add-hook 'post-command-hook 'semantic-c-debug-mode-init-pch))) + (add-hook 'post-command-hook #'semantic-c-debug-mode-init-pch))) (defun semantic-c-debug-mode-init-pch () "Notify user about needing to debug their major mode hooks." @@ -987,7 +990,7 @@ M-x semantic-c-debug-mode-init now. ") - (remove-hook 'post-command-hook 'semantic-c-debug-mode-init-pch))) + (remove-hook 'post-command-hook #'semantic-c-debug-mode-init-pch))) (defun semantic-expand-c-tag (tag) "Expand TAG into a list of equivalent tags, or nil." @@ -1228,7 +1231,7 @@ Use `semantic-analyze-current-tag' to debug this fcn." (when (not (semantic-tag-p tag)) (signal 'wrong-type-argument (list 'semantic-tag-p tag))) (let ((allhits nil) (scope nil) - (refs nil)) + ) ;; (refs nil) (save-excursion (semantic-go-to-tag tag db) (setq scope (semantic-calculate-scope)) @@ -1250,11 +1253,12 @@ Use `semantic-analyze-current-tag' to debug this fcn." (reverse newparents))) (setq allhits (semantic--analyze-refs-full-lookup tag scope t))) - (setq refs (semantic-analyze-references (semantic-tag-name tag) - :tag tag - :tagdb db - :scope scope - :rawsearchdata allhits))))) + ;; (setq refs + (semantic-analyze-references (semantic-tag-name tag) + :tag tag + :tagdb db + :scope scope + :rawsearchdata allhits)))) ;;) (defun semantic-c-reconstitute-token (tokenpart declmods typedecl) "Reconstitute a token TOKENPART with DECLMODS and TYPEDECL. @@ -1540,9 +1544,9 @@ This might be a string, or a list of tokens." ((semantic-tag-p templatespec) (semantic-format-tag-abbreviate templatespec)) ((listp templatespec) - (mapconcat 'semantic-format-tag-abbreviate templatespec ", ")))) + (mapconcat #'semantic-format-tag-abbreviate templatespec ", ")))) -(defun semantic-c-template-string (token &optional parent color) +(defun semantic-c-template-string (token &optional parent _color) "Return a string representing the TEMPLATE attribute of TOKEN. This string is prefixed with a space, or is the empty string. Argument PARENT specifies a parent type. @@ -1550,8 +1554,8 @@ Argument COLOR specifies that the string should be colorized." (let ((t2 (semantic-c-tag-template-specifier token)) (t1 (semantic-c-tag-template token)) ;; @todo - Need to account for a parent that is a template - (pt1 (if parent (semantic-c-tag-template parent))) - (pt2 (if parent (semantic-c-tag-template-specifier parent))) + (_pt1 (if parent (semantic-c-tag-template parent))) + (_pt2 (if parent (semantic-c-tag-template-specifier parent))) ) (cond (t2 ;; we have a template with specifier (concat " <" @@ -1610,7 +1614,7 @@ handled. A class is abstract only if its destructor is virtual." (member "virtual" (semantic-tag-modifiers tag)))) (t (semantic-tag-abstract-p-default tag parent)))) -(defun semantic-c-dereference-typedef (type scope &optional type-declaration) +(defun semantic-c-dereference-typedef (type _scope &optional type-declaration) "If TYPE is a typedef, get TYPE's type by name or tag, and return. SCOPE is not used, and TYPE-DECLARATION is used only if TYPE is not a typedef." (if (and (eq (semantic-tag-class type) 'type) @@ -1655,7 +1659,7 @@ return `ref<Foo,Bar>'." (concat (semantic-tag-name type) "<" (semantic-c--template-name-1 (cdr spec-list)) ">")) -(defun semantic-c-dereference-template (type scope &optional type-declaration) +(defun semantic-c-dereference-template (type _scope &optional type-declaration) "Dereference any template specifiers in TYPE within SCOPE. If TYPE is a template, return a TYPE copy with the templates types instantiated as specified in TYPE-DECLARATION." @@ -1677,7 +1681,7 @@ instantiated as specified in TYPE-DECLARATION." (list type type-declaration)) ;;; Patch here by "Raf" for instantiating templates. -(defun semantic-c-dereference-member-of (type scope &optional type-declaration) +(defun semantic-c-dereference-member-of (type _scope &optional type-declaration) "Dereference through the `->' operator of TYPE. Uses the return type of the `->' operator if it is contained in TYPE. SCOPE is the current local scope to perform searches in. @@ -1700,7 +1704,7 @@ Such an alias can be created through `using' statements in a namespace declaration. This function checks the namespaces in SCOPE for such statements." (let ((scopetypes (oref scope scopetypes)) - typename currentns tmp usingname result namespaces) + typename currentns result namespaces) ;; usingname tmp (when (and (semantic-tag-p type-declaration) (or (null type) (semantic-tag-prototype-p type))) (setq typename (semantic-analyze-split-name (semantic-tag-name type-declaration))) @@ -1739,11 +1743,11 @@ with a fully qualified name in the original namespace. Returns nil if NAMESPACE is not an alias." (when (eq (semantic-tag-get-attribute namespace :kind) 'alias) (let ((typename (semantic-analyze-split-name (semantic-tag-name type))) - ns nstype originaltype newtype) + ns nstype originaltype) ;; newtype ;; Make typename unqualified - (if (listp typename) - (setq typename (last typename)) - (setq typename (list typename))) + (setq typename (if (listp typename) + (last typename) + (list typename))) (when (and ;; Get original namespace and make sure TYPE exists there. @@ -1755,13 +1759,13 @@ nil if NAMESPACE is not an alias." (semantic-tag-get-attribute nstype :members)))) ;; Construct new type with name in original namespace. (setq ns (semantic-analyze-split-name ns)) - (setq newtype - (semantic-tag-clone - (car originaltype) - (semantic-analyze-unsplit-name - (if (listp ns) - (append ns typename) - (append (list ns) typename))))))))) + ;; (setq newtype + (semantic-tag-clone + (car originaltype) + (semantic-analyze-unsplit-name + (if (listp ns) + (append ns typename) + (append (list ns) typename)))))))) ;; ) ;; This searches a type in a namespace, following through all using ;; statements. @@ -1769,7 +1773,7 @@ nil if NAMESPACE is not an alias." "Check if TYPE is accessible in NAMESPACE through a using statement. Returns the original type from the namespace where it is defined, or nil if it cannot be found." - (let (usings result usingname usingtype unqualifiedname members shortname tmp) + (let (usings result usingname usingtype unqualifiedname members) ;; shortname tmp ;; Get all using statements from NAMESPACE. (when (and (setq usings (semantic-tag-get-attribute namespace :members)) (setq usings (semantic-find-tags-by-class 'using usings))) @@ -1842,7 +1846,7 @@ These are constants which are of type TYPE." (define-mode-local-override semantic-analyze-unsplit-name c-mode (namelist) "Assemble the list of names NAMELIST into a namespace name." - (mapconcat 'identity namelist "::")) + (mapconcat #'identity namelist "::")) (define-mode-local-override semantic-ctxt-scoped-types c++-mode (&optional point) "Return a list of tags of CLASS type based on POINT. @@ -1885,7 +1889,7 @@ DO NOT return the list of tags encompassing point." (semantic-get-local-variables)))) (setq tagreturn (append tagreturn - (mapcar 'semantic-tag-type tmp)))))) + (mapcar #'semantic-tag-type tmp)))))) ;; Return the stuff tagreturn)) @@ -1943,7 +1947,7 @@ namespace, since this means all tags inside this include will have to be wrapped in that namespace." (let ((inctable (semanticdb-find-table-for-include-default includetag table)) (inside-ns (semantic-tag-get-attribute includetag :inside-ns)) - tags newtags namespaces prefix parenttable newtable) + tags newtags namespaces parenttable newtable) ;; prefix (if (or (null inside-ns) (not inctable) (not (slot-boundp inctable 'tags))) @@ -2111,13 +2115,11 @@ actually in their parent which is not accessible.") "Set up a buffer for semantic parsing of the C language." (semantic-c-by--install-parser) (setq semantic-lex-syntax-modifications '((?> ".") - (?< ".") - ) - ) + (?< "."))) (setq semantic-lex-analyzer #'semantic-c-lexer) - (add-hook 'semantic-lex-reset-functions 'semantic-lex-spp-reset-hook nil t) - (when (eq major-mode 'c++-mode) + (add-hook 'semantic-lex-reset-functions #'semantic-lex-spp-reset-hook nil t) + (when (derived-mode-p 'c++-mode) (add-to-list 'semantic-lex-c-preprocessor-symbol-map '("__cplusplus" . ""))) ) @@ -2142,7 +2144,7 @@ actually in their parent which is not accessible.") (defun semantic-c-describe-environment () "Describe the Semantic features of the current C environment." (interactive) - (if (not (member 'c-mode (mode-local-equivalent-mode-p major-mode))) + (if (not (derived-mode-p 'c-mode)) (error "Not useful to query C mode in %s mode" major-mode)) (let ((gcc (when (boundp 'semantic-gcc-setup-data) semantic-gcc-setup-data)) @@ -2242,8 +2244,8 @@ actually in their parent which is not accessible.") (if (obarrayp semantic-lex-spp-project-macro-symbol-obarray) (let ((macros nil)) (mapatoms - #'(lambda (symbol) - (setq macros (cons symbol macros))) + (lambda (symbol) + (setq macros (cons symbol macros))) semantic-lex-spp-project-macro-symbol-obarray) (dolist (S macros) (princ " ") diff --git a/lisp/cedet/semantic/bovine/debug.el b/lisp/cedet/semantic/bovine/debug.el index 8ea9ac24423..47850a5d1f4 100644 --- a/lisp/cedet/semantic/bovine/debug.el +++ b/lisp/cedet/semantic/bovine/debug.el @@ -1,4 +1,4 @@ -;;; semantic/bovine/debug.el --- Debugger support for bovinator +;;; semantic/bovine/debug.el --- Debugger support for bovinator -*- lexical-binding: t; -*- ;; Copyright (C) 2003, 2009-2021 Free Software Foundation, Inc. @@ -123,7 +123,7 @@ Argument CONDITION is the thrown error condition." frame) frame)) -(cl-defmethod semantic-debug-frame-highlight ((frame semantic-bovine-debug-error-frame)) +(cl-defmethod semantic-debug-frame-highlight ((_frame semantic-bovine-debug-error-frame)) "Highlight a frame from an action." ;; How do I get the location of the action in the source buffer? ) diff --git a/lisp/cedet/semantic/bovine/el.el b/lisp/cedet/semantic/bovine/el.el index dc617349021..ebb20448ed5 100644 --- a/lisp/cedet/semantic/bovine/el.el +++ b/lisp/cedet/semantic/bovine/el.el @@ -1,4 +1,4 @@ -;;; semantic/bovine/el.el --- Semantic details for Emacs Lisp +;;; semantic/bovine/el.el --- Semantic details for Emacs Lisp -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2005, 2007-2021 Free Software Foundation, Inc. @@ -169,10 +169,10 @@ where: - 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." + (declare (indent 1)) (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) (defmacro semantic-elisp-reuse-form-parser (symbol &rest symbols) "Reuse the form parser of SYMBOL for forms identified by SYMBOLS. @@ -210,7 +210,7 @@ Return a bovination list to use." ;;; Form parsers ;; (semantic-elisp-setup-form-parser - (lambda (form start end) + (lambda (form _start _end) (semantic-tag-new-function (symbol-name (nth 2 form)) nil @@ -234,7 +234,7 @@ Return a bovination list to use." ) (semantic-elisp-setup-form-parser - (lambda (form start end) + (lambda (form _start _end) (semantic-tag-new-function (symbol-name (nth 1 form)) nil @@ -256,7 +256,7 @@ Return a bovination list to use." ) (semantic-elisp-setup-form-parser - (lambda (form start end) + (lambda (form _start _end) (let ((doc (semantic-elisp-form-to-doc-string (nth 3 form)))) (semantic-tag-new-variable (symbol-name (nth 1 form)) @@ -274,7 +274,7 @@ Return a bovination list to use." ) (semantic-elisp-setup-form-parser - (lambda (form start end) + (lambda (form _start _end) (let ((doc (semantic-elisp-form-to-doc-string (nth 3 form)))) (semantic-tag-new-variable (symbol-name (nth 1 form)) @@ -290,7 +290,7 @@ Return a bovination list to use." (semantic-elisp-setup-form-parser - (lambda (form start end) + (lambda (form _start _end) (let ((doc (semantic-elisp-form-to-doc-string (nth 3 form)))) (semantic-tag-new-variable (symbol-name (nth 1 form)) @@ -307,7 +307,7 @@ Return a bovination list to use." (semantic-elisp-setup-form-parser - (lambda (form start end) + (lambda (form _start _end) (let ((doc (semantic-elisp-form-to-doc-string (nth 3 form)))) (semantic-tag (symbol-name (nth 1 form)) @@ -321,7 +321,7 @@ Return a bovination list to use." (semantic-elisp-setup-form-parser - (lambda (form start end) + (lambda (form _start _end) (semantic-tag-new-function (symbol-name (cadr (cadr form))) nil nil @@ -333,7 +333,7 @@ Return a bovination list to use." ) (semantic-elisp-setup-form-parser - (lambda (form start end) + (lambda (form _start _end) (let* ((a2 (nth 2 form)) (a3 (nth 3 form)) (args (if (listp a2) a2 a3)) @@ -353,7 +353,7 @@ Return a bovination list to use." ) (semantic-elisp-setup-form-parser - (lambda (form start end) + (lambda (form _start _end) (semantic-tag-new-function (symbol-name (nth 1 form)) nil @@ -363,7 +363,7 @@ Return a bovination list to use." ) (semantic-elisp-setup-form-parser - (lambda (form start end) + (lambda (form _start _end) (let ((docpart (nthcdr 4 form))) (semantic-tag-new-type (symbol-name (nth 1 form)) @@ -381,7 +381,7 @@ Return a bovination list to use." ) (semantic-elisp-setup-form-parser - (lambda (form start end) + (lambda (form _start _end) (let ((slots (nthcdr 2 form))) ;; Skip doc string if present. (and (stringp (car slots)) @@ -399,7 +399,7 @@ Return a bovination list to use." ) (semantic-elisp-setup-form-parser - (lambda (form start end) + (lambda (form _start _end) (semantic-tag-new-function (symbol-name (nth 1 form)) nil nil @@ -410,7 +410,7 @@ Return a bovination list to use." ) (semantic-elisp-setup-form-parser - (lambda (form start end) + (lambda (form _start _end) (let ((args (nth 3 form))) (semantic-tag-new-function (symbol-name (nth 1 form)) @@ -424,7 +424,7 @@ Return a bovination list to use." ) (semantic-elisp-setup-form-parser - (lambda (form start end) + (lambda (form _start _end) (semantic-tag-new-variable (symbol-name (nth 2 form)) nil @@ -437,7 +437,7 @@ Return a bovination list to use." ) (semantic-elisp-setup-form-parser - (lambda (form start end) + (lambda (form _start _end) (let ((name (nth 1 form))) (semantic-tag-new-include (symbol-name (if (eq (car-safe name) 'quote) @@ -449,7 +449,7 @@ Return a bovination list to use." ) (semantic-elisp-setup-form-parser - (lambda (form start end) + (lambda (form _start _end) (let ((name (nth 1 form))) (semantic-tag-new-package (symbol-name (if (eq (car-safe name) 'quote) @@ -500,7 +500,7 @@ into Emacs Lisp's memory." "")))) (define-mode-local-override semantic-documentation-for-tag - emacs-lisp-mode (tag &optional nosnarf) + emacs-lisp-mode (tag &optional _nosnarf) "Return the documentation string for TAG. Optional argument NOSNARF is ignored." (let ((d (semantic-tag-docstring tag))) @@ -577,7 +577,7 @@ Override function for `semantic-tag-protection'." ((string= prot "protected") 'protected)))) (define-mode-local-override semantic-tag-static-p - emacs-lisp-mode (tag &optional parent) + emacs-lisp-mode (tag &optional _parent) "Return non-nil if TAG is static in PARENT class. Overrides `semantic-nonterminal-static'." ;; This can only be true (theoretically) in a class where it is assigned. @@ -585,10 +585,10 @@ Overrides `semantic-nonterminal-static'." ;;; Context parsing ;; -;; Emacs lisp is very different from C,C++ which most context parsing +;; Emacs Lisp is very different from C,C++ which most context parsing ;; functions are written. Support them here. (define-mode-local-override semantic-up-context emacs-lisp-mode - (&optional point bounds-type) + (&optional _point _bounds-type) "Move up one context in an Emacs Lisp function. A Context in many languages is a block with its own local variables. In Emacs, we will move up lists and stop when one starts with one of @@ -652,7 +652,7 @@ define-mode-overload\\)\ (define-mode-local-override semantic-get-local-variables emacs-lisp-mode - (&optional point) + (&optional _point) "Return a list of local variables for POINT. Scan backwards from point at each successive function. For all occurrences of `let' or `let*', grab those variable names." @@ -940,7 +940,7 @@ ELisp variables can be pretty long, so track this one too.") ;; loaded into Emacs. ) -(add-hook 'emacs-lisp-mode-hook 'semantic-default-elisp-setup) +(add-hook 'emacs-lisp-mode-hook #'semantic-default-elisp-setup) ;;; LISP MODE ;; @@ -950,7 +950,7 @@ ELisp variables can be pretty long, so track this one too.") ;; See this syntax: ;; (defun foo () /#A) ;; -(add-hook 'lisp-mode-hook 'semantic-default-elisp-setup) +(add-hook 'lisp-mode-hook #'semantic-default-elisp-setup) (eval-after-load "semantic/db" '(require 'semantic/db-el) diff --git a/lisp/cedet/semantic/bovine/gcc.el b/lisp/cedet/semantic/bovine/gcc.el index 1cfe5a3bac1..02bd0defef5 100644 --- a/lisp/cedet/semantic/bovine/gcc.el +++ b/lisp/cedet/semantic/bovine/gcc.el @@ -1,4 +1,4 @@ -;;; semantic/bovine/gcc.el --- gcc querying special code for the C parser +;;; semantic/bovine/gcc.el --- gcc querying special code for the C parser -*- lexical-binding: t -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -25,6 +25,7 @@ ;; GCC, and set up the preprocessor and include paths. (require 'semantic/dep) +(require 'cl-lib) (defvar semantic-lex-c-preprocessor-symbol-file) (defvar semantic-lex-c-preprocessor-symbol-map) @@ -46,11 +47,11 @@ to give to the program." (erase-buffer) (setenv "LC_ALL" "C") (condition-case nil - (setq err (apply 'call-process gcc-cmd options)) + (setq err (apply #'call-process gcc-cmd options)) (error ;; Some bogus directory for the first time perhaps? (let ((default-directory (expand-file-name "~/"))) (condition-case nil - (setq err (apply 'call-process gcc-cmd options)) + (setq err (apply #'call-process gcc-cmd options)) (error ;; gcc doesn't exist??? nil))))) (setenv "LC_ALL" old-lc-messages) @@ -88,10 +89,9 @@ to give to the program." (let ((path (substring line 1))) (when (and (file-accessible-directory-p path) (file-name-absolute-p path)) - (add-to-list 'inc-path - (expand-file-name path) - t)))))))) - inc-path)) + (cl-pushnew (expand-file-name path) inc-path + :test #'equal)))))))) + (nreverse inc-path))) (defun semantic-cpp-defs (str) @@ -101,7 +101,7 @@ to give to the program." (dolist (L lines) (let ((dat (split-string L))) (when (= (length dat) 3) - (add-to-list 'lst (cons (nth 1 dat) (nth 2 dat)))))) + (push (cons (nth 1 dat) (nth 2 dat)) lst)))) lst)) (defun semantic-gcc-fields (str) @@ -142,6 +142,8 @@ This is an alist, and should include keys of: `--prefix' - where GCC was installed. It should also include other symbols GCC was compiled with.") +(defvar c++-include-path) + ;;;###autoload (defun semantic-gcc-setup () "Setup Semantic C/C++ parsing based on GCC output." @@ -149,12 +151,12 @@ It should also include other symbols GCC was compiled with.") (let* ((fields (or semantic-gcc-setup-data (semantic-gcc-fields (semantic-gcc-query "gcc" "-v")))) (cpp-options `("-E" "-dM" "-x" "c++" ,null-device)) - (query (let ((q (apply 'semantic-gcc-query "cpp" cpp-options))) + (query (let ((q (apply #'semantic-gcc-query "cpp" cpp-options))) (if (stringp q) q ;; `cpp' command in `semantic-gcc-setup' doesn't work on ;; Mac, try `gcc'. - (apply 'semantic-gcc-query "gcc" cpp-options)))) + (apply #'semantic-gcc-query "gcc" cpp-options)))) (defines (if (stringp query) (semantic-cpp-defs query) (message (concat "Could not query gcc for defines. " diff --git a/lisp/cedet/semantic/bovine/grammar.el b/lisp/cedet/semantic/bovine/grammar.el index 4914ec9b124..a2717d711fe 100644 --- a/lisp/cedet/semantic/bovine/grammar.el +++ b/lisp/cedet/semantic/bovine/grammar.el @@ -1,4 +1,4 @@ -;;; semantic/bovine/grammar.el --- Bovine's input grammar mode +;;; semantic/bovine/grammar.el --- Bovine's input grammar mode -*- lexical-binding: t; -*- ;; ;; Copyright (C) 2002-2021 Free Software Foundation, Inc. ;; @@ -25,9 +25,8 @@ ;; ;; Major mode for editing Bovine's input grammar (.by) files. -;;; History: - ;;; Code: + (require 'semantic) (require 'semantic/grammar) (require 'semantic/find) @@ -243,7 +242,8 @@ QUOTEMODE is the mode in which quoted symbols are slurred." (insert "\n") (cond ((eq (car sexp) 'EXPAND) - (insert ",(lambda (vals start end)") + (insert ",(lambda (vals start end)" + "\n(ignore vals start end)") ;; The EXPAND macro definition is mandatory (bovine-grammar-expand-form (apply (cdr (assq 'EXPAND bovine--grammar-macros)) (cdr sexp)) @@ -475,7 +475,7 @@ Menu items are appended to the common grammar menu.") (with-current-buffer (find-file-noselect infile) (setq infile buffer-file-name) (if outdir (setq default-directory outdir)) - (semantic-grammar-create-package nil t)) + (semantic-grammar-create-package t t)) (error (message "%s" (error-message-string err)) nil))) lang filename copyright-end) (when (and packagename @@ -520,7 +520,8 @@ Menu items are appended to the common grammar menu.") (goto-char (point-min)) (delete-region (point-min) (line-end-position)) (insert ";;; " packagename - " --- Generated parser support file") + " --- Generated parser support file " + "-*- lexical-binding:t -*-") (delete-trailing-whitespace) (re-search-forward ";;; \\(.*\\) ends here") (replace-match packagename nil nil nil 1))))) diff --git a/lisp/cedet/semantic/bovine/make.el b/lisp/cedet/semantic/bovine/make.el index 80895565274..bb579cfde3f 100644 --- a/lisp/cedet/semantic/bovine/make.el +++ b/lisp/cedet/semantic/bovine/make.el @@ -1,4 +1,4 @@ -;;; semantic/bovine/make.el --- Makefile parsing rules. +;;; semantic/bovine/make.el --- Makefile parsing rules. -*- lexical-binding: t; -*- ;; Copyright (C) 2000-2004, 2008-2021 Free Software Foundation, Inc. @@ -103,13 +103,13 @@ Ignore them." xpand)) (define-mode-local-override semantic-get-local-variables - makefile-mode (&optional point) + makefile-mode (&optional _point) "Override `semantic-get-local-variables' so it does not throw an error. We never have local variables in Makefiles." nil) (define-mode-local-override semantic-ctxt-current-class-list - makefile-mode (&optional point) + makefile-mode (&optional _point) "List of classes that are valid to place at point." (let ((tag (semantic-current-tag))) (when tag @@ -176,7 +176,7 @@ This is the same as a regular prototype." (semantic-format-tag-prototype tag parent color)) (define-mode-local-override semantic-analyze-possible-completions - makefile-mode (context &rest flags) + makefile-mode (context &rest _flags) "Return a list of possible completions in a Makefile. Uses default implementation, and also gets a list of filenames." (require 'semantic/analyze/complete) @@ -218,7 +218,7 @@ Uses default implementation, and also gets a list of filenames." ;; but not actually parsed. (file . "File")) semantic-case-fold t - semantic-tag-expand-function 'semantic-make-expand-tag + semantic-tag-expand-function #'semantic-make-expand-tag semantic-lex-syntax-modifications '((?. "_") (?= ".") (?/ "_") @@ -226,7 +226,7 @@ Uses default implementation, and also gets a list of filenames." (?+ ".") (?\\ ".") ) - imenu-create-index-function 'semantic-create-imenu-index + imenu-create-index-function #'semantic-create-imenu-index ) (setq semantic-lex-analyzer #'semantic-make-lexer) ) diff --git a/lisp/cedet/semantic/bovine/scm.el b/lisp/cedet/semantic/bovine/scm.el index aaa86a1e36c..0395412069b 100644 --- a/lisp/cedet/semantic/bovine/scm.el +++ b/lisp/cedet/semantic/bovine/scm.el @@ -1,6 +1,6 @@ -;;; semantic/bovine/scm.el --- Semantic details for Scheme (guile) +;;; semantic/bovine/scm.el --- Semantic details for Scheme (guile) -*- lexical-binding: t; -*- -;;; Copyright (C) 2001-2004, 2008-2021 Free Software Foundation, Inc. +;; Copyright (C) 2001-2021 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> @@ -49,7 +49,7 @@ actually on the local machine.") ")") (semantic-format-tag-prototype-default tag parent color)))) -(define-mode-local-override semantic-documentation-for-tag scheme-mode (tag &optional nosnarf) +(define-mode-local-override semantic-documentation-for-tag scheme-mode (tag &optional _nosnarf) "Return the documentation string for TAG. Optional argument NOSNARF is ignored." (let ((d (semantic-tag-docstring tag))) @@ -57,7 +57,7 @@ Optional argument NOSNARF is ignored." (substring d 1) d))) -(define-mode-local-override semantic-insert-foreign-tag scheme-mode (tag tagfile) +(define-mode-local-override semantic-insert-foreign-tag scheme-mode (tag _tagfile) "Insert TAG from TAGFILE at point. Attempts a simple prototype for calling or using TAG." (cond ((eq (semantic-tag-class tag) 'function) @@ -102,8 +102,7 @@ syntax as specified by the syntax table." (function . "Functions") (include . "Loads") (package . "DefineModule")) - imenu-create-index-function 'semantic-create-imenu-index - imenu-create-index-function 'semantic-create-imenu-index + imenu-create-index-function #'semantic-create-imenu-index ) (setq semantic-lex-analyzer #'semantic-scheme-lexer) ) diff --git a/lisp/cedet/semantic/chart.el b/lisp/cedet/semantic/chart.el index e7848faf741..0abbe458647 100644 --- a/lisp/cedet/semantic/chart.el +++ b/lisp/cedet/semantic/chart.el @@ -1,4 +1,4 @@ -;;; semantic/chart.el --- Utilities for use with semantic tag tables +;;; semantic/chart.el --- Utilities for use with semantic tag tables -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2001, 2003, 2005, 2008-2021 Free Software ;; Foundation, Inc. @@ -43,7 +43,7 @@ TAGTABLE is passed to `semantic-something-to-tag-table'." (interactive) (let* ((stream (semantic-something-to-tag-table (or tagtable (current-buffer)))) - (names (mapcar 'cdr semantic-symbol->name-assoc-list)) + (names (mapcar #'cdr semantic-symbol->name-assoc-list)) (nums (mapcar (lambda (symname) (length @@ -57,7 +57,7 @@ TAGTABLE is passed to `semantic-something-to-tag-table'." nums "Volume") )) -(defun semantic-chart-database-size (&optional tagtable) +(defun semantic-chart-database-size (&optional _tagtable) "Create a bar chart representing the size of each file in semanticdb. Each bar represents how many toplevel tags in TAGTABLE exist in each database entry. @@ -68,7 +68,7 @@ TAGTABLE is passed to `semantic-something-to-tag-table'." (error "Semanticdb is not enabled")) (let* ((db semanticdb-current-database) (dbt (semanticdb-get-database-tables db)) - (names (mapcar 'car + (names (mapcar #'car (object-assoc-list 'file dbt))) @@ -84,8 +84,8 @@ TAGTABLE is passed to `semantic-something-to-tag-table'." (nums nil) (fh (/ (- (frame-height) 7) 4))) (setq numnuts (sort numnuts (lambda (a b) (> (car a) (car b))))) - (setq names (mapcar 'cdr numnuts) - nums (mapcar 'car numnuts)) + (setq names (mapcar #'cdr numnuts) + nums (mapcar #'car numnuts)) (if (> (length names) fh) (progn (setcdr (nthcdr fh names) nil) diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el index c83505818f5..d6ef7960473 100644 --- a/lisp/cedet/semantic/complete.el +++ b/lisp/cedet/semantic/complete.el @@ -1,4 +1,4 @@ -;;; semantic/complete.el --- Routines for performing tag completion +;;; semantic/complete.el --- Routines for performing tag completion -*- lexical-binding: t; -*- ;; Copyright (C) 2003-2005, 2007-2021 Free Software Foundation, Inc. @@ -154,8 +154,8 @@ Presumably if you call this you will insert something new there." (defun semantic-completion-message (fmt &rest args) "Display the string FMT formatted with ARGS at the end of the minibuffer." (if semantic-complete-inline-overlay - (apply 'message fmt args) - (apply 'message (concat "%s" fmt) (buffer-string) args))) + (apply #'message fmt args) + (apply #'message (concat "%s" fmt) (buffer-string) args))) ;;; ------------------------------------------------------------ ;;; MINIBUFFER: Option Selection harnesses @@ -171,14 +171,14 @@ Value should be a ... what?") (defvar semantic-complete-key-map (let ((km (make-sparse-keymap))) - (define-key km " " 'semantic-complete-complete-space) - (define-key km "\t" 'semantic-complete-complete-tab) - (define-key km "\C-m" 'semantic-complete-done) - (define-key km "\C-g" 'abort-recursive-edit) - (define-key km "\M-n" 'next-history-element) - (define-key km "\M-p" 'previous-history-element) - (define-key km "\C-n" 'next-history-element) - (define-key km "\C-p" 'previous-history-element) + (define-key km " " #'semantic-complete-complete-space) + (define-key km "\t" #'semantic-complete-complete-tab) + (define-key km "\C-m" #'semantic-complete-done) + (define-key km "\C-g" #'abort-recursive-edit) + (define-key km "\M-n" #'next-history-element) + (define-key km "\M-p" #'previous-history-element) + (define-key km "\C-n" #'next-history-element) + (define-key km "\C-p" #'previous-history-element) ;; Add history navigation km) "Keymap used while completing across a list of tags.") @@ -488,7 +488,7 @@ If PARTIAL, do partial completion stopping at spaces." ) (t nil)))) -(defun semantic-complete-do-completion (&optional partial inline) +(defun semantic-complete-do-completion (&optional partial _inline) "Do a completion for the current minibuffer. If PARTIAL, do partial completion stopping at spaces. if INLINE, then completion is happening inline in a buffer." @@ -550,12 +550,12 @@ if INLINE, then completion is happening inline in a buffer." ;; push ourselves out of this mode on alternate keypresses. (defvar semantic-complete-inline-map (let ((km (make-sparse-keymap))) - (define-key km "\C-i" 'semantic-complete-inline-TAB) - (define-key km "\M-p" 'semantic-complete-inline-up) - (define-key km "\M-n" 'semantic-complete-inline-down) - (define-key km "\C-m" 'semantic-complete-inline-done) - (define-key km "\C-\M-c" 'semantic-complete-inline-exit) - (define-key km "\C-g" 'semantic-complete-inline-quit) + (define-key km "\C-i" #'semantic-complete-inline-TAB) + (define-key km "\M-p" #'semantic-complete-inline-up) + (define-key km "\M-n" #'semantic-complete-inline-down) + (define-key km "\C-m" #'semantic-complete-inline-done) + (define-key km "\C-\M-c" #'semantic-complete-inline-exit) + (define-key km "\C-g" #'semantic-complete-inline-quit) (define-key km "?" (lambda () (interactive) (describe-variable 'semantic-complete-inline-map))) @@ -620,7 +620,7 @@ Similar to `minibuffer-contents' when completing in the minibuffer." "Exit inline completion mode." (interactive) ;; Remove this hook FIRST! - (remove-hook 'pre-command-hook 'semantic-complete-pre-command-hook) + (remove-hook 'pre-command-hook #'semantic-complete-pre-command-hook) (condition-case nil (progn @@ -649,7 +649,7 @@ Similar to `minibuffer-contents' when completing in the minibuffer." ;; Remove this hook LAST!!! ;; This will force us back through this function if there was ;; some sort of error above. - (remove-hook 'post-command-hook 'semantic-complete-post-command-hook) + (remove-hook 'post-command-hook #'semantic-complete-post-command-hook) ;;(message "Exiting inline completion.") ) @@ -770,8 +770,8 @@ END is at the end of the current symbol being completed." (overlay-put semantic-complete-inline-overlay 'semantic-original-start start) ;; Install our command hooks - (add-hook 'pre-command-hook 'semantic-complete-pre-command-hook) - (add-hook 'post-command-hook 'semantic-complete-post-command-hook) + (add-hook 'pre-command-hook #'semantic-complete-pre-command-hook) + (add-hook 'post-command-hook #'semantic-complete-post-command-hook) ;; Go! (semantic-complete-inline-force-display) ) @@ -929,8 +929,8 @@ The only options available for completion are those which can be logically inserted into the current context.") (cl-defmethod semantic-collector-calculate-completions-raw - ((obj semantic-collector-analyze-completions) prefix completionlist) - "calculate the completions for prefix from completionlist." + ((obj semantic-collector-analyze-completions) prefix _completionlist) + "calculate the completions for prefix from COMPLETIONLIST." ;; if there are no completions yet, calculate them. (if (not (slot-boundp obj 'first-pass-completions)) (oset obj first-pass-completions @@ -943,7 +943,7 @@ inserted into the current context.") prefix (oref obj first-pass-completions))))) -(cl-defmethod semantic-collector-cleanup ((obj semantic-collector-abstract)) +(cl-defmethod semantic-collector-cleanup ((_obj semantic-collector-abstract)) "Clean up any mess this collector may have." nil) @@ -1004,7 +1004,7 @@ Output must be in semanticdb Find result format." (list (cons table result))))) (cl-defmethod semantic-collector-calculate-completions - ((obj semantic-collector-abstract) prefix partial) + ((obj semantic-collector-abstract) prefix _partial) "Calculate completions for prefix as setup for other queries." (let* ((case-fold-search semantic-case-fold) (same-prefix-p (semantic-collector-last-prefix= obj prefix)) @@ -1014,7 +1014,8 @@ Output must be in semanticdb Find result format." (cond ((or same-prefix-p (and last-prefix (eq (compare-strings last-prefix 0 nil - prefix 0 (length last-prefix)) t))) + prefix 0 (length last-prefix)) + t))) ;; We have the same prefix, or last-prefix is a ;; substring of the of new prefix, in which case we are ;; refining our symbol so just re-use cache. @@ -1023,7 +1024,8 @@ Output must be in semanticdb Find result format." (> (length prefix) 1) (eq (compare-strings prefix 0 nil - last-prefix 0 (length prefix)) t)) + last-prefix 0 (length prefix)) + t)) ;; The new prefix is a substring of the old ;; prefix, and it's longer than one character. ;; Perform a full search to pull in additional @@ -1134,7 +1136,7 @@ into a buffer." (semanticdb-find-result-nth-in-buffer (oref obj current-exact-match) 0))) (cl-defmethod semantic-collector-all-completions - ((obj semantic-collector-abstract) prefix) + ((obj semantic-collector-abstract) _prefix) "For OBJ, retrieve all completions matching PREFIX. The returned list consists of all the tags currently matching PREFIX." @@ -1142,7 +1144,7 @@ matching PREFIX." (oref obj last-all-completions))) (cl-defmethod semantic-collector-try-completion - ((obj semantic-collector-abstract) prefix) + ((obj semantic-collector-abstract) _prefix) "For OBJ, attempt to match PREFIX. See `try-completion' for details on how this works. Return nil for no match. @@ -1153,7 +1155,7 @@ with that name." (oref obj last-completion))) (cl-defmethod semantic-collector-calculate-cache - ((obj semantic-collector-abstract)) + ((_obj semantic-collector-abstract)) "Calculate the completion cache for OBJ." nil ) @@ -1176,7 +1178,7 @@ These collectors track themselves on a per-buffer basis." :abstract t) (cl-defmethod make-instance ((this (subclass semantic-collector-buffer-abstract)) - &rest args) + &rest _args) "Reuse previously created objects of this type in buffer." (let ((old nil) (bl semantic-collector-per-buffer-list)) @@ -1193,7 +1195,7 @@ These collectors track themselves on a per-buffer basis." old)) ;; Buffer specific collectors should flush themselves -(defun semantic-collector-buffer-flush (newcache) +(defun semantic-collector-buffer-flush (_newcache) "Flush all buffer collector objects. NEWCACHE is the new tag table, but we ignore it." (condition-case nil @@ -1204,7 +1206,7 @@ NEWCACHE is the new tag table, but we ignore it." (error nil))) (add-hook 'semantic-after-toplevel-cache-change-hook - 'semantic-collector-buffer-flush) + #'semantic-collector-buffer-flush) ;;; DEEP BUFFER SPECIFIC COMPLETION ;; @@ -1246,8 +1248,8 @@ Uses semanticdb for searching all tags in the current project." (cl-defmethod semantic-collector-calculate-completions-raw - ((obj semantic-collector-project) prefix completionlist) - "Calculate the completions for prefix from completionlist." + ((obj semantic-collector-project) prefix _completionlist) + "Calculate the completions for prefix from COMPLETIONLIST." (semanticdb-find-tags-for-completion prefix (oref obj path))) ;;; Brutish Project search @@ -1259,8 +1261,8 @@ Uses semanticdb for searching all tags in the current project." "semantic/db-find") (cl-defmethod semantic-collector-calculate-completions-raw - ((obj semantic-collector-project-brutish) prefix completionlist) - "Calculate the completions for prefix from completionlist." + ((obj semantic-collector-project-brutish) prefix _completionlist) + "Calculate the completions for prefix from COMPLETIONLIST." (require 'semantic/db-find) (semanticdb-brute-deep-find-tags-for-completion prefix (oref obj path))) @@ -1273,8 +1275,8 @@ Uses semanticdb for searching all tags in the current project." "Completion engine for tags in a project.") (cl-defmethod semantic-collector-calculate-completions-raw - ((obj semantic-collector-local-members) prefix completionlist) - "Calculate the completions for prefix from completionlist." + ((obj semantic-collector-local-members) prefix _completionlist) + "Calculate the completions for prefix from COMPLETIONLIST." (let* ((scope (or (oref obj scope) (oset obj scope (semantic-calculate-scope)))) (localstuff (oref scope scope))) @@ -1323,7 +1325,7 @@ a collector, and tracking tables of completion to display." (define-obsolete-function-alias 'semantic-displayor-cleanup #'semantic-displayer-cleanup "27.1") -(cl-defmethod semantic-displayer-cleanup ((obj semantic-displayer-abstract)) +(cl-defmethod semantic-displayer-cleanup ((_obj semantic-displayer-abstract)) "Clean up any mess this displayer may have." nil) @@ -1348,37 +1350,37 @@ a collector, and tracking tables of completion to display." (define-obsolete-function-alias 'semantic-displayor-show-request #'semantic-displayer-show-request "27.1") -(cl-defmethod semantic-displayer-show-request ((obj semantic-displayer-abstract)) +(cl-defmethod semantic-displayer-show-request ((_obj semantic-displayer-abstract)) "A request to show the current tags table." (ding)) (define-obsolete-function-alias 'semantic-displayor-focus-request #'semantic-displayer-focus-request "27.1") -(cl-defmethod semantic-displayer-focus-request ((obj semantic-displayer-abstract)) +(cl-defmethod semantic-displayer-focus-request ((_obj semantic-displayer-abstract)) "A request to for the displayer to focus on some tag option." (ding)) (define-obsolete-function-alias 'semantic-displayor-scroll-request #'semantic-displayer-scroll-request "27.1") -(cl-defmethod semantic-displayer-scroll-request ((obj semantic-displayer-abstract)) +(cl-defmethod semantic-displayer-scroll-request ((_obj semantic-displayer-abstract)) "A request to for the displayer to scroll the completion list (if needed)." (scroll-other-window)) (define-obsolete-function-alias 'semantic-displayor-focus-previous #'semantic-displayer-focus-previous "27.1") -(cl-defmethod semantic-displayer-focus-previous ((obj semantic-displayer-abstract)) +(cl-defmethod semantic-displayer-focus-previous ((_obj semantic-displayer-abstract)) "Set the current focus to the previous item." nil) (define-obsolete-function-alias 'semantic-displayor-focus-next #'semantic-displayer-focus-next "27.1") -(cl-defmethod semantic-displayer-focus-next ((obj semantic-displayer-abstract)) +(cl-defmethod semantic-displayer-focus-next ((_obj semantic-displayer-abstract)) "Set the current focus to the next item." nil) (define-obsolete-function-alias 'semantic-displayor-current-focus #'semantic-displayer-current-focus "27.1") -(cl-defmethod semantic-displayer-current-focus ((obj semantic-displayer-abstract)) +(cl-defmethod semantic-displayer-current-focus ((_obj semantic-displayer-abstract)) "Return a single tag currently in focus. This object type doesn't do focus, so will never have a focus object." nil) @@ -1452,7 +1454,7 @@ which have the same name." (define-obsolete-function-alias 'semantic-displayor-set-completions #'semantic-displayer-set-completions "27.1") (cl-defmethod semantic-displayer-set-completions ((obj semantic-displayer-focus-abstract) - table prefix) + _table _prefix) "Set the list of tags to be completed over to TABLE." (cl-call-next-method) (slot-makeunbound obj 'focus)) @@ -1663,7 +1665,7 @@ This will not happen if you directly set this variable via `setq'." "Display completions options in a tooltip. Display mechanism using tooltip for a list of possible completions.") -(cl-defmethod initialize-instance :after ((obj semantic-displayer-tooltip) &rest args) +(cl-defmethod initialize-instance :after ((_obj semantic-displayer-tooltip) &rest _args) "Make sure we have tooltips required." (require 'tooltip)) @@ -1681,16 +1683,16 @@ Display mechanism using tooltip for a list of possible completions.") (table (semantic-unique-tag-table-by-name tablelong)) (completions (mapcar semantic-completion-displayer-format-tag-function table)) (numcompl (length completions)) - (typing-count (oref obj typing-count)) + ;; (typing-count (oref obj typing-count)) (mode (oref obj mode)) (max-tags (oref obj max-tags-initial)) (matchtxt (semantic-completion-text)) msg msg-tail) ;; Keep a count of the consecutive completion commands entered by the user. - (if (and (stringp (this-command-keys)) - (string= (this-command-keys) "\C-i")) - (oset obj typing-count (1+ (oref obj typing-count))) - (oset obj typing-count 0)) + (oset obj typing-count + (if (equal (this-command-keys) "\C-i") + (1+ (oref obj typing-count)) + 0)) (cond ((eq mode 'quiet) ;; Switch back to standard mode if user presses key more than 5 times. @@ -1730,7 +1732,7 @@ Display mechanism using tooltip for a list of possible completions.") (when semantic-idle-scheduler-verbose-flag (setq msg "[NO MATCH]")))) ;; Create the tooltip text. - (setq msg (concat msg (mapconcat 'identity completions "\n")))) + (setq msg (concat msg (mapconcat #'identity completions "\n")))) ;; Add any tail info. (setq msg (concat msg msg-tail)) ;; Display tooltip. @@ -1828,12 +1830,10 @@ text using overlay options.") (define-obsolete-function-alias 'semantic-displayor-set-completions #'semantic-displayer-set-completions "27.1") (cl-defmethod semantic-displayer-set-completions ((obj semantic-displayer-ghost) - table prefix) + _table _prefix) "Set the list of tags to be completed over to TABLE." (cl-call-next-method) - - (semantic-displayer-cleanup obj) - ) + (semantic-displayer-cleanup obj)) (define-obsolete-function-alias 'semantic-displayor-show-request @@ -2058,9 +2058,8 @@ prompts. these are calculated from the CONTEXT variable passed in." (semantic-displayer-traditional-with-focus-highlight) (with-current-buffer (oref context buffer) (goto-char (cdr (oref context bounds))) - (concat prompt (mapconcat 'identity syms ".") - (if syms "." "") - )) + (concat prompt (mapconcat #'identity syms ".") + (if syms "." ""))) nil inp history))) diff --git a/lisp/cedet/semantic/ctxt.el b/lisp/cedet/semantic/ctxt.el index 8d5b5dcdbdf..17ffaeff5e4 100644 --- a/lisp/cedet/semantic/ctxt.el +++ b/lisp/cedet/semantic/ctxt.el @@ -1,4 +1,4 @@ -;;; semantic/ctxt.el --- Context calculations for Semantic tools. +;;; semantic/ctxt.el --- Context calculations for Semantic tools -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2021 Free Software Foundation, Inc. @@ -137,18 +137,16 @@ Return non-nil if there is no upper context." (defmacro semantic-with-buffer-narrowed-to-context (&rest body) "Execute BODY with the buffer narrowed to the current context." + (declare (indent 0) (debug t)) `(save-restriction (semantic-narrow-to-context) ,@body)) -(put 'semantic-with-buffer-narrowed-to-context 'lisp-indent-function 0) -(add-hook 'edebug-setup-hook - (lambda () - (def-edebug-spec semantic-with-buffer-narrowed-to-context - (def-body)))) ;;; Local Variables ;; -;; + +(defvar semantic--progress-reporter) + (define-overloadable-function semantic-get-local-variables (&optional point) "Get the local variables based on POINT's context. Local variables are returned in Semantic tag format. @@ -345,14 +343,10 @@ beginning and end of a command." (defmacro semantic-with-buffer-narrowed-to-command (&rest body) "Execute BODY with the buffer narrowed to the current command." + (declare (indent 0) (debug t)) `(save-restriction (semantic-narrow-to-command) ,@body)) -(put 'semantic-with-buffer-narrowed-to-command 'lisp-indent-function 0) -(add-hook 'edebug-setup-hook - (lambda () - (def-edebug-spec semantic-with-buffer-narrowed-to-command - (def-body)))) (define-overloadable-function semantic-ctxt-end-of-symbol (&optional point) "Move point to the end of the current symbol under POINT. @@ -374,7 +368,7 @@ work on C like languages." ;; NOTE: The [ \n] expression below should used \\s-, but that ;; doesn't work in C since \n means end-of-comment, and isn't ;; really whitespace. - (fieldsep (concat "[ \t\n\r]*\\(" fieldsep1 "\\)[ \t\n\r]*\\(\\w\\|\\s_\\)")) + ;;(fieldsep (concat "[ \t\n\r]*\\(" fieldsep1 "\\)[ \t\n\r]*\\(\\w\\|\\s_\\)")) (case-fold-search semantic-case-fold) (continuesearch t) (end nil) @@ -655,7 +649,7 @@ POINT defaults to the value of point in current buffer. You should override this function in multiple mode buffers to determine which major mode apply at point.") -(defun semantic-ctxt-current-mode-default (&optional point) +(defun semantic-ctxt-current-mode-default (&optional _point) "Return the major mode active at POINT. POINT defaults to the value of point in current buffer. This default implementation returns the current major mode." @@ -671,7 +665,7 @@ The return value can be a mixed list of either strings (names of types that are in scope) or actual tags (type declared locally that may or may not have a name.)") -(defun semantic-ctxt-scoped-types-default (&optional point) +(defun semantic-ctxt-scoped-types-default (&optional _point) "Return a list of scoped types by name for the current context at POINT. This is very different for various languages, and does nothing unless overridden." diff --git a/lisp/cedet/semantic/db-debug.el b/lisp/cedet/semantic/db-debug.el index c553ab499ae..d8f7034f03a 100644 --- a/lisp/cedet/semantic/db-debug.el +++ b/lisp/cedet/semantic/db-debug.el @@ -1,6 +1,6 @@ -;;; semantic/db-debug.el --- Extra level debugging routines for Semantic +;;; semantic/db-debug.el --- Extra level debugging routines for Semantic -*- lexical-binding: t; -*- -;;; Copyright (C) 2008-2021 Free Software Foundation, Inc. +;; Copyright (C) 2008-2021 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> @@ -38,7 +38,7 @@ (data-debug-new-buffer "*SEMANTICDB*") (data-debug-insert-stuff-list db "*"))) -(defalias 'semanticdb-adebug-database-list 'semanticdb-dump-all-table-summary) +(defalias 'semanticdb-adebug-database-list #'semanticdb-dump-all-table-summary) (defun semanticdb-adebug-current-database () "Run ADEBUG on the current database." diff --git a/lisp/cedet/semantic/db-ebrowse.el b/lisp/cedet/semantic/db-ebrowse.el index 946f9ef6326..8bc3b810a65 100644 --- a/lisp/cedet/semantic/db-ebrowse.el +++ b/lisp/cedet/semantic/db-ebrowse.el @@ -1,4 +1,4 @@ -;;; semantic/db-ebrowse.el --- Semanticdb backend using ebrowse. +;;; semantic/db-ebrowse.el --- Semanticdb backend using ebrowse. -*- lexical-binding: t; -*- ;; Copyright (C) 2005-2021 Free Software Foundation, Inc. @@ -79,7 +79,7 @@ be searched." ;;; SEMANTIC Database related Code ;;; Classes: (defclass semanticdb-table-ebrowse (semanticdb-table) - ((major-mode :initform c++-mode) + ((major-mode :initform #'c++-mode) (ebrowse-tree :initform nil :initarg :ebrowse-tree :documentation @@ -95,7 +95,7 @@ This table is composited from the ebrowse *Globals* section.") (defclass semanticdb-project-database-ebrowse (semanticdb-project-database) - ((new-table-class :initform semanticdb-table-ebrowse + ((new-table-class :initform 'semanticdb-table-ebrowse :type class :documentation "New tables created for this database are of this class.") @@ -135,8 +135,8 @@ is specified by `semanticdb-default-save-directory'." (let* ((savein (semanticdb-ebrowse-file-for-directory dir)) (filebuff (get-buffer-create "*SEMANTICDB EBROWSE TMP*")) (files (directory-files (expand-file-name dir) t)) - (mma auto-mode-alist) - (regexp nil) + ;; (mma auto-mode-alist) + ;; (regexp nil) ) ;; Create the input to the ebrowse command (with-current-buffer filebuff @@ -222,12 +222,12 @@ warn instead." ;JAVE this just instantiates a default empty ebrowse struct? ; how would new instances wind up here? -; the ebrowse class isn't singleton, unlike the emacs lisp one +; the ebrowse class isn't singleton, unlike the Emacs Lisp one (defvar-mode-local c++-mode semanticdb-project-system-databases () "Search Ebrowse for symbols.") -(cl-defmethod semanticdb-needs-refresh-p ((table semanticdb-table-ebrowse)) +(cl-defmethod semanticdb-needs-refresh-p ((_table semanticdb-table-ebrowse)) "EBROWSE database do not need to be refreshed. JAVE: stub for needs-refresh, because, how do we know if BROWSE files @@ -274,7 +274,7 @@ For instance: /home/<username>/.semanticdb/!usr!include!BROWSE" (insert-file-contents B) (let ((ans nil) (efcn (symbol-function 'ebrowse-show-progress))) - (fset 'ebrowse-show-progress #'(lambda (&rest junk) nil)) + (fset 'ebrowse-show-progress (lambda (&rest _junk) nil)) (unwind-protect ;; Protect against errors w/ ebrowse (setq ans (list B (ebrowse-read))) ;; These items must always happen @@ -341,10 +341,10 @@ If there is no database for DIRECTORY available, then (while T (let* ((tree (car T)) - (class (ebrowse-ts-class tree)); root class of tree + ;;(class (ebrowse-ts-class tree)); root class of tree ;; Something funny going on with this file thing... - (filename (or (ebrowse-cs-source-file class) - (ebrowse-cs-file class))) + ;; (filename (or (ebrowse-cs-source-file class) + ;; (ebrowse-cs-file class))) ) (cond ((ebrowse-globals-tree-p tree) @@ -363,18 +363,18 @@ If there is no database for DIRECTORY available, then ;;; Filename based methods ;; -(defun semanticdb-ebrowse-add-globals-to-table (dbe tree) +(defun semanticdb-ebrowse-add-globals-to-table (_dbe tree) "For database DBE, add the ebrowse TREE into the table." (if (or (not (ebrowse-ts-p tree)) (not (ebrowse-globals-tree-p tree))) (signal 'wrong-type-argument (list 'ebrowse-ts-p tree))) (let* ((class (ebrowse-ts-class tree)) - (fname (or (ebrowse-cs-source-file class) - (ebrowse-cs-file class) - ;; Not def'd here, assume our current - ;; file - (concat default-directory "/unknown-proxy.hh"))) + ;; (fname (or (ebrowse-cs-source-file class) + ;; (ebrowse-cs-file class) + ;; ;; Not def'd here, assume our current + ;; ;; file + ;; (concat default-directory "/unknown-proxy.hh"))) (vars (ebrowse-ts-member-functions tree)) (fns (ebrowse-ts-member-variables tree)) (toks nil) @@ -573,7 +573,7 @@ return that." ;; how your new search routines are implemented. ;; (cl-defmethod semanticdb-find-tags-by-name-method - ((table semanticdb-table-ebrowse) name &optional tags) + ((_table semanticdb-table-ebrowse) _name &optional tags) "Find all tags named NAME in TABLE. Return a list of tags." ;;(message "semanticdb-find-tags-by-name-method name -- %s" name) @@ -588,7 +588,7 @@ Return a list of tags." ) (cl-defmethod semanticdb-find-tags-by-name-regexp-method - ((table semanticdb-table-ebrowse) regex &optional tags) + ((_table semanticdb-table-ebrowse) _regex &optional tags) "Find all tags with name matching REGEX in TABLE. Optional argument TAGS is a list of tags to search. Return a list of tags." @@ -598,7 +598,7 @@ Return a list of tags." )) (cl-defmethod semanticdb-find-tags-for-completion-method - ((table semanticdb-table-ebrowse) prefix &optional tags) + ((_table semanticdb-table-ebrowse) _prefix &optional tags) "In TABLE, find all occurrences of tags matching PREFIX. Optional argument TAGS is a list of tags to search. Returns a table of all matching tags." @@ -608,7 +608,7 @@ Returns a table of all matching tags." )) (cl-defmethod semanticdb-find-tags-by-class-method - ((table semanticdb-table-ebrowse) class &optional tags) + ((_table semanticdb-table-ebrowse) _class &optional tags) "In TABLE, find all occurrences of tags of CLASS. Optional argument TAGS is a list of tags to search. Returns a table of all matching tags." @@ -625,7 +625,7 @@ Returns a table of all matching tags." ;; (cl-defmethod semanticdb-deep-find-tags-by-name-method - ((table semanticdb-table-ebrowse) name &optional tags) + ((_table semanticdb-table-ebrowse) _name &optional _tags) "Find all tags name NAME in TABLE. Optional argument TAGS is a list of tags to search. Like `semanticdb-find-tags-by-name-method' for ebrowse." @@ -633,7 +633,7 @@ Like `semanticdb-find-tags-by-name-method' for ebrowse." (cl-call-next-method)) (cl-defmethod semanticdb-deep-find-tags-by-name-regexp-method - ((table semanticdb-table-ebrowse) regex &optional tags) + ((_table semanticdb-table-ebrowse) _regex &optional _tags) "Find all tags with name matching REGEX in TABLE. Optional argument TAGS is a list of tags to search. Like `semanticdb-find-tags-by-name-method' for ebrowse." @@ -641,7 +641,7 @@ Like `semanticdb-find-tags-by-name-method' for ebrowse." (cl-call-next-method)) (cl-defmethod semanticdb-deep-find-tags-for-completion-method - ((table semanticdb-table-ebrowse) prefix &optional tags) + ((_table semanticdb-table-ebrowse) _prefix &optional _tags) "In TABLE, find all occurrences of tags matching PREFIX. Optional argument TAGS is a list of tags to search. Like `semanticdb-find-tags-for-completion-method' for ebrowse." @@ -651,7 +651,7 @@ Like `semanticdb-find-tags-for-completion-method' for ebrowse." ;;; Advanced Searches ;; (cl-defmethod semanticdb-find-tags-external-children-of-type-method - ((table semanticdb-table-ebrowse) type &optional tags) + ((_table semanticdb-table-ebrowse) _type &optional tags) "Find all nonterminals which are child elements of TYPE Optional argument TAGS is a list of tags to search. Return a list of tags." diff --git a/lisp/cedet/semantic/db-el.el b/lisp/cedet/semantic/db-el.el index 4699e722c1a..41e48b0bc30 100644 --- a/lisp/cedet/semantic/db-el.el +++ b/lisp/cedet/semantic/db-el.el @@ -1,6 +1,6 @@ -;;; semantic/db-el.el --- Semantic database extensions for Emacs Lisp +;;; semantic/db-el.el --- Semantic database extensions for Emacs Lisp -*- lexical-binding: t; -*- -;;; Copyright (C) 2002-2021 Free Software Foundation, Inc. +;; Copyright (C) 2002-2021 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: tags @@ -40,7 +40,7 @@ ;;; Classes: (defclass semanticdb-table-emacs-lisp (semanticdb-abstract-table) - ((major-mode :initform emacs-lisp-mode) + ((major-mode :initform #'emacs-lisp-mode) ) "A table for returning search results from Emacs.") @@ -53,7 +53,7 @@ It does not need refreshing." "Return nil, we never need a refresh." nil) -(cl-defmethod semanticdb-debug-info ((obj semanticdb-table-emacs-lisp)) +(cl-defmethod semanticdb-debug-info ((_obj semanticdb-table-emacs-lisp)) (list "(proxy)")) (cl-defmethod cl-print-object ((obj semanticdb-table-emacs-lisp) stream) @@ -63,7 +63,7 @@ It does not need refreshing." (defclass semanticdb-project-database-emacs-lisp (semanticdb-project-database eieio-singleton) - ((new-table-class :initform semanticdb-table-emacs-lisp + ((new-table-class :initform 'semanticdb-table-emacs-lisp :type class :documentation "New tables created for this database are of this class.") @@ -195,9 +195,6 @@ If Emacs cannot resolve this symbol to a particular file, then return nil." (when tab (cons tab match)))))) (autoload 'help-function-arglist "help-fns") -(defalias 'semanticdb-elisp-sym-function-arglist 'help-function-arglist) -(make-obsolete 'semanticdb-elisp-sym-function-arglist - 'help-function-arglist "CEDET 1.1") (defun semanticdb-elisp-sym->tag (sym &optional toktype) "Convert SYM into a semantic tag. @@ -347,6 +344,9 @@ Return a list of tags." ) taglst)))) +(define-obsolete-function-alias 'semanticdb-elisp-sym-function-arglist + #'help-function-arglist "24.3") + (provide 'semantic/db-el) ;;; semantic/db-el.el ends here diff --git a/lisp/cedet/semantic/db-file.el b/lisp/cedet/semantic/db-file.el index 59e9db9cc0a..c9007ac7a02 100644 --- a/lisp/cedet/semantic/db-file.el +++ b/lisp/cedet/semantic/db-file.el @@ -1,6 +1,6 @@ -;;; semantic/db-file.el --- Save a semanticdb to a cache file. +;;; semantic/db-file.el --- Save a semanticdb to a cache file. -*- lexical-binding: t; -*- -;;; Copyright (C) 2000-2005, 2007-2021 Free Software Foundation, Inc. +;; Copyright (C) 2000-2021 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: tags @@ -154,8 +154,6 @@ If DIRECTORY doesn't exist, create a new one." ;;; File IO -(declare-function inversion-test "inversion") - (defun semanticdb-load-database (filename) "Load the database FILENAME." (condition-case foo @@ -163,32 +161,19 @@ If DIRECTORY doesn't exist, create a new one." 'semanticdb-project-database-file)) (c (semanticdb-get-database-tables r)) (tv (oref r semantic-tag-version)) - (fv (oref r semanticdb-version)) - ) + (fv (oref r semanticdb-version))) ;; Restore the parent-db connection (while c (oset (car c) parent-db r) (setq c (cdr c))) (unless (and (equal semanticdb-file-version fv) (equal semantic-tag-version tv)) - ;; Try not to load inversion unless we need it: - (require 'inversion) - (if (not (inversion-test 'semanticdb-file fv)) - (when (inversion-test 'semantic-tag tv) - ;; Incompatible version. Flush tables. - (semanticdb-flush-database-tables r) - ;; Reset the version to new version. - (oset r semantic-tag-version semantic-tag-version) - ;; Warn user - (message "Semanticdb file is old. Starting over for %s" - filename)) - ;; Version is not ok. Flush whole system - (message "semanticdb file is old. Starting over for %s" - filename) - ;; This database is so old, we need to replace it. - ;; We also need to delete it from the instance tracker. - (delete-instance r) - (setq r nil))) + ;; Version is not ok. Flush whole system + (message "semanticdb file is old. Starting over for %s" filename) + ;; This database is so old, we need to replace it. + ;; We also need to delete it from the instance tracker. + (delete-instance r) + (setq r nil)) r) (error (message "Cache Error: [%s] %s, Restart" filename foo) @@ -373,13 +358,13 @@ Uses `semanticdb-persistent-path' to determine the return value." (object-assoc (file-name-nondirectory filename) 'file (oref obj tables))) (cl-defmethod semanticdb-file-name-non-directory - ((dbclass (subclass semanticdb-project-database-file))) + ((_dbclass (subclass semanticdb-project-database-file))) "Return the file name DBCLASS will use. File name excludes any directory part." semanticdb-default-file-name) (cl-defmethod semanticdb-file-name-directory - ((dbclass (subclass semanticdb-project-database-file)) directory) + ((_dbclass (subclass semanticdb-project-database-file)) directory) "Return the relative directory to where DBCLASS will save its cache file. The returned path is related to DIRECTORY." (if semanticdb-default-save-directory diff --git a/lisp/cedet/semantic/db-find.el b/lisp/cedet/semantic/db-find.el index db88463bfd1..c96a426280e 100644 --- a/lisp/cedet/semantic/db-find.el +++ b/lisp/cedet/semantic/db-find.el @@ -1,4 +1,4 @@ -;;; semantic/db-find.el --- Searching through semantic databases. +;;; semantic/db-find.el --- Searching through semantic databases. -*- lexical-binding: t; -*- ;; Copyright (C) 2000-2021 Free Software Foundation, Inc. @@ -209,14 +209,14 @@ This class will cache data derived during various searches.") ) (cl-defmethod semanticdb-synchronize ((idx semanticdb-find-search-index) - new-tags) + _new-tags) "Synchronize the search index IDX with some NEW-TAGS." ;; Reset our parts. (semantic-reset idx) ;; Notify dependants by clearing their indices. (semanticdb-notify-references (oref idx table) - (lambda (tab me) + (lambda (tab _me) (semantic-reset (semanticdb-get-table-index tab)))) ) @@ -230,7 +230,7 @@ This class will cache data derived during various searches.") ;; Notify dependants by clearing their indices. (semanticdb-notify-references (oref idx table) - (lambda (tab me) + (lambda (tab _me) (semantic-reset (semanticdb-get-table-index tab)))) ) ;; Else, not an include, by just a type. @@ -240,7 +240,7 @@ This class will cache data derived during various searches.") ;; Notify dependants by clearing their indices. (semanticdb-notify-references (oref idx table) - (lambda (tab me) + (lambda (tab _me) (let ((tab-idx (semanticdb-get-table-index tab))) ;; Not a full reset? (when (oref tab-idx type-cache) @@ -791,7 +791,8 @@ PREBUTTONTEXT is some text between prefix and the overlay button." (file (semantic-tag-file-name tag)) (str1 (format "%S %s" mode name)) (str2 (format " : %s" file)) - (tip nil)) + ;; (tip nil) + ) (insert prefix prebuttontext str1) (setq end (point)) (insert str2) @@ -807,7 +808,7 @@ PREBUTTONTEXT is some text between prefix and the overlay button." (put-text-property start end 'ddebug (cdr consdata)) (put-text-property start end 'ddebug-indent(length prefix)) (put-text-property start end 'ddebug-prefix prefix) - (put-text-property start end 'help-echo tip) + ;; (put-text-property start end 'help-echo tip) (put-text-property start end 'ddebug-function 'data-debug-insert-tag-parts-from-point) (insert "\n") @@ -1009,7 +1010,7 @@ is still made current." (when norm ;; The normalized tags can now be found based on that ;; tags table. - (condition-case foo + (condition-case nil (progn (semanticdb-set-buffer (car norm)) ;; Now reset ans diff --git a/lisp/cedet/semantic/db-global.el b/lisp/cedet/semantic/db-global.el index 2f40082d53c..fad24485ed2 100644 --- a/lisp/cedet/semantic/db-global.el +++ b/lisp/cedet/semantic/db-global.el @@ -1,4 +1,4 @@ -;;; semantic/db-global.el --- Semantic database extensions for GLOBAL +;;; semantic/db-global.el --- Semantic database extensions for GLOBAL -*- lexical-binding: t; -*- ;; Copyright (C) 2002-2006, 2008-2021 Free Software Foundation, Inc. @@ -56,7 +56,7 @@ values." (interactive (list (completing-read "Enable in Mode: " obarray - #'(lambda (s) (get s 'mode-local-symbol-table)) + (lambda (s) (get s 'mode-local-symbol-table)) t (symbol-name major-mode)))) ;; First, make sure the version is ok. @@ -69,7 +69,8 @@ values." (let ((semanticdb--ih (mode-local-value mode 'semantic-init-mode-hook))) (eval `(setq-mode-local ,mode semantic-init-mode-hook - (cons 'semanticdb-enable-gnu-global-hook semanticdb--ih)))) + (cons 'semanticdb-enable-gnu-global-hook ',semanticdb--ih)) + t)) t ) ) @@ -114,7 +115,7 @@ if optional DONT-ERR-IF-NOT-AVAILABLE is non-nil; else throw an error." ) "A table for returning search results from GNU Global.") -(cl-defmethod semanticdb-debug-info ((obj semanticdb-table-global)) +(cl-defmethod semanticdb-debug-info ((_obj semanticdb-table-global)) (list "(proxy)")) (cl-defmethod cl-print-object ((obj semanticdb-table-global) stream) @@ -123,7 +124,7 @@ Adds the number of tags in this file to the object print name." (princ (eieio-object-name obj (semanticdb-debug-info obj)) stream)) -(cl-defmethod semanticdb-equivalent-mode ((table semanticdb-table-global) &optional buffer) +(cl-defmethod semanticdb-equivalent-mode ((_table semanticdb-table-global) &optional _buffer) "Return t, pretend that this table's mode is equivalent to BUFFER. Equivalent modes are specified by the `semantic-equivalent-major-modes' local variable." @@ -146,7 +147,7 @@ For each file hit, get the traditional semantic table from that file." (cl-call-next-method)) -(cl-defmethod semanticdb-file-table ((obj semanticdb-project-database-global) filename) +(cl-defmethod semanticdb-file-table ((obj semanticdb-project-database-global) _filename) "From OBJ, return FILENAME's associated table object." ;; We pass in "don't load". I wonder if we need to avoid that or not? (car (semanticdb-get-database-tables obj)) @@ -157,7 +158,7 @@ For each file hit, get the traditional semantic table from that file." ;; Only NAME based searches work with GLOBAL as that is all it tracks. ;; (cl-defmethod semanticdb-find-tags-by-name-method - ((table semanticdb-table-global) name &optional tags) + ((_table semanticdb-table-global) name &optional tags) "Find all tags named NAME in TABLE. Return a list of tags." (if tags @@ -174,7 +175,7 @@ Return a list of tags." ))) (cl-defmethod semanticdb-find-tags-by-name-regexp-method - ((table semanticdb-table-global) regex &optional tags) + ((_table semanticdb-table-global) regex &optional tags) "Find all tags with name matching REGEX in TABLE. Optional argument TAGS is a list of tags to search. Return a list of tags." @@ -187,7 +188,7 @@ Return a list of tags." ))) (cl-defmethod semanticdb-find-tags-for-completion-method - ((table semanticdb-table-global) prefix &optional tags) + ((_table semanticdb-table-global) prefix &optional tags) "In TABLE, find all occurrences of tags matching PREFIX. Optional argument TAGS is a list of tags to search. Returns a table of all matching tags." diff --git a/lisp/cedet/semantic/db-javascript.el b/lisp/cedet/semantic/db-javascript.el index 2b138866215..bf3d6122954 100644 --- a/lisp/cedet/semantic/db-javascript.el +++ b/lisp/cedet/semantic/db-javascript.el @@ -1,4 +1,4 @@ -;;; semantic/db-javascript.el --- Semantic database extensions for javascript +;;; semantic/db-javascript.el --- Semantic database extensions for javascript -*- lexical-binding: t; -*- ;; Copyright (C) 2002-2021 Free Software Foundation, Inc. @@ -80,7 +80,7 @@ See bottom of this file for instructions on managing this list.") ;;; Classes: (defclass semanticdb-table-javascript (semanticdb-search-results-table) - ((major-mode :initform javascript-mode) + ((major-mode :initform #'javascript-mode) ) "A table for returning search results from javascript.") @@ -88,7 +88,7 @@ See bottom of this file for instructions on managing this list.") (semanticdb-project-database eieio-singleton ;this db is for js globals, so singleton is appropriate ) - ((new-table-class :initform semanticdb-table-javascript + ((new-table-class :initform 'semanticdb-table-javascript :type class :documentation "New tables created for this database are of this class.") @@ -129,20 +129,20 @@ Create one of our special tables that can act as an intermediary." (cl-call-next-method) ) -(cl-defmethod semanticdb-file-table ((obj semanticdb-project-database-javascript) filename) +(cl-defmethod semanticdb-file-table ((obj semanticdb-project-database-javascript) _filename) "From OBJ, return FILENAME's associated table object." ;; NOTE: See not for `semanticdb-get-database-tables'. (car (semanticdb-get-database-tables obj)) ) -(cl-defmethod semanticdb-get-tags ((table semanticdb-table-javascript )) +(cl-defmethod semanticdb-get-tags ((_table semanticdb-table-javascript )) "Return the list of tags belonging to TABLE." ;; NOTE: Omniscient databases probably don't want to keep large tables ;; lolly-gagging about. Keep internal Emacs tables empty and ;; refer to alternate databases when you need something. semanticdb-javascript-tags) -(cl-defmethod semanticdb-equivalent-mode ((table semanticdb-table-javascript) &optional buffer) +(cl-defmethod semanticdb-equivalent-mode ((_table semanticdb-table-javascript) &optional buffer) "Return non-nil if TABLE's mode is equivalent to BUFFER. Equivalent modes are specified by the `semantic-equivalent-major-modes' local variable." @@ -193,7 +193,7 @@ database (if available.)" result)) (cl-defmethod semanticdb-find-tags-by-name-method - ((table semanticdb-table-javascript) name &optional tags) + ((_table semanticdb-table-javascript) name &optional tags) "Find all tags named NAME in TABLE. Return a list of tags." (if tags @@ -203,7 +203,7 @@ Return a list of tags." )) (cl-defmethod semanticdb-find-tags-by-name-regexp-method - ((table semanticdb-table-javascript) regex &optional tags) + ((_table semanticdb-table-javascript) regex &optional tags) "Find all tags with name matching REGEX in TABLE. Optional argument TAGS is a list of tags to search. Return a list of tags." @@ -214,7 +214,7 @@ Return a list of tags." )) (cl-defmethod semanticdb-find-tags-for-completion-method - ((table semanticdb-table-javascript) prefix &optional tags) + ((_table semanticdb-table-javascript) prefix &optional tags) "In TABLE, find all occurrences of tags matching PREFIX. Optional argument TAGS is a list of tags to search. Returns a table of all matching tags." @@ -224,7 +224,7 @@ Returns a table of all matching tags." )) (cl-defmethod semanticdb-find-tags-by-class-method - ((table semanticdb-table-javascript) class &optional tags) + ((_table semanticdb-table-javascript) _class &optional tags) "In TABLE, find all occurrences of tags of CLASS. Optional argument TAGS is a list of tags to search. Returns a table of all matching tags." @@ -268,7 +268,7 @@ Like `semanticdb-find-tags-for-completion-method' for javascript." ;;; Advanced Searches ;; (cl-defmethod semanticdb-find-tags-external-children-of-type-method - ((table semanticdb-table-javascript) type &optional tags) + ((_table semanticdb-table-javascript) _type &optional tags) "Find all nonterminals which are child elements of TYPE. Optional argument TAGS is a list of tags to search. Return a list of tags." diff --git a/lisp/cedet/semantic/db-mode.el b/lisp/cedet/semantic/db-mode.el index aa4634faa98..839dcb8172d 100644 --- a/lisp/cedet/semantic/db-mode.el +++ b/lisp/cedet/semantic/db-mode.el @@ -1,4 +1,4 @@ -;;; semantic/db-mode.el --- Semanticdb Minor Mode +;;; semantic/db-mode.el --- Semanticdb Minor Mode -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. diff --git a/lisp/cedet/semantic/db-ref.el b/lisp/cedet/semantic/db-ref.el index da09f9830a7..10108d39772 100644 --- a/lisp/cedet/semantic/db-ref.el +++ b/lisp/cedet/semantic/db-ref.el @@ -1,6 +1,6 @@ -;;; semantic/db-ref.el --- Handle cross-db file references +;;; semantic/db-ref.el --- Handle cross-db file references -*- lexical-binding: t; -*- -;;; Copyright (C) 2007-2021 Free Software Foundation, Inc. +;; Copyright (C) 2007-2021 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> @@ -67,7 +67,7 @@ will be added to the database that INCLUDE-TAG refers to." (object-add-to-list refdbt 'db-refs dbt) t))) -(cl-defmethod semanticdb-check-references ((dbt semanticdb-abstract-table)) +(cl-defmethod semanticdb-check-references ((_dbt semanticdb-abstract-table)) "Check and cleanup references in the database DBT. Abstract tables would be difficult to reference." ;; Not sure how an abstract table can have references. @@ -109,7 +109,7 @@ refers to DBT will be removed." )) (setq refs (cdr refs))))) -(cl-defmethod semanticdb-refresh-references ((dbt semanticdb-abstract-table)) +(cl-defmethod semanticdb-refresh-references ((_dbt semanticdb-abstract-table)) "Refresh references to DBT in other files." ;; alternate tables can't be edited, so can't be changed. nil diff --git a/lisp/cedet/semantic/db-typecache.el b/lisp/cedet/semantic/db-typecache.el index 8c394cd7fa9..c0fee3b2bd9 100644 --- a/lisp/cedet/semantic/db-typecache.el +++ b/lisp/cedet/semantic/db-typecache.el @@ -1,4 +1,4 @@ -;;; semantic/db-typecache.el --- Manage Datatypes +;;; semantic/db-typecache.el --- Manage Datatypes -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. @@ -74,14 +74,14 @@ Said object must support `semantic-reset' methods.") (oset tc stream nil) - (mapc 'semantic-reset (oref tc dependants)) + (mapc #'semantic-reset (oref tc dependants)) (oset tc dependants nil) ) (cl-defmethod semanticdb-typecache-notify-reset ((tc semanticdb-typecache)) "Do a reset from a notify from a table we depend on." (oset tc includestream nil) - (mapc 'semantic-reset (oref tc dependants)) + (mapc #'semantic-reset (oref tc dependants)) (oset tc dependants nil) ) @@ -90,7 +90,7 @@ Said object must support `semantic-reset' methods.") "Reset the typecache based on a partial reparse." (when (semantic-find-tags-by-class 'include new-tags) (oset tc includestream nil) - (mapc 'semantic-reset (oref tc dependants)) + (mapc #'semantic-reset (oref tc dependants)) (oset tc dependants nil) ) @@ -167,15 +167,15 @@ If there is no table, create one, and fill it in." (oset tc stream nil) ) -(cl-defmethod semanticdb-synchronize ((cache semanticdb-database-typecache) - new-tags) +(cl-defmethod semanticdb-synchronize ((_cache semanticdb-database-typecache) + _new-tags) "Synchronize a CACHE with some NEW-TAGS." - ) + nil) -(cl-defmethod semanticdb-partial-synchronize ((cache semanticdb-database-typecache) - new-tags) +(cl-defmethod semanticdb-partial-synchronize ((_cache semanticdb-database-typecache) + _new-tags) "Synchronize a CACHE with some changed NEW-TAGS." - ) + nil) (cl-defmethod semanticdb-get-typecache ((db semanticdb-project-database)) "Retrieve the typecache from the semantic database DB. @@ -312,7 +312,7 @@ If TAG has fully qualified names, expand it to a series of nested namespaces instead." tag) -(cl-defmethod semanticdb-typecache-file-tags ((table semanticdb-abstract-table)) +(cl-defmethod semanticdb-typecache-file-tags ((_table semanticdb-abstract-table)) "No tags available from non-file based tables." nil) @@ -338,7 +338,7 @@ all included files." (oref cache filestream) )) -(cl-defmethod semanticdb-typecache-include-tags ((table semanticdb-abstract-table)) +(cl-defmethod semanticdb-typecache-include-tags ((_table semanticdb-abstract-table)) "No tags available from non-file based tables." nil) @@ -611,7 +611,7 @@ If there isn't one, create it. (require 'data-debug) (let* ((tab semanticdb-current-table) (idx (semanticdb-get-table-index tab)) - (junk (oset idx type-cache nil)) ;; flush! + (_ (oset idx type-cache nil)) ;; flush! (start (current-time)) (tc (semanticdb-typecache-for-database (oref tab parent-db))) (end (current-time)) diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el index 8f9eceea554..38e2b34b0db 100644 --- a/lisp/cedet/semantic/db.el +++ b/lisp/cedet/semantic/db.el @@ -321,12 +321,12 @@ Adds the number of tags in this file to the object print name." '(list-of semanticdb-abstract-table)) (defclass semanticdb-project-database (eieio-instance-tracker) - ((tracking-symbol :initform semanticdb-database-list) + ((tracking-symbol :initform 'semanticdb-database-list) (reference-directory :type string :documentation "Directory this database refers to. When a cache directory is specified, then this refers to the directory this database contains symbols for.") - (new-table-class :initform semanticdb-table + (new-table-class :initform 'semanticdb-table :type class :documentation "New tables created for this database are of this class.") diff --git a/lisp/cedet/semantic/debug.el b/lisp/cedet/semantic/debug.el index ce4afbbf26d..4f96746166b 100644 --- a/lisp/cedet/semantic/debug.el +++ b/lisp/cedet/semantic/debug.el @@ -1,4 +1,4 @@ -;;; semantic/debug.el --- Language Debugger framework +;;; semantic/debug.el --- Language Debugger framework -*- lexical-binding: t; -*- ;; Copyright (C) 2003-2005, 2008-2021 Free Software Foundation, Inc. @@ -265,12 +265,12 @@ on different types of return values." ) "One frame representation.") -(cl-defmethod semantic-debug-frame-highlight ((frame semantic-debug-frame)) +(cl-defmethod semantic-debug-frame-highlight ((_frame semantic-debug-frame)) "Highlight one parser frame." ) -(cl-defmethod semantic-debug-frame-info ((frame semantic-debug-frame)) +(cl-defmethod semantic-debug-frame-info ((_frame semantic-debug-frame)) "Display info about this one parser frame." ) @@ -279,21 +279,21 @@ on different types of return values." ;; (defvar semantic-debug-mode-map (let ((km (make-sparse-keymap))) - (define-key km "n" 'semantic-debug-next) - (define-key km " " 'semantic-debug-next) - (define-key km "s" 'semantic-debug-step) - (define-key km "u" 'semantic-debug-up) - (define-key km "d" 'semantic-debug-down) - (define-key km "f" 'semantic-debug-fail-match) - (define-key km "h" 'semantic-debug-print-state) - (define-key km "s" 'semantic-debug-jump-to-source) - (define-key km "p" 'semantic-debug-jump-to-parser) - (define-key km "q" 'semantic-debug-quit) - (define-key km "a" 'semantic-debug-abort) - (define-key km "g" 'semantic-debug-go) - (define-key km "b" 'semantic-debug-set-breakpoint) + (define-key km "n" #'semantic-debug-next) + (define-key km " " #'semantic-debug-next) + (define-key km "s" #'semantic-debug-step) + (define-key km "u" #'semantic-debug-up) + (define-key km "d" #'semantic-debug-down) + (define-key km "f" #'semantic-debug-fail-match) + (define-key km "h" #'semantic-debug-print-state) + (define-key km "s" #'semantic-debug-jump-to-source) + (define-key km "p" #'semantic-debug-jump-to-parser) + (define-key km "q" #'semantic-debug-quit) + (define-key km "a" #'semantic-debug-abort) + (define-key km "g" #'semantic-debug-go) + (define-key km "b" #'semantic-debug-set-breakpoint) ;; Some boring bindings. - (define-key km "e" 'eval-expression) + (define-key km "e" #'eval-expression) km) "Keymap used when in semantic-debug-node.") @@ -514,49 +514,49 @@ by overriding one of the command methods. Be sure to use down to your parser later." :abstract t) -(cl-defmethod semantic-debug-parser-next ((parser semantic-debug-parser)) +(cl-defmethod semantic-debug-parser-next ((_parser semantic-debug-parser)) "Execute next for this PARSER." (setq semantic-debug-user-command 'next) ) -(cl-defmethod semantic-debug-parser-step ((parser semantic-debug-parser)) +(cl-defmethod semantic-debug-parser-step ((_parser semantic-debug-parser)) "Execute a step for this PARSER." (setq semantic-debug-user-command 'step) ) -(cl-defmethod semantic-debug-parser-go ((parser semantic-debug-parser)) +(cl-defmethod semantic-debug-parser-go ((_parser semantic-debug-parser)) "Continue execution in this PARSER until the next breakpoint." (setq semantic-debug-user-command 'go) ) -(cl-defmethod semantic-debug-parser-fail ((parser semantic-debug-parser)) +(cl-defmethod semantic-debug-parser-fail ((_parser semantic-debug-parser)) "Continue execution in this PARSER until the next breakpoint." (setq semantic-debug-user-command 'fail) ) -(cl-defmethod semantic-debug-parser-quit ((parser semantic-debug-parser)) +(cl-defmethod semantic-debug-parser-quit ((_parser semantic-debug-parser)) "Continue execution in this PARSER until the next breakpoint." (setq semantic-debug-user-command 'quit) ) -(cl-defmethod semantic-debug-parser-abort ((parser semantic-debug-parser)) +(cl-defmethod semantic-debug-parser-abort ((_parser semantic-debug-parser)) "Continue execution in this PARSER until the next breakpoint." (setq semantic-debug-user-command 'abort) ) -(cl-defmethod semantic-debug-parser-print-state ((parser semantic-debug-parser)) +(cl-defmethod semantic-debug-parser-print-state ((_parser semantic-debug-parser)) "Print state for this PARSER at the current breakpoint." (with-slots (current-frame) semantic-debug-current-interface (when current-frame (semantic-debug-frame-info current-frame) ))) -(cl-defmethod semantic-debug-parser-break ((parser semantic-debug-parser)) +(cl-defmethod semantic-debug-parser-break ((_parser semantic-debug-parser)) "Set a breakpoint for this PARSER." ) ;; Stack stuff -(cl-defmethod semantic-debug-parser-frames ((parser semantic-debug-parser)) +(cl-defmethod semantic-debug-parser-frames ((_parser semantic-debug-parser)) "Return a list of frames for the current parser. A frame is of the form: ( .. .what ? .. ) diff --git a/lisp/cedet/semantic/decorate.el b/lisp/cedet/semantic/decorate.el index 53c54ab4cc8..3e6651df152 100644 --- a/lisp/cedet/semantic/decorate.el +++ b/lisp/cedet/semantic/decorate.el @@ -1,7 +1,6 @@ -;;; semantic/decorate.el --- Utilities for decorating/highlighting tokens. +;;; semantic/decorate.el --- Utilities for decorating/highlighting tokens. -*- lexical-binding: t; -*- -;;; Copyright (C) 1999-2003, 2005-2007, 2009-2021 Free Software -;;; Foundation, Inc. +;; Copyright (C) 1999-2021 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: syntax @@ -51,7 +50,7 @@ Optional FACE specifies the face to use." )) ;;; Momentary Highlighting - One line -(defun semantic-momentary-highlight-one-tag-line (tag &optional face) +(defun semantic-momentary-highlight-one-tag-line (tag &optional _face) "Highlight the first line of TAG, unhighlighting before next command. Optional argument FACE specifies the face to do the highlighting." (save-excursion @@ -88,7 +87,7 @@ If VISIBLE is non-nil, make the text visible." (overlay-get (semantic-tag-overlay tag) 'invisible)) (defun semantic-overlay-signal-read-only - (overlay after start end &optional len) + (overlay after start end &optional _len) "Hook used in modification hooks to prevent modification. Allows deletion of the entire text. Argument OVERLAY, AFTER, START, END, and LEN are passed in by the system." @@ -261,7 +260,7 @@ nil implies the tag should be fully shown." (declare-function semantic-current-tag "semantic/find") -(defun semantic-set-tag-folded-isearch (overlay) +(defun semantic-set-tag-folded-isearch (_overlay) "Called by isearch if it discovers text in the folded region. OVERLAY is passed in by isearch." (semantic-set-tag-folded (semantic-current-tag) nil) diff --git a/lisp/cedet/semantic/decorate/include.el b/lisp/cedet/semantic/decorate/include.el index ee7fad1fc5f..a3bf4e252f7 100644 --- a/lisp/cedet/semantic/decorate/include.el +++ b/lisp/cedet/semantic/decorate/include.el @@ -1,4 +1,4 @@ -;;; semantic/decorate/include.el --- Decoration modes for include statements +;;; semantic/decorate/include.el --- Decoration modes for include statements -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -55,7 +55,7 @@ Used by the decoration style: `semantic-decoration-on-includes'." (defvar semantic-decoration-on-include-map (let ((km (make-sparse-keymap))) - (define-key km semantic-decoration-mouse-3 'semantic-decoration-include-menu) + (define-key km semantic-decoration-mouse-3 #'semantic-decoration-include-menu) km) "Keymap used on includes.") @@ -114,7 +114,7 @@ Used by the decoration style: `semantic-decoration-on-unknown-includes'." (defvar semantic-decoration-on-unknown-include-map (let ((km (make-sparse-keymap))) ;(define-key km [ mouse-2 ] 'semantic-decoration-unknown-include-describe) - (define-key km semantic-decoration-mouse-3 'semantic-decoration-unknown-include-menu) + (define-key km semantic-decoration-mouse-3 #'semantic-decoration-unknown-include-menu) km) "Keymap used on unparsed includes.") @@ -169,7 +169,7 @@ Used by the decoration style: `semantic-decoration-on-fileless-includes'." (defvar semantic-decoration-on-fileless-include-map (let ((km (make-sparse-keymap))) ;(define-key km [ mouse-2 ] 'semantic-decoration-fileless-include-describe) - (define-key km semantic-decoration-mouse-3 'semantic-decoration-fileless-include-menu) + (define-key km semantic-decoration-mouse-3 #'semantic-decoration-fileless-include-menu) km) "Keymap used on unparsed includes.") @@ -223,7 +223,7 @@ Used by the decoration style: `semantic-decoration-on-unparsed-includes'." (defvar semantic-decoration-on-unparsed-include-map (let ((km (make-sparse-keymap))) - (define-key km semantic-decoration-mouse-3 'semantic-decoration-unparsed-include-menu) + (define-key km semantic-decoration-mouse-3 #'semantic-decoration-unparsed-include-menu) km) "Keymap used on unparsed includes.") @@ -535,7 +535,7 @@ Argument EVENT is the mouse clicked event." (interactive) (let* ((tag (semantic-current-tag)) (table (semanticdb-find-table-for-include tag (current-buffer))) - (mm major-mode)) + ) ;; (mm major-mode) (with-output-to-temp-buffer (help-buffer) ; "*Help*" (help-setup-xref (list #'semantic-decoration-fileless-include-describe) (called-interactively-p 'interactive)) @@ -793,7 +793,7 @@ any decorated referring includes.") (let ((table (oref obj table))) ;; This is a hack. Add in something better? (semanticdb-notify-references - table (lambda (tab me) + table (lambda (tab _me) (semantic-decoration-unparsed-include-refrence-reset tab) )) )) @@ -805,7 +805,7 @@ any decorated referring includes.") (semantic-reset cache))) (cl-defmethod semanticdb-synchronize ((cache semantic-decoration-unparsed-include-cache) - new-tags) + _new-tags) "Synchronize a CACHE with some NEW-TAGS." (semantic-reset cache)) diff --git a/lisp/cedet/semantic/decorate/mode.el b/lisp/cedet/semantic/decorate/mode.el index 884b066d77f..c6bf15205fd 100644 --- a/lisp/cedet/semantic/decorate/mode.el +++ b/lisp/cedet/semantic/decorate/mode.el @@ -1,4 +1,4 @@ -;;; semantic/decorate/mode.el --- Minor mode for decorating tags +;;; semantic/decorate/mode.el --- Minor mode for decorating tags -*- lexical-binding: t; -*- ;; Copyright (C) 2000-2005, 2007-2021 Free Software Foundation, Inc. @@ -254,7 +254,7 @@ available and the current buffer was set up for parsing. Return non-nil if the minor mode is enabled." ;; ;;\\{semantic-decoration-map}" - nil nil nil + :lighter nil (if semantic-decoration-mode (if (not (and (featurep 'semantic) (semantic-active-p))) (progn @@ -264,9 +264,9 @@ non-nil if the minor mode is enabled." (buffer-name))) ;; Add hooks (add-hook 'semantic-after-partial-cache-change-hook - 'semantic-decorate-tags-after-partial-reparse nil t) + #'semantic-decorate-tags-after-partial-reparse nil t) (add-hook 'semantic-after-toplevel-cache-change-hook - 'semantic-decorate-tags-after-full-reparse nil t) + #'semantic-decorate-tags-after-full-reparse nil t) ;; Add decorations to available tags. The above hooks ensure ;; that new tags will be decorated when they become available. ;; However, don't do this immediately, because EDE will be @@ -282,9 +282,9 @@ non-nil if the minor mode is enabled." (semantic-decorate-flush-decorations) ;; Remove hooks (remove-hook 'semantic-after-partial-cache-change-hook - 'semantic-decorate-tags-after-partial-reparse t) + #'semantic-decorate-tags-after-partial-reparse t) (remove-hook 'semantic-after-toplevel-cache-change-hook - 'semantic-decorate-tags-after-full-reparse t))) + #'semantic-decorate-tags-after-full-reparse t))) (semantic-add-minor-mode 'semantic-decoration-mode "") @@ -350,20 +350,18 @@ Return non-nil if the decoration style is enabled." (defun semantic-decoration-build-style-menu (style) "Build a menu item for controlling a specific decoration STYLE." - (vector (car style) - `(lambda () (interactive) - (semantic-toggle-decoration-style - ,(car style))) - :style 'toggle - :selected `(semantic-decoration-style-enabled-p ,(car style)) - )) - -(defun semantic-build-decoration-mode-menu (&rest ignore) + (let ((s (car style))) + (vector s + (lambda () (interactive) (semantic-toggle-decoration-style s)) + :style 'toggle + :selected `(semantic-decoration-style-enabled-p ',s)))) + +(defun semantic-build-decoration-mode-menu (&rest _ignore) "Create a menu listing all the known decorations for toggling. IGNORE any input arguments." (or semantic-decoration-menu-cache (setq semantic-decoration-menu-cache - (mapcar 'semantic-decoration-build-style-menu + (mapcar #'semantic-decoration-build-style-menu (reverse semantic-decoration-styles)) ))) diff --git a/lisp/cedet/semantic/dep.el b/lisp/cedet/semantic/dep.el index db8be5ecf47..efebe21a945 100644 --- a/lisp/cedet/semantic/dep.el +++ b/lisp/cedet/semantic/dep.el @@ -1,4 +1,4 @@ -;;; semantic/dep.el --- Methods for tracking dependencies (include files) +;;; semantic/dep.el --- Methods for tracking dependencies (include files) -*- lexical-binding: t; -*- ;; Copyright (C) 2006-2021 Free Software Foundation, Inc. @@ -123,12 +123,12 @@ Changes made by this function are not persistent." (if (not mode) (setq mode major-mode)) (let ((dirtmp (file-name-as-directory dir)) (value - (mode-local-value mode 'semantic-dependency-system-include-path)) - ) - (add-to-list 'value dirtmp t) + (mode-local-value mode 'semantic-dependency-system-include-path))) (eval `(setq-mode-local ,mode - semantic-dependency-system-include-path value)) - )) + semantic-dependency-system-include-path + ',(if (member dirtmp value) value + (append value (list dirtmp)))) + t))) ;;;###autoload (defun semantic-remove-system-include (dir &optional mode) @@ -146,10 +146,10 @@ Changes made by this function are not persistent." (value (mode-local-value mode 'semantic-dependency-system-include-path)) ) - (setq value (delete dirtmp value)) + (setq value (remove dirtmp value)) (eval `(setq-mode-local ,mode semantic-dependency-system-include-path - value)) - )) + ',value) + t))) ;;;###autoload (defun semantic-reset-system-include (&optional mode) @@ -157,10 +157,10 @@ Changes made by this function are not persistent." Modifies a mode-local version of `semantic-dependency-system-include-path'." (interactive) - (if (not mode) (setq mode major-mode)) - (eval `(setq-mode-local ,mode semantic-dependency-system-include-path - nil)) - ) + (eval `(setq-mode-local ,(or mode major-mode) + semantic-dependency-system-include-path + nil) + t)) ;;;###autoload (defun semantic-customize-system-include-path (&optional mode) diff --git a/lisp/cedet/semantic/doc.el b/lisp/cedet/semantic/doc.el index d4dd9286421..413ed83a154 100644 --- a/lisp/cedet/semantic/doc.el +++ b/lisp/cedet/semantic/doc.el @@ -1,4 +1,4 @@ -;;; semantic/doc.el --- Routines for documentation strings +;;; semantic/doc.el --- Routines for documentation strings -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2003, 2005, 2008-2021 Free Software Foundation, ;; Inc. @@ -85,7 +85,7 @@ just the lexical token and not the string." )) (define-obsolete-function-alias 'semantic-documentation-comment-preceeding-tag - 'semantic-documentation-comment-preceding-tag + #'semantic-documentation-comment-preceding-tag "25.1") (defun semantic-doc-snarf-comment-for-tag (nosnarf) diff --git a/lisp/cedet/semantic/ede-grammar.el b/lisp/cedet/semantic/ede-grammar.el index bd0795acbd6..19d4184fa45 100644 --- a/lisp/cedet/semantic/ede-grammar.el +++ b/lisp/cedet/semantic/ede-grammar.el @@ -1,4 +1,4 @@ -;;; semantic/ede-grammar.el --- EDE support for Semantic Grammar Files +;;; semantic/ede-grammar.el --- EDE support for Semantic Grammar Files -*- lexical-binding: t; -*- ;; Copyright (C) 2003-2004, 2007-2021 Free Software Foundation, Inc. @@ -30,6 +30,7 @@ (require 'ede/pconf) (require 'ede/proj-elisp) (require 'semantic/grammar) +(eval-when-compile (require 'cl-lib)) ;;; Code: (defclass semantic-ede-proj-target-grammar (ede-proj-target-elisp) @@ -37,13 +38,13 @@ (keybindings :initform nil) (phony :initform t) (sourcetype :initform - (semantic-ede-source-grammar-wisent - semantic-ede-source-grammar-bovine - )) + '(semantic-ede-source-grammar-wisent + semantic-ede-source-grammar-bovine + )) (availablecompilers :initform - (semantic-ede-grammar-compiler-wisent - semantic-ede-grammar-compiler-bovine - )) + '(semantic-ede-grammar-compiler-wisent + semantic-ede-grammar-compiler-bovine + )) (aux-packages :initform '("semantic" "cedet-compat")) (pre-load-packages :initform '("cedet-compat" "semantic/grammar" "semantic/bovine/grammar" "semantic/wisent/grammar")) ) @@ -118,7 +119,7 @@ For Emacs Lisp, return addsuffix command on source files." "Compile Emacs Lisp programs.") ;;; Target options. -(cl-defmethod ede-buffer-mine ((this semantic-ede-proj-target-grammar) buffer) +(cl-defmethod ede-buffer-mine ((_this semantic-ede-proj-target-grammar) buffer) "Return t if object THIS lays claim to the file in BUFFER. Lays claim to all -by.el, and -wy.el files." ;; We need to be a little more careful than this, but at the moment it @@ -130,7 +131,7 @@ Lays claim to all -by.el, and -wy.el files." (cl-defmethod project-compile-target ((obj semantic-ede-proj-target-grammar)) "Compile all sources in a Lisp target OBJ." - (let* ((cb (current-buffer)) + (let* (;; (cb (current-buffer)) (proj (ede-target-parent obj)) (default-directory (oref proj directory)) (comp 0) @@ -141,11 +142,10 @@ Lays claim to all -by.el, and -wy.el files." (fname (progn (string-match ".*/\\(.+\\.el\\)" package) (match-string 1 package))) (src (ede-expand-filename obj fname)) - (csrc (concat (file-name-sans-extension src) ".elc"))) - (with-no-warnings - (if (eq (byte-recompile-file src nil 0) t) - (setq comp (1+ comp)) - (setq utd (1+ utd))))))) + ;; (csrc (concat (file-name-sans-extension src) ".elc")) + ) + (cl-incf (if (eq (byte-recompile-file src nil 0) t) + comp utd))))) (oref obj source)) (message "All Semantic Grammar sources are up to date in %s" (eieio-object-name obj)) (cons comp utd))) @@ -162,10 +162,9 @@ Lays claim to all -by.el, and -wy.el files." "Insert variables needed by target THIS." (ede-proj-makefile-insert-loadpath-items (ede-proj-elisp-packages-to-loadpath - (list "eieio" "semantic" "inversion" "ede"))) + (list "eieio" "semantic" "ede"))) ;; eieio for object system needed in ede ;; semantic because it is - ;; Inversion for versioning system. ;; ede for project regeneration (ede-pmake-insert-variable-shared (concat (ede-pmake-varname this) "_SEMANTIC_GRAMMAR_EL") @@ -174,8 +173,7 @@ Lays claim to all -by.el, and -wy.el files." (with-current-buffer (find-file-noselect src) (concat (semantic-grammar-package) ".el"))) (oref this source) - " "))) - ) + " ")))) (cl-defmethod ede-proj-makefile-insert-rules :after ((this semantic-ede-proj-target-grammar)) "Insert rules needed by THIS target. diff --git a/lisp/cedet/semantic/edit.el b/lisp/cedet/semantic/edit.el index f39cc093cc9..b2e56360cf7 100644 --- a/lisp/cedet/semantic/edit.el +++ b/lisp/cedet/semantic/edit.el @@ -1,4 +1,4 @@ -;;; semantic/edit.el --- Edit Management for Semantic +;;; semantic/edit.el --- Edit Management for Semantic -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2021 Free Software Foundation, Inc. @@ -154,10 +154,10 @@ Optional argument BUFFER is the buffer to search for changes in." (when (overlay-get (car ol) 'semantic-change) (setq ret (cons (car ol) ret))) (setq ol (cdr ol))) - (sort ret #'(lambda (a b) (< (overlay-start a) - (overlay-start b))))))) + (sort ret (lambda (a b) (< (overlay-start a) + (overlay-start b))))))) -(defun semantic-edits-change-function-handle-changes (start end length) +(defun semantic-edits-change-function-handle-changes (start end _length) "Run whenever a buffer controlled by `semantic-mode' change. Tracks when and how the buffer is re-parsed. Argument START, END, and LENGTH specify the bounds of the change." @@ -356,7 +356,7 @@ See `semantic-edits-change-leaf-tag' for details on parents." start end))) (parent nil) (overlapped-tags nil) - inner-start inner-end + inner-end ;; inner-start (list-to-search nil)) ;; By the time this is already called, we know that it is ;; not a leaf change, nor a between tag change. That leaves @@ -370,7 +370,7 @@ See `semantic-edits-change-leaf-tag' for details on parents." (progn ;; We encompass one whole change. (setq overlapped-tags (list (car tags)) - inner-start (semantic-tag-start (car tags)) + ;; inner-start (semantic-tag-start (car tags)) inner-end (semantic-tag-end (car tags)) tags (cdr tags)) ;; Keep looping while tags are inside the change. @@ -386,13 +386,14 @@ See `semantic-edits-change-leaf-tag' for details on parents." ;; This is a parent. Drop the children found ;; so far. (setq overlapped-tags (list (car tags)) - inner-start (semantic-tag-start (car tags)) + ;; inner-start (semantic-tag-start (car tags)) inner-end (semantic-tag-end (car tags)) ) ;; It is not a parent encompassing tag (setq overlapped-tags (cons (car tags) overlapped-tags) - inner-start (semantic-tag-start (car tags)))) + ;; inner-start (semantic-tag-start (car tags)) + )) (setq tags (cdr tags))) (if (not tags) ;; There are no tags left, and all tags originally @@ -533,6 +534,7 @@ This function is for internal use by `semantic-edits-incremental-parser'." ;query this when debugging to find ;source of bugs. ) + (ignore last-cond) ;; Don't warn about the var not being used. (or changes ;; If we were called, and there are no changes, then we ;; don't know what to do. Force a full reparse. @@ -828,8 +830,7 @@ This function is for internal use by `semantic-edits-incremental-parser'." ;; Make it the default changes parser ;;;###autoload -(defalias 'semantic-parse-changes-default - 'semantic-edits-incremental-parser) +(defalias 'semantic-parse-changes-default #'semantic-edits-incremental-parser) ;;; Cache Splicing ;; diff --git a/lisp/cedet/semantic/find.el b/lisp/cedet/semantic/find.el index 706892b4861..17fb20fa0a0 100644 --- a/lisp/cedet/semantic/find.el +++ b/lisp/cedet/semantic/find.el @@ -1,4 +1,4 @@ -;;; semantic/find.el --- Search routines for Semantic +;;; semantic/find.el --- Search routines for Semantic -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2005, 2008-2021 Free Software Foundation, Inc. @@ -583,7 +583,7 @@ Optional argument SEARCH-PARTS and SEARCH-INCLUDES are passed to ) (defun semantic-brute-find-tag-by-function - (function streamorbuffer &optional search-parts search-includes) + (function streamorbuffer &optional search-parts _search-includes) "Find all tags for which FUNCTION's value is non-nil within STREAMORBUFFER. FUNCTION must return non-nil if an element of STREAM will be included in the new list. @@ -620,7 +620,7 @@ This parameter hasn't be active for a while and is obsolete." nl)) (defun semantic-brute-find-first-tag-by-function - (function streamorbuffer &optional search-parts search-includes) + (function streamorbuffer &optional _search-parts _search-includes) "Find the first tag which FUNCTION match within STREAMORBUFFER. FUNCTION must return non-nil if an element of STREAM will be included in the new list. diff --git a/lisp/cedet/semantic/format.el b/lisp/cedet/semantic/format.el index 8927ccde843..a68ef8064d1 100644 --- a/lisp/cedet/semantic/format.el +++ b/lisp/cedet/semantic/format.el @@ -1,4 +1,4 @@ -;;; semantic/format.el --- Routines for formatting tags +;;; semantic/format.el --- Routines for formatting tags -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2005, 2007-2021 Free Software Foundation, Inc. @@ -162,7 +162,7 @@ COLOR specifies if color should be used." (car args) nil color 'variable)) out) (setq args (cdr args))) - (mapconcat 'identity (nreverse out) semantic-function-argument-separator) + (mapconcat #'identity (nreverse out) semantic-function-argument-separator) )) ;;; Data Type @@ -200,7 +200,7 @@ Argument COLOR specifies to colorize the text." ;;; Abstract formatting functions ;; -(defun semantic-format-tag-prin1 (tag &optional parent color) +(defun semantic-format-tag-prin1 (tag &optional _parent _color) "Convert TAG to a string that is the print name for TAG. PARENT and COLOR are ignored." (format "%S" tag)) @@ -237,7 +237,7 @@ The name is the shortest possible representation. Optional argument PARENT is the parent type if TAG is a detail. Optional argument COLOR means highlight the prototype with font-lock colors.") -(defun semantic-format-tag-name-default (tag &optional parent color) +(defun semantic-format-tag-name-default (tag &optional _parent color) "Return an abbreviated string describing TAG. Optional argument PARENT is the parent type if TAG is a detail. Optional argument COLOR means highlight the prototype with font-lock colors." @@ -500,7 +500,7 @@ Optional argument COLOR means highlight the prototype with font-lock colors." args (if (eq class 'type) "}" ")")))) (when mods - (setq mods (concat (mapconcat 'identity mods " ") " "))) + (setq mods (concat (mapconcat #'identity mods " ") " "))) (concat (or mods "") (if type (concat type " ")) name diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el index 91944c44f5e..4ad70ff7c64 100644 --- a/lisp/cedet/semantic/fw.el +++ b/lisp/cedet/semantic/fw.el @@ -1,6 +1,6 @@ -;;; semantic/fw.el --- Framework for Semantic +;;; semantic/fw.el --- Framework for Semantic -*- lexical-binding: t; -*- -;;; Copyright (C) 1999-2021 Free Software Foundation, Inc. +;; Copyright (C) 1999-2021 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> @@ -34,29 +34,29 @@ ;;; Compatibility ;; -(define-obsolete-function-alias 'semantic-overlay-live-p 'overlay-buffer "27.1") -(define-obsolete-function-alias 'semantic-make-overlay 'make-overlay "27.1") -(define-obsolete-function-alias 'semantic-overlay-put 'overlay-put "27.1") -(define-obsolete-function-alias 'semantic-overlay-get 'overlay-get "27.1") +(define-obsolete-function-alias 'semantic-overlay-live-p #'overlay-buffer "27.1") +(define-obsolete-function-alias 'semantic-make-overlay #'make-overlay "27.1") +(define-obsolete-function-alias 'semantic-overlay-put #'overlay-put "27.1") +(define-obsolete-function-alias 'semantic-overlay-get #'overlay-get "27.1") (define-obsolete-function-alias 'semantic-overlay-properties - 'overlay-properties "27.1") -(define-obsolete-function-alias 'semantic-overlay-move 'move-overlay "27.1") -(define-obsolete-function-alias 'semantic-overlay-delete 'delete-overlay "27.1") -(define-obsolete-function-alias 'semantic-overlays-at 'overlays-at "27.1") -(define-obsolete-function-alias 'semantic-overlays-in 'overlays-in "27.1") -(define-obsolete-function-alias 'semantic-overlay-buffer 'overlay-buffer "27.1") -(define-obsolete-function-alias 'semantic-overlay-start 'overlay-start "27.1") -(define-obsolete-function-alias 'semantic-overlay-end 'overlay-end "27.1") + #'overlay-properties "27.1") +(define-obsolete-function-alias 'semantic-overlay-move #'move-overlay "27.1") +(define-obsolete-function-alias 'semantic-overlay-delete #'delete-overlay "27.1") +(define-obsolete-function-alias 'semantic-overlays-at #'overlays-at "27.1") +(define-obsolete-function-alias 'semantic-overlays-in #'overlays-in "27.1") +(define-obsolete-function-alias 'semantic-overlay-buffer #'overlay-buffer "27.1") +(define-obsolete-function-alias 'semantic-overlay-start #'overlay-start "27.1") +(define-obsolete-function-alias 'semantic-overlay-end #'overlay-end "27.1") (define-obsolete-function-alias 'semantic-overlay-next-change - 'next-overlay-change "27.1") + #'next-overlay-change "27.1") (define-obsolete-function-alias 'semantic-overlay-previous-change - 'previous-overlay-change "27.1") -(define-obsolete-function-alias 'semantic-overlay-lists 'overlay-lists "27.1") -(define-obsolete-function-alias 'semantic-overlay-p 'overlayp "27.1") -(define-obsolete-function-alias 'semantic-read-event 'read-event "27.1") -(define-obsolete-function-alias 'semantic-popup-menu 'popup-menu "27.1") + #'previous-overlay-change "27.1") +(define-obsolete-function-alias 'semantic-overlay-lists #'overlay-lists "27.1") +(define-obsolete-function-alias 'semantic-overlay-p #'overlayp "27.1") +(define-obsolete-function-alias 'semantic-read-event #'read-event "27.1") +(define-obsolete-function-alias 'semantic-popup-menu #'popup-menu "27.1") (define-obsolete-function-alias 'semantic-buffer-local-value - 'buffer-local-value "27.1") + #'buffer-local-value "27.1") (defun semantic-event-window (event) "Extract the window from EVENT." @@ -68,11 +68,11 @@ ;; Since Emacs 22 major mode functions should use `run-mode-hooks' to ;; run major mode hooks. -(define-obsolete-function-alias 'semantic-run-mode-hooks 'run-mode-hooks "28.1") +(define-obsolete-function-alias 'semantic-run-mode-hooks #'run-mode-hooks "28.1") ;; Fancy compat usage now handled in cedet-compat (define-obsolete-function-alias 'semantic-subst-char-in-string - 'subst-char-in-string "28.1") + #'subst-char-in-string "28.1") (defun semantic-delete-overlay-maybe (overlay) "Delete OVERLAY if it is a semantic token overlay." @@ -111,7 +111,7 @@ Possible Lifespans are: (setq semantic-cache-data-overlays (cons o semantic-cache-data-overlays)) ;;(message "Adding to cache: %s" o) - (add-hook 'post-command-hook 'semantic-cache-data-post-command-hook) + (add-hook 'post-command-hook #'semantic-cache-data-post-command-hook) )) (defun semantic-cache-data-post-command-hook () @@ -137,7 +137,7 @@ Remove self from `post-command-hook' if it is empty." ;; Remove ourselves if we have removed all overlays. (unless semantic-cache-data-overlays (remove-hook 'post-command-hook - 'semantic-cache-data-post-command-hook))) + #'semantic-cache-data-post-command-hook))) (defun semantic-get-cache-data (name &optional point) "Get cached data with NAME from optional POINT." @@ -189,14 +189,13 @@ will throw a warning when it encounters this symbol." (when (and (mode-local--function-overload-p newfn) (not (mode-local--overload-obsoleted-by newfn)) ;; Only throw this warning when byte compiling things. - (boundp 'byte-compile-current-file) - byte-compile-current-file - (not (string-match "cedet" byte-compile-current-file)) + (macroexp-compiling-p) + (not (string-match "cedet" (macroexp-file-name))) ) (make-obsolete-overload oldfnalias newfn when) (byte-compile-warn "%s: `%s' obsoletes overload `%s'" - byte-compile-current-file + (macroexp-file-name) newfn (with-suppressed-warnings ((obsolete semantic-overload-symbol-from-function)) (semantic-overload-symbol-from-function oldfnalias))))) @@ -211,8 +210,7 @@ will throw a warning when it encounters this symbol." (defvaralias oldvaralias newvar) (error ;; Only throw this warning when byte compiling things. - (when (and (boundp 'byte-compile-current-file) - byte-compile-current-file) + (when (macroexp-compiling-p) (byte-compile-warn "variable `%s' obsoletes, but isn't alias of `%s'" newvar oldvaralias) @@ -256,7 +254,7 @@ FUNCTION does not have arguments. When FUNCTION is entered `current-buffer' is a selected Semantic enabled buffer." (mode-local-map-file-buffers function #'semantic-active-p)) -(defalias 'semantic-map-mode-buffers 'mode-local-map-mode-buffers) +(defalias 'semantic-map-mode-buffers #'mode-local-map-mode-buffers) (defun semantic-install-function-overrides (overrides &optional transient) "Install the function OVERRIDES in the specified environment. @@ -272,11 +270,11 @@ later installation should be done in MODE hook." (mode-local-bind ;; Add the semantic- prefix to OVERLOAD short names. (mapcar - #'(lambda (e) - (let ((name (symbol-name (car e)))) - (if (string-match "^semantic-" name) - e - (cons (intern (format "semantic-%s" name)) (cdr e))))) + (lambda (e) + (let ((name (symbol-name (car e)))) + (if (string-match "^semantic-" name) + e + (cons (intern (format "semantic-%s" name)) (cdr e))))) overrides) (list 'constant-flag (not transient) 'override-flag t))) @@ -320,21 +318,17 @@ calling this one." ;;; Special versions of Find File ;; +(defvar recentf-exclude) +(defvar semantic-init-hook) +(defvar ede-auto-add-method) +(defvar flymake-start-syntax-check-on-find-file) +(defvar auto-insert) + (defun semantic-find-file-noselect (file &optional nowarn rawfile wildcards) "Call `find-file-noselect' with various features turned off. Use this when referencing a file that will be soon deleted. FILE, NOWARN, RAWFILE, and WILDCARDS are passed into `find-file-noselect'." - ;; Hack - - ;; Check if we are in set-auto-mode, and if so, warn about this. - (when (boundp 'keep-mode-if-same) - (let ((filename (or (and (boundp 'filename) filename) - "(unknown)"))) - (message "WARNING: semantic-find-file-noselect called for \ -%s while in set-auto-mode for %s. You should call the responsible function \ -into `mode-local-init-hook'." file filename) - (sit-for 1))) - - (let* ((recentf-exclude '( (lambda (f) t) )) + (let* ((recentf-exclude #'always) ;; This is a brave statement. Don't waste time loading in ;; lots of modes. Especially decoration mode can waste a lot ;; of time for a buffer we intend to kill. diff --git a/lisp/cedet/semantic/grammar-wy.el b/lisp/cedet/semantic/grammar-wy.el deleted file mode 100644 index 12c9c047fc5..00000000000 --- a/lisp/cedet/semantic/grammar-wy.el +++ /dev/null @@ -1,496 +0,0 @@ -;;; semantic/grammar-wy.el --- Generated parser support file - -;; Copyright (C) 2002-2004, 2009-2021 Free Software Foundation, Inc. - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: -;; -;; This file was generated from admin/grammars/grammar.wy. - -;;; Code: - -(require 'semantic) - -;;; Prologue -;; -(defvar semantic-grammar-lex-c-char-re) - -;; Current parsed nonterminal name. -(defvar semantic-grammar-wy--nterm nil) -;; Index of rule in a nonterminal clause. -(defvar semantic-grammar-wy--rindx nil) - -;;; Declarations -;; -(defconst semantic-grammar-wy--keyword-table - (semantic-lex-make-keyword-table - '(("%default-prec" . DEFAULT-PREC) - ("%no-default-prec" . NO-DEFAULT-PREC) - ("%keyword" . KEYWORD) - ("%expectedconflicts" . EXPECTEDCONFLICTS) - ("%languagemode" . LANGUAGEMODE) - ("%left" . LEFT) - ("%nonassoc" . NONASSOC) - ("%package" . PACKAGE) - ("%provide" . PROVIDE) - ("%prec" . PREC) - ("%put" . PUT) - ("%quotemode" . QUOTEMODE) - ("%right" . RIGHT) - ("%scopestart" . SCOPESTART) - ("%start" . START) - ("%token" . TOKEN) - ("%type" . TYPE) - ("%use-macros" . USE-MACROS)) - 'nil) - "Table of language keywords.") - -(defconst semantic-grammar-wy--token-table - (semantic-lex-make-type-table - '(("punctuation" - (GT . ">") - (LT . "<") - (OR . "|") - (SEMI . ";") - (COLON . ":")) - ("close-paren" - (RBRACE . "}") - (RPAREN . ")")) - ("open-paren" - (LBRACE . "{") - (LPAREN . "(")) - ("block" - (BRACE_BLOCK . "(LBRACE RBRACE)") - (PAREN_BLOCK . "(LPAREN RPAREN)")) - ("code" - (EPILOGUE . "%%...EOF") - (PROLOGUE . "%{...%}")) - ("sexp" - (SEXP)) - ("qlist" - (PREFIXED_LIST)) - ("char" - (CHARACTER)) - ("symbol" - (PERCENT_PERCENT . "\\`%%\\'") - (SYMBOL)) - ("string" - (STRING))) - '(("punctuation" :declared t) - ("block" :declared t) - ("sexp" matchdatatype sexp) - ("sexp" syntax "\\=") - ("sexp" :declared t) - ("qlist" matchdatatype sexp) - ("qlist" syntax "\\s'\\s-*(") - ("qlist" :declared t) - ("char" syntax semantic-grammar-lex-c-char-re) - ("char" :declared t) - ("symbol" syntax ":?\\(\\sw\\|\\s_\\)+") - ("symbol" :declared t) - ("string" :declared t) - ("keyword" :declared t))) - "Table of lexical tokens.") - -(defconst semantic-grammar-wy--parse-table - (progn - (eval-when-compile - (require 'semantic/wisent/comp)) - (wisent-compile-grammar - '((DEFAULT-PREC NO-DEFAULT-PREC KEYWORD LANGUAGEMODE EXPECTEDCONFLICTS LEFT NONASSOC PACKAGE PROVIDE PREC PUT QUOTEMODE RIGHT SCOPESTART START TOKEN TYPE USE-MACROS STRING SYMBOL PERCENT_PERCENT CHARACTER PREFIXED_LIST SEXP PROLOGUE EPILOGUE PAREN_BLOCK BRACE_BLOCK LPAREN RPAREN LBRACE RBRACE COLON SEMI OR LT GT) - nil - (grammar - ((prologue)) - ((epilogue)) - ((declaration)) - ((nonterminal)) - ((PERCENT_PERCENT))) - (prologue - ((PROLOGUE) - (wisent-raw-tag - (semantic-tag-new-code "prologue" nil)))) - (epilogue - ((EPILOGUE) - (wisent-raw-tag - (semantic-tag-new-code "epilogue" nil)))) - (declaration - ((decl) - (eval $1))) - (decl - ((default_prec_decl)) - ((no_default_prec_decl)) - ((languagemode_decl)) - ((expectedconflicts_decl)) - ((package_decl)) - ((provide_decl)) - ((precedence_decl)) - ((put_decl)) - ((quotemode_decl)) - ((scopestart_decl)) - ((start_decl)) - ((keyword_decl)) - ((token_decl)) - ((type_decl)) - ((use_macros_decl))) - (default_prec_decl - ((DEFAULT-PREC) - `(wisent-raw-tag - (semantic-tag "default-prec" 'assoc :value - '("t"))))) - (no_default_prec_decl - ((NO-DEFAULT-PREC) - `(wisent-raw-tag - (semantic-tag "default-prec" 'assoc :value - '("nil"))))) - (languagemode_decl - ((LANGUAGEMODE symbols) - `(wisent-raw-tag - (semantic-tag ',(car $2) - 'languagemode :rest ',(cdr $2))))) - (expectedconflicts_decl - ((EXPECTEDCONFLICTS symbols) - `(wisent-raw-tag - (semantic-tag ',(car $2) - 'expectedconflicts :rest ',(cdr $2))))) - (package_decl - ((PACKAGE SYMBOL) - `(wisent-raw-tag - (semantic-tag-new-package ',$2 nil)))) - (provide_decl - ((PROVIDE SYMBOL) - `(wisent-raw-tag - (semantic-tag ',$2 'provide)))) - (precedence_decl - ((associativity token_type_opt items) - `(wisent-raw-tag - (semantic-tag ',$1 'assoc :type ',$2 :value ',$3)))) - (associativity - ((LEFT) - (progn "left")) - ((RIGHT) - (progn "right")) - ((NONASSOC) - (progn "nonassoc"))) - (put_decl - ((PUT put_name put_value) - `(wisent-raw-tag - (semantic-tag ',$2 'put :value ',(list $3)))) - ((PUT put_name put_value_list) - `(wisent-raw-tag - (semantic-tag ',$2 'put :value ',$3))) - ((PUT put_name_list put_value) - `(wisent-raw-tag - (semantic-tag ',(car $2) - 'put :rest ',(cdr $2) - :value ',(list $3)))) - ((PUT put_name_list put_value_list) - `(wisent-raw-tag - (semantic-tag ',(car $2) - 'put :rest ',(cdr $2) - :value ',$3)))) - (put_name_list - ((BRACE_BLOCK) - (mapcar 'semantic-tag-name - (semantic-parse-region - (car $region1) - (cdr $region1) - 'put_names 1)))) - (put_names - ((LBRACE) - nil) - ((RBRACE) - nil) - ((put_name) - (wisent-raw-tag - (semantic-tag $1 'put-name)))) - (put_name - ((SYMBOL)) - ((token_type))) - (put_value_list - ((BRACE_BLOCK) - (mapcar 'semantic-tag-code-detail - (semantic-parse-region - (car $region1) - (cdr $region1) - 'put_values 1)))) - (put_values - ((LBRACE) - nil) - ((RBRACE) - nil) - ((put_value) - (wisent-raw-tag - (semantic-tag-new-code "put-value" $1)))) - (put_value - ((SYMBOL any_value) - (cons $1 $2))) - (scopestart_decl - ((SCOPESTART SYMBOL) - `(wisent-raw-tag - (semantic-tag ',$2 'scopestart)))) - (quotemode_decl - ((QUOTEMODE SYMBOL) - `(wisent-raw-tag - (semantic-tag ',$2 'quotemode)))) - (start_decl - ((START symbols) - `(wisent-raw-tag - (semantic-tag ',(car $2) - 'start :rest ',(cdr $2))))) - (keyword_decl - ((KEYWORD SYMBOL string_value) - `(wisent-raw-tag - (semantic-tag ',$2 'keyword :value ',$3)))) - (token_decl - ((TOKEN token_type_opt SYMBOL string_value) - `(wisent-raw-tag - (semantic-tag ',$3 ',(if $2 'token 'keyword) - :type ',$2 :value ',$4))) - ((TOKEN token_type_opt symbols) - `(wisent-raw-tag - (semantic-tag ',(car $3) - 'token :type ',$2 :rest ',(cdr $3))))) - (token_type_opt - (nil) - ((token_type))) - (token_type - ((LT SYMBOL GT) - (progn $2))) - (type_decl - ((TYPE token_type plist_opt) - `(wisent-raw-tag - (semantic-tag ',$2 'type :value ',$3)))) - (plist_opt - (nil) - ((plist))) - (plist - ((plist put_value) - (append - (list $2) - $1)) - ((put_value) - (list $1))) - (use_name_list - ((BRACE_BLOCK) - (mapcar 'semantic-tag-name - (semantic-parse-region - (car $region1) - (cdr $region1) - 'use_names 1)))) - (use_names - ((LBRACE) - nil) - ((RBRACE) - nil) - ((SYMBOL) - (wisent-raw-tag - (semantic-tag $1 'use-name)))) - (use_macros_decl - ((USE-MACROS SYMBOL use_name_list) - `(wisent-raw-tag - (semantic-tag "macro" 'macro :type ',$2 :value ',$3)))) - (string_value - ((STRING) - (read $1))) - (any_value - ((SYMBOL)) - ((STRING)) - ((PAREN_BLOCK)) - ((PREFIXED_LIST)) - ((SEXP))) - (symbols - ((lifo_symbols) - (nreverse $1))) - (lifo_symbols - ((lifo_symbols SYMBOL) - (cons $2 $1)) - ((SYMBOL) - (list $1))) - (nonterminal - ((SYMBOL - (setq semantic-grammar-wy--nterm $1 semantic-grammar-wy--rindx 0) - COLON rules SEMI) - (wisent-raw-tag - (semantic-tag $1 'nonterminal :children $4)))) - (rules - ((lifo_rules) - (apply 'nconc - (nreverse $1)))) - (lifo_rules - ((lifo_rules OR rule) - (cons $3 $1)) - ((rule) - (list $1))) - (rule - ((rhs) - (let* - ((nterm semantic-grammar-wy--nterm) - (rindx semantic-grammar-wy--rindx) - (rhs $1) - comps prec action elt) - (setq semantic-grammar-wy--rindx - (1+ semantic-grammar-wy--rindx)) - (while rhs - (setq elt - (car rhs) - rhs - (cdr rhs)) - (cond - ((vectorp elt) - (if prec - (error "Duplicate %%prec in `%s:%d' rule" nterm rindx)) - (setq prec - (aref elt 0))) - ((consp elt) - (if - (or action comps) - (setq comps - (cons elt comps) - semantic-grammar-wy--rindx - (1+ semantic-grammar-wy--rindx)) - (setq action - (car elt)))) - (t - (setq comps - (cons elt comps))))) - (wisent-cook-tag - (wisent-raw-tag - (semantic-tag - (format "%s:%d" nterm rindx) - 'rule :type - (if comps "group" "empty") - :value comps :prec prec :expr action)))))) - (rhs - (nil) - ((rhs item) - (cons $2 $1)) - ((rhs action) - (cons - (list $2) - $1)) - ((rhs PREC item) - (cons - (vector $3) - $1))) - (action - ((PAREN_BLOCK)) - ((PREFIXED_LIST)) - ((BRACE_BLOCK) - (format "(progn\n%s)" - (let - ((s $1)) - (if - (string-match "^{[\r\n\t ]*" s) - (setq s - (substring s - (match-end 0)))) - (if - (string-match "[\r\n\t ]*}$" s) - (setq s - (substring s 0 - (match-beginning 0)))) - s)))) - (items - ((lifo_items) - (nreverse $1))) - (lifo_items - ((lifo_items item) - (cons $2 $1)) - ((item) - (list $1))) - (item - ((SYMBOL)) - ((CHARACTER)))) - '(grammar prologue epilogue declaration nonterminal rule put_names put_values use_names))) - "Parser table.") - -(defun semantic-grammar-wy--install-parser () - "Setup the Semantic Parser." - (semantic-install-function-overrides - '((semantic-parse-stream . wisent-parse-stream))) - (setq semantic-parser-name "LALR" - semantic--parse-table semantic-grammar-wy--parse-table - semantic-debug-parser-source "grammar.wy" - semantic-flex-keywords-obarray semantic-grammar-wy--keyword-table - semantic-lex-types-obarray semantic-grammar-wy--token-table) - ;; Collect unmatched syntax lexical tokens - (add-hook 'wisent-discarding-token-functions - 'wisent-collect-unmatched-syntax nil t)) - - -;;; Analyzers -;; -(define-lex-block-type-analyzer semantic-grammar-wy--<block>-block-analyzer - "block analyzer for <block> tokens." - "\\s(\\|\\s)" - '((("(" LPAREN PAREN_BLOCK) - ("{" LBRACE BRACE_BLOCK)) - (")" RPAREN) - ("}" RBRACE)) - ) - -(define-lex-regex-type-analyzer semantic-grammar-wy--<char>-regexp-analyzer - "regexp analyzer for <char> tokens." - semantic-grammar-lex-c-char-re - nil - 'CHARACTER) - -(define-lex-regex-type-analyzer semantic-grammar-wy--<symbol>-regexp-analyzer - "regexp analyzer for <symbol> tokens." - ":?\\(\\sw\\|\\s_\\)+" - '((PERCENT_PERCENT . "\\`%%\\'")) - 'SYMBOL) - -(define-lex-sexp-type-analyzer semantic-grammar-wy--<qlist>-sexp-analyzer - "sexp analyzer for <qlist> tokens." - "\\s'\\s-*(" - 'PREFIXED_LIST) - -(define-lex-sexp-type-analyzer semantic-grammar-wy--<string>-sexp-analyzer - "sexp analyzer for <string> tokens." - "\\s\"" - 'STRING) - -(define-lex-string-type-analyzer semantic-grammar-wy--<punctuation>-string-analyzer - "string analyzer for <punctuation> tokens." - "\\(\\s.\\|\\s$\\|\\s'\\)+" - '((GT . ">") - (LT . "<") - (OR . "|") - (SEMI . ";") - (COLON . ":")) - 'punctuation) - -(define-lex-keyword-type-analyzer semantic-grammar-wy--<keyword>-keyword-analyzer - "keyword analyzer for <keyword> tokens." - "\\(\\sw\\|\\s_\\)+") - -(define-lex-sexp-type-analyzer semantic-grammar-wy--<sexp>-sexp-analyzer - "sexp analyzer for <sexp> tokens." - "\\=" - 'SEXP) - - -;;; Epilogue -;; - - - - -(provide 'semantic/grammar-wy) - -;;; semantic/grammar-wy.el ends here diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index 4551811c235..4c3bb6c238b 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el @@ -1,4 +1,4 @@ -;;; semantic/grammar.el --- Major mode framework for Semantic grammars +;;; semantic/grammar.el --- Major mode framework for Semantic grammars -*- lexical-binding: t; -*- ;; Copyright (C) 2002-2005, 2007-2021 Free Software Foundation, Inc. @@ -23,9 +23,6 @@ ;; ;; Major mode framework for editing Semantic's input grammar files. -;;; History: -;; - ;;; Code: (require 'semantic) @@ -34,7 +31,12 @@ (require 'semantic/format) ;; FIXME this is a generated file, but we need to load this file to ;; generate it! -(require 'semantic/grammar-wy) +;; We need `semantic/grammar-wy.el' but we're also needed to generate +;; that file from `grammar.wy', so to break the dependency, we keep +;; a bootstrap copy of `grammar-wy.el' in `grm-wy-boot.el'. See bug#16008. +(eval-and-compile + (unless (require 'semantic/grammar-wy nil t) + (load "semantic/grm-wy-boot"))) (require 'semantic/idle) (require 'help-fns) (require 'semantic/analyze) @@ -143,12 +145,12 @@ It ignores whitespaces, newlines and comments." ARGS are ASSOC's key value list." (let ((key t)) `(semantic-tag-make-plist - ,@(mapcar #'(lambda (i) - (prog1 - (if key - (list 'quote i) - i) - (setq key (not key)))) + ,@(mapcar (lambda (i) + (prog1 + (if key + (list 'quote i) + i) + (setq key (not key)))) args)))) (defsubst semantic-grammar-quote-p (sym) @@ -191,13 +193,13 @@ Warn if other tags of class CLASS exist." That is tag names plus names defined in tag attribute `:rest'." (let* ((tags (semantic-find-tags-by-class class (current-buffer)))) - (apply 'append + (apply #'append (mapcar - #'(lambda (tag) - (mapcar - 'intern - (cons (semantic-tag-name tag) - (semantic-tag-get-attribute tag :rest)))) + (lambda (tag) + (mapcar + #'intern + (cons (semantic-tag-name tag) + (semantic-tag-get-attribute tag :rest)))) tags)))) (defsubst semantic-grammar-item-text (item) @@ -298,9 +300,9 @@ foo.by it is foo-by." That is an alist of (VALUE . TOKEN) where VALUE is the string value of the keyword and TOKEN is the terminal symbol identifying the keyword." (mapcar - #'(lambda (key) - (cons (semantic-tag-get-attribute key :value) - (intern (semantic-tag-name key)))) + (lambda (key) + (cons (semantic-tag-get-attribute key :value) + (intern (semantic-tag-name key)))) (semantic-find-tags-by-class 'keyword (current-buffer)))) (defun semantic-grammar-keyword-properties (keywords) @@ -312,7 +314,7 @@ the keyword and TOKEN is the terminal symbol identifying the keyword." (setq put (car puts) puts (cdr puts) keys (mapcar - 'intern + #'intern (cons (semantic-tag-name put) (semantic-tag-get-attribute put :rest)))) (while keys @@ -565,6 +567,10 @@ Typically a DEFINE expression should look like this: (goto-char start) (indent-sexp)))) +(defvar semantic-grammar-require-form + '(eval-when-compile (require 'semantic/bovine)) + "The form to use to load the parser engine.") + (defconst semantic-grammar-header-template '("\ ;;; " file " --- Generated parser support file @@ -596,13 +602,10 @@ Typically a DEFINE expression should look like this: ;; PLEASE DO NOT MANUALLY EDIT THIS FILE! It is automatically ;; generated from the grammar file " gram ". -;;; History: -;; - ;;; Code: (require 'semantic/lex) -(eval-when-compile (require 'semantic/bovine)) +" require-form " ") "Generated header template. The symbols in the template are local variables in @@ -651,6 +654,7 @@ The symbols in the list are local variables in semantic--grammar-output-buffer)) (gram . ,(semantic-grammar-buffer-file)) (date . ,(format-time-string "%Y-%m-%d %T%z")) + (require-form . ,(format "%S" semantic-grammar-require-form)) (vcid . ,(concat "$" "Id" "$")) ;; Avoid expansion ;; Try to get the copyright from the input grammar, or ;; generate a new one if not found. @@ -818,7 +822,7 @@ Block definitions are read from the current table of lexical types." (let ((semantic-lex-types-obarray (semantic-lex-make-type-table tokens props)) semantic-grammar--lex-block-specs) - (mapatoms 'semantic-grammar-insert-defanalyzer + (mapatoms #'semantic-grammar-insert-defanalyzer semantic-lex-types-obarray)))) ;;; Generation of the grammar support file. @@ -846,7 +850,8 @@ Lisp code." (semantic--grammar-package (semantic-grammar-package)) (semantic--grammar-provide (semantic-grammar-first-tag-name 'provide)) (output (concat (or semantic--grammar-provide - semantic--grammar-package) ".el")) + semantic--grammar-package) + ".el")) (semantic--grammar-input-buffer (current-buffer)) (semantic--grammar-output-buffer (find-file-noselect @@ -1063,7 +1068,7 @@ See also the variable `semantic-grammar-file-regexp'." (setq semantic--grammar-macros-regexp-1 (concat "(\\s-*" (regexp-opt - (mapcar #'(lambda (e) (symbol-name (car e))) + (mapcar (lambda (e) (symbol-name (car e))) semantic-grammar-macros) t) "\\>")) @@ -1197,20 +1202,20 @@ END is the limit of the search." (defvar semantic-grammar-mode-map (let ((km (make-sparse-keymap))) - (define-key km "|" 'semantic-grammar-electric-punctuation) - (define-key km ";" 'semantic-grammar-electric-punctuation) - (define-key km "%" 'semantic-grammar-electric-punctuation) - (define-key km "(" 'semantic-grammar-electric-punctuation) - (define-key km ")" 'semantic-grammar-electric-punctuation) - (define-key km ":" 'semantic-grammar-electric-punctuation) - - (define-key km "\t" 'semantic-grammar-indent) - (define-key km "\M-\t" 'semantic-grammar-complete) - (define-key km "\C-c\C-c" 'semantic-grammar-create-package) - (define-key km "\C-cm" 'semantic-grammar-find-macro-expander) - (define-key km "\C-cik" 'semantic-grammar-insert-keyword) -;; (define-key km "\C-cc" 'semantic-grammar-generate-and-load) -;; (define-key km "\C-cr" 'semantic-grammar-generate-one-rule) + (define-key km "|" #'semantic-grammar-electric-punctuation) + (define-key km ";" #'semantic-grammar-electric-punctuation) + (define-key km "%" #'semantic-grammar-electric-punctuation) + (define-key km "(" #'semantic-grammar-electric-punctuation) + (define-key km ")" #'semantic-grammar-electric-punctuation) + (define-key km ":" #'semantic-grammar-electric-punctuation) + + (define-key km "\t" #'semantic-grammar-indent) + (define-key km "\M-\t" #'semantic-grammar-complete) + (define-key km "\C-c\C-c" #'semantic-grammar-create-package) + (define-key km "\C-cm" #'semantic-grammar-find-macro-expander) + (define-key km "\C-cik" #'semantic-grammar-insert-keyword) +;; (define-key km "\C-cc" #'semantic-grammar-generate-and-load) +;; (define-key km "\C-cr" #'semantic-grammar-generate-one-rule) km) "Keymap used in `semantic-grammar-mode'.") @@ -1322,7 +1327,7 @@ the change bounds to encompass the whole nonterminal tag." ;; Setup Semantic to parse grammar (semantic-grammar-wy--install-parser) (setq semantic-lex-comment-regex ";;" - semantic-lex-analyzer 'semantic-grammar-lexer + semantic-lex-analyzer #'semantic-grammar-lexer semantic-type-relation-separator-character '(":") semantic-symbol->name-assoc-list '( @@ -1343,10 +1348,10 @@ the change bounds to encompass the whole nonterminal tag." ;; Before each change, clear the cached regexp used to highlight ;; macros local in this grammar. (add-hook 'before-change-functions - 'semantic--grammar-clear-macros-regexp-2 nil t) + #'semantic--grammar-clear-macros-regexp-2 nil t) ;; Handle safe re-parse of grammar rules. (add-hook 'semantic-edits-new-change-functions - 'semantic-grammar-edits-new-change-hook-fcn + #'semantic-grammar-edits-new-change-hook-fcn nil t)) ;;;; @@ -1734,7 +1739,7 @@ If it is a macro name, return a description of the associated expander function parameter list. If it is a function name, return a description of this function parameter list. -It it is a variable name, return a brief (one-line) documentation +If it is a variable name, return a brief (one-line) documentation string for the variable. If a default description of the current context can be obtained, return it. @@ -1856,11 +1861,11 @@ Optional argument COLOR determines if color is added to the text." (setq label "Keyword: ") (let (summary) (semantic--find-tags-by-function - #'(lambda (put) - (unless summary - (setq summary (cdr (assoc "summary" - (semantic-tag-get-attribute - put :value)))))) + (lambda (put) + (unless summary + (setq summary (cdr (assoc "summary" + (semantic-tag-get-attribute + put :value)))))) ;; Get `put' tag with TAG name. (semantic-find-tags-by-name-regexp (regexp-quote (semantic-tag-name tag)) @@ -1876,7 +1881,7 @@ Optional argument COLOR determines if color is added to the text." (names (semantic-tag-get-attribute tag :rest)) (type (semantic-tag-type tag))) (if names - (setq name (mapconcat 'identity (cons name names) " "))) + (setq name (mapconcat #'identity (cons name names) " "))) (setq desc (concat (if type (format " <%s>" type) @@ -1893,7 +1898,7 @@ Optional argument COLOR determines if color is added to the text." (format " <%s>" type) "") (if val - (concat " " (mapconcat 'identity val " ")) + (concat " " (mapconcat #'identity val " ")) ""))))) (t (setq desc (semantic-format-tag-abbreviate tag parent color)))) @@ -1944,7 +1949,7 @@ Optional argument COLOR determines if color is added to the text." context-return))) (define-mode-local-override semantic-analyze-possible-completions - semantic-grammar-mode (context &rest flags) + semantic-grammar-mode (context &rest _flags) "Return a list of possible completions based on CONTEXT." (require 'semantic/analyze/complete) (if (semantic-grammar-in-lisp-p) diff --git a/lisp/cedet/semantic/grm-wy-boot.el b/lisp/cedet/semantic/grm-wy-boot.el new file mode 100644 index 00000000000..a6bf211713a --- /dev/null +++ b/lisp/cedet/semantic/grm-wy-boot.el @@ -0,0 +1,503 @@ +;;; semantic/grammar-wy.el --- Generated parser support file -*- lexical-binding:t -*- + +;; Copyright (C) 2002-2021 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; This file was generated from admin/grammars/grammar.wy. + +;;; Code: + +(require 'semantic/lex) +(require 'semantic/wisent) + +;;; Prologue +;; +(defvar semantic-grammar-lex-c-char-re) + +;; Current parsed nonterminal name. +(defvar semantic-grammar-wy--nterm nil) +;; Index of rule in a nonterminal clause. +(defvar semantic-grammar-wy--rindx nil) + +;;; Declarations +;; +(eval-and-compile (defconst semantic-grammar-wy--expected-conflicts + nil + "The number of expected shift/reduce conflicts in this grammar.")) + +(defconst semantic-grammar-wy--keyword-table + (semantic-lex-make-keyword-table + '(("%default-prec" . DEFAULT-PREC) + ("%no-default-prec" . NO-DEFAULT-PREC) + ("%keyword" . KEYWORD) + ("%languagemode" . LANGUAGEMODE) + ("%left" . LEFT) + ("%nonassoc" . NONASSOC) + ("%package" . PACKAGE) + ("%expectedconflicts" . EXPECTEDCONFLICTS) + ("%provide" . PROVIDE) + ("%prec" . PREC) + ("%put" . PUT) + ("%quotemode" . QUOTEMODE) + ("%right" . RIGHT) + ("%scopestart" . SCOPESTART) + ("%start" . START) + ("%token" . TOKEN) + ("%type" . TYPE) + ("%use-macros" . USE-MACROS)) + 'nil) + "Table of language keywords.") + +(defconst semantic-grammar-wy--token-table + (semantic-lex-make-type-table + '(("punctuation" + (GT . ">") + (LT . "<") + (OR . "|") + (SEMI . ";") + (COLON . ":")) + ("close-paren" + (RBRACE . "}") + (RPAREN . ")")) + ("open-paren" + (LBRACE . "{") + (LPAREN . "(")) + ("block" + (BRACE_BLOCK . "(LBRACE RBRACE)") + (PAREN_BLOCK . "(LPAREN RPAREN)")) + ("code" + (EPILOGUE . "%%...EOF") + (PROLOGUE . "%{...%}")) + ("sexp" + (SEXP)) + ("qlist" + (PREFIXED_LIST)) + ("char" + (CHARACTER)) + ("symbol" + (PERCENT_PERCENT . "\\`%%\\'") + (SYMBOL)) + ("string" + (STRING))) + '(("punctuation" :declared t) + ("block" :declared t) + ("sexp" matchdatatype sexp) + ("sexp" syntax "\\=") + ("sexp" :declared t) + ("qlist" matchdatatype sexp) + ("qlist" syntax "\\s'\\s-*(") + ("qlist" :declared t) + ("char" syntax semantic-grammar-lex-c-char-re) + ("char" :declared t) + ("symbol" syntax ":?\\(\\sw\\|\\s_\\)+") + ("symbol" :declared t) + ("string" :declared t) + ("keyword" :declared t))) + "Table of lexical tokens.") + +(defconst semantic-grammar-wy--parse-table + (wisent-compiled-grammar + ((DEFAULT-PREC NO-DEFAULT-PREC KEYWORD LANGUAGEMODE LEFT NONASSOC PACKAGE EXPECTEDCONFLICTS PROVIDE PREC PUT QUOTEMODE RIGHT SCOPESTART START TOKEN TYPE USE-MACROS STRING SYMBOL PERCENT_PERCENT CHARACTER PREFIXED_LIST SEXP PROLOGUE EPILOGUE PAREN_BLOCK BRACE_BLOCK LPAREN RPAREN LBRACE RBRACE COLON SEMI OR LT GT) + nil + (grammar + ((prologue)) + ((epilogue)) + ((declaration)) + ((nonterminal)) + ((PERCENT_PERCENT))) + (prologue + ((PROLOGUE) + (wisent-raw-tag + (semantic-tag-new-code "prologue" nil)))) + (epilogue + ((EPILOGUE) + (wisent-raw-tag + (semantic-tag-new-code "epilogue" nil)))) + (declaration + ((decl) + (eval $1 t))) + (decl + ((default_prec_decl)) + ((no_default_prec_decl)) + ((languagemode_decl)) + ((package_decl)) + ((expectedconflicts_decl)) + ((provide_decl)) + ((precedence_decl)) + ((put_decl)) + ((quotemode_decl)) + ((scopestart_decl)) + ((start_decl)) + ((keyword_decl)) + ((token_decl)) + ((type_decl)) + ((use_macros_decl))) + (default_prec_decl + ((DEFAULT-PREC) + `(wisent-raw-tag + (semantic-tag "default-prec" 'assoc :value + '("t"))))) + (no_default_prec_decl + ((NO-DEFAULT-PREC) + `(wisent-raw-tag + (semantic-tag "default-prec" 'assoc :value + '("nil"))))) + (languagemode_decl + ((LANGUAGEMODE symbols) + `(wisent-raw-tag + (semantic-tag ',(car $2) + 'languagemode :rest ',(cdr $2))))) + (package_decl + ((PACKAGE SYMBOL) + `(wisent-raw-tag + (semantic-tag-new-package ',$2 nil)))) + (expectedconflicts_decl + ((EXPECTEDCONFLICTS symbols) + `(wisent-raw-tag + (semantic-tag ',(car $2) + 'expectedconflicts :rest ',(cdr $2))))) + (provide_decl + ((PROVIDE SYMBOL) + `(wisent-raw-tag + (semantic-tag ',$2 'provide)))) + (precedence_decl + ((associativity token_type_opt items) + `(wisent-raw-tag + (semantic-tag ',$1 'assoc :type ',$2 :value ',$3)))) + (associativity + ((LEFT) + (progn "left")) + ((RIGHT) + (progn "right")) + ((NONASSOC) + (progn "nonassoc"))) + (put_decl + ((PUT put_name put_value) + `(wisent-raw-tag + (semantic-tag ',$2 'put :value ',(list $3)))) + ((PUT put_name put_value_list) + `(wisent-raw-tag + (semantic-tag ',$2 'put :value ',$3))) + ((PUT put_name_list put_value) + `(wisent-raw-tag + (semantic-tag ',(car $2) + 'put :rest ',(cdr $2) + :value ',(list $3)))) + ((PUT put_name_list put_value_list) + `(wisent-raw-tag + (semantic-tag ',(car $2) + 'put :rest ',(cdr $2) + :value ',$3)))) + (put_name_list + ((BRACE_BLOCK) + (mapcar #'semantic-tag-name + (semantic-parse-region + (car $region1) + (cdr $region1) + 'put_names 1)))) + (put_names + ((LBRACE) + nil) + ((RBRACE) + nil) + ((put_name) + (wisent-raw-tag + (semantic-tag $1 'put-name)))) + (put_name + ((SYMBOL)) + ((token_type))) + (put_value_list + ((BRACE_BLOCK) + (mapcar #'semantic-tag-code-detail + (semantic-parse-region + (car $region1) + (cdr $region1) + 'put_values 1)))) + (put_values + ((LBRACE) + nil) + ((RBRACE) + nil) + ((put_value) + (wisent-raw-tag + (semantic-tag-new-code "put-value" $1)))) + (put_value + ((SYMBOL any_value) + (cons $1 $2))) + (scopestart_decl + ((SCOPESTART SYMBOL) + `(wisent-raw-tag + (semantic-tag ',$2 'scopestart)))) + (quotemode_decl + ((QUOTEMODE SYMBOL) + `(wisent-raw-tag + (semantic-tag ',$2 'quotemode)))) + (start_decl + ((START symbols) + `(wisent-raw-tag + (semantic-tag ',(car $2) + 'start :rest ',(cdr $2))))) + (keyword_decl + ((KEYWORD SYMBOL string_value) + `(wisent-raw-tag + (semantic-tag ',$2 'keyword :value ',$3)))) + (token_decl + ((TOKEN token_type_opt SYMBOL string_value) + `(wisent-raw-tag + (semantic-tag ',$3 ',(if $2 'token 'keyword) + :type ',$2 :value ',$4))) + ((TOKEN token_type_opt symbols) + `(wisent-raw-tag + (semantic-tag ',(car $3) + 'token :type ',$2 :rest ',(cdr $3))))) + (token_type_opt + (nil) + ((token_type))) + (token_type + ((LT SYMBOL GT) + (progn $2))) + (type_decl + ((TYPE token_type plist_opt) + `(wisent-raw-tag + (semantic-tag ',$2 'type :value ',$3)))) + (plist_opt + (nil) + ((plist))) + (plist + ((plist put_value) + (append + (list $2) + $1)) + ((put_value) + (list $1))) + (use_name_list + ((BRACE_BLOCK) + (mapcar #'semantic-tag-name + (semantic-parse-region + (car $region1) + (cdr $region1) + 'use_names 1)))) + (use_names + ((LBRACE) + nil) + ((RBRACE) + nil) + ((SYMBOL) + (wisent-raw-tag + (semantic-tag $1 'use-name)))) + (use_macros_decl + ((USE-MACROS SYMBOL use_name_list) + `(wisent-raw-tag + (semantic-tag "macro" 'macro :type ',$2 :value ',$3)))) + (string_value + ((STRING) + (read $1))) + (any_value + ((SYMBOL)) + ((STRING)) + ((PAREN_BLOCK)) + ((PREFIXED_LIST)) + ((SEXP))) + (symbols + ((lifo_symbols) + (nreverse $1))) + (lifo_symbols + ((lifo_symbols SYMBOL) + (cons $2 $1)) + ((SYMBOL) + (list $1))) + (nonterminal + ((SYMBOL + (setq semantic-grammar-wy--nterm $1 semantic-grammar-wy--rindx 0) + COLON rules SEMI) + (wisent-raw-tag + (semantic-tag $1 'nonterminal :children $4)))) + (rules + ((lifo_rules) + (apply #'nconc + (nreverse $1)))) + (lifo_rules + ((lifo_rules OR rule) + (cons $3 $1)) + ((rule) + (list $1))) + (rule + ((rhs) + (let* + ((nterm semantic-grammar-wy--nterm) + (rindx semantic-grammar-wy--rindx) + (rhs $1) + comps prec action elt) + (setq semantic-grammar-wy--rindx + (1+ semantic-grammar-wy--rindx)) + (while rhs + (setq elt + (car rhs) + rhs + (cdr rhs)) + (cond + ((vectorp elt) + (if prec + (error "Duplicate %%prec in `%s:%d' rule" nterm rindx)) + (setq prec + (aref elt 0))) + ((consp elt) + (if + (or action comps) + (setq comps + (cons elt comps) + semantic-grammar-wy--rindx + (1+ semantic-grammar-wy--rindx)) + (setq action + (car elt)))) + (t + (setq comps + (cons elt comps))))) + (wisent-cook-tag + (wisent-raw-tag + (semantic-tag + (format "%s:%d" nterm rindx) + 'rule :type + (if comps "group" "empty") + :value comps :prec prec :expr action)))))) + (rhs + (nil) + ((rhs item) + (cons $2 $1)) + ((rhs action) + (cons + (list $2) + $1)) + ((rhs PREC item) + (cons + (vector $3) + $1))) + (action + ((PAREN_BLOCK)) + ((PREFIXED_LIST)) + ((BRACE_BLOCK) + (format "(progn\n%s)" + (let + ((s $1)) + (if + (string-match "^{[
\n ]*" s) + (setq s + (substring s + (match-end 0)))) + (if + (string-match "[
\n ]*}$" s) + (setq s + (substring s 0 + (match-beginning 0)))) + s)))) + (items + ((lifo_items) + (nreverse $1))) + (lifo_items + ((lifo_items item) + (cons $2 $1)) + ((item) + (list $1))) + (item + ((SYMBOL)) + ((CHARACTER)))) + (grammar prologue epilogue declaration nonterminal rule put_names put_values use_names)) + "Parser table.") + +(defun semantic-grammar-wy--install-parser () + "Setup the Semantic Parser." + (semantic-install-function-overrides + '((semantic-parse-stream . wisent-parse-stream))) + (setq semantic-parser-name "LALR" + semantic--parse-table semantic-grammar-wy--parse-table + semantic-debug-parser-source "grammar.wy" + semantic-flex-keywords-obarray semantic-grammar-wy--keyword-table + semantic-lex-types-obarray semantic-grammar-wy--token-table) + ;; Collect unmatched syntax lexical tokens + (add-hook 'wisent-discarding-token-functions + #'wisent-collect-unmatched-syntax nil t)) + + +;;; Analyzers +;; +(define-lex-keyword-type-analyzer semantic-grammar-wy--<keyword>-keyword-analyzer + "keyword analyzer for <keyword> tokens." + "\\(\\sw\\|\\s_\\)+") + +(define-lex-regex-type-analyzer semantic-grammar-wy--<char>-regexp-analyzer + "regexp analyzer for <char> tokens." + semantic-grammar-lex-c-char-re + nil + 'CHARACTER) + +(define-lex-sexp-type-analyzer semantic-grammar-wy--<string>-sexp-analyzer + "sexp analyzer for <string> tokens." + "\\s\"" + 'STRING) + +(define-lex-block-type-analyzer semantic-grammar-wy--<block>-block-analyzer + "block analyzer for <block> tokens." + "\\s(\\|\\s)" + '((("(" LPAREN PAREN_BLOCK) + ("{" LBRACE BRACE_BLOCK)) + (")" RPAREN) + ("}" RBRACE)) + ) + +(define-lex-string-type-analyzer semantic-grammar-wy--<punctuation>-string-analyzer + "string analyzer for <punctuation> tokens." + "\\(\\s.\\|\\s$\\|\\s'\\)+" + '((GT . ">") + (LT . "<") + (OR . "|") + (SEMI . ";") + (COLON . ":")) + 'punctuation) + +(define-lex-regex-type-analyzer semantic-grammar-wy--<symbol>-regexp-analyzer + "regexp analyzer for <symbol> tokens." + ":?\\(\\sw\\|\\s_\\)+" + '((PERCENT_PERCENT . "\\`%%\\'")) + 'SYMBOL) + +(define-lex-sexp-type-analyzer semantic-grammar-wy--<qlist>-sexp-analyzer + "sexp analyzer for <qlist> tokens." + "\\s'\\s-*(" + 'PREFIXED_LIST) + +(define-lex-sexp-type-analyzer semantic-grammar-wy--<sexp>-sexp-analyzer + "sexp analyzer for <sexp> tokens." + "\\=" + 'SEXP) + + +;;; Epilogue +;; + + + + +(provide 'semantic/grammar-wy) + +;; Local Variables: +;; version-control: never +;; no-update-autoloads: t +;; End: + +;;; semantic/grammar-wy.el ends here diff --git a/lisp/cedet/semantic/html.el b/lisp/cedet/semantic/html.el index 658d218a4a3..ad5d2c798fb 100644 --- a/lisp/cedet/semantic/html.el +++ b/lisp/cedet/semantic/html.el @@ -1,4 +1,4 @@ -;;; semantic/html.el --- Semantic details for html files +;;; semantic/html.el --- Semantic details for html files -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2005, 2007-2021 Free Software Foundation, Inc. @@ -59,14 +59,14 @@ "Alist of sectioning commands and their relative level.") (define-mode-local-override semantic-parse-region - html-mode (&rest ignore) + html-mode (&rest _ignore) "Parse the current html buffer for semantic tags. IGNORE any arguments. Always parse the whole buffer. Each tag returned is of the form: (\"NAME\" section (:members CHILDREN)) or (\"NAME\" anchor)" - (mapcar 'semantic-html-expand-tag + (mapcar #'semantic-html-expand-tag (semantic-html-parse-headings))) (define-mode-local-override semantic-parse-changes @@ -79,7 +79,7 @@ or (let ((chil (semantic-html-components tag))) (if chil (semantic-tag-put-attribute - tag :members (mapcar 'semantic-html-expand-tag chil))) + tag :members (mapcar #'semantic-html-expand-tag chil))) (car (semantic--tag-expand tag)))) (defun semantic-html-components (tag) @@ -233,7 +233,7 @@ tag with greater section value than LEVEL is found." ;; This will use our parser. (setq semantic-parser-name "HTML" semantic--parse-table t - imenu-create-index-function 'semantic-create-imenu-index + imenu-create-index-function #'semantic-create-imenu-index semantic-command-separation-character ">" semantic-type-relation-separator-character '(":") semantic-symbol->name-assoc-list '((section . "Section") diff --git a/lisp/cedet/semantic/ia-sb.el b/lisp/cedet/semantic/ia-sb.el index b132d41cd4a..12a2f1db92a 100644 --- a/lisp/cedet/semantic/ia-sb.el +++ b/lisp/cedet/semantic/ia-sb.el @@ -1,7 +1,6 @@ -;;; semantic/ia-sb.el --- Speedbar analysis display interactor +;;; semantic/ia-sb.el --- Speedbar analysis display interactor -*- lexical-binding: t; -*- -;;; Copyright (C) 2002-2004, 2006, 2008-2021 Free Software Foundation, -;;; Inc. +;; Copyright (C) 2002-2021 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: syntax @@ -30,18 +29,14 @@ (require 'speedbar) ;;; Code: -(defvar semantic-ia-sb-key-map nil +(defvar semantic-ia-sb-key-map + (let ((map (speedbar-make-specialized-keymap))) + ;; Basic features. + (define-key map "\C-m" #'speedbar-edit-line) + (define-key map "I" #'semantic-ia-sb-show-tag-info) + map) "Keymap used when in semantic analysis display mode.") -(if semantic-ia-sb-key-map - nil - (setq semantic-ia-sb-key-map (speedbar-make-specialized-keymap)) - - ;; Basic features. - (define-key semantic-ia-sb-key-map "\C-m" 'speedbar-edit-line) - (define-key semantic-ia-sb-key-map "I" 'semantic-ia-sb-show-tag-info) - ) - (defvar semantic-ia-sb-easymenu-definition '( "---" ; [ "Expand" speedbar-expand-line nil ] @@ -75,7 +70,7 @@ list of possible completions." (speedbar-change-initial-expansion-list "Analyze") ) -(defun semantic-ia-speedbar (directory zero) +(defun semantic-ia-speedbar (_directory _zero) "Create buttons in speedbar which define the current analysis at POINT. DIRECTORY is the current directory, which is ignored, and ZERO is 0." (let ((analysis nil) @@ -195,7 +190,7 @@ DIRECTORY is the current directory, which is ignored, and ZERO is 0." ;; An index for the argument the prefix is in: (let ((arg (oref context argument)) (args (semantic-tag-function-arguments (car func))) - (idx 0) + ;; (idx 0) ) (speedbar-insert-separator (format "Argument #%d" (oref context index))) @@ -275,7 +270,7 @@ See `semantic-ia-sb-tag-info' for more." (setq tok (get-text-property (point) 'speedbar-token))) (semantic-ia-sb-tag-info nil tok 0))) -(defun semantic-ia-sb-tag-info (text tag indent) +(defun semantic-ia-sb-tag-info (_text tag _indent) "Display as much information as we can about tag. Show the information in a shrunk split-buffer and expand out as many details as possible. @@ -322,16 +317,15 @@ TEXT, TAG, and INDENT are speedbar function arguments." (get-buffer-window "*Tag Information*"))) (select-frame speedbar-frame)))) -(defun semantic-ia-sb-line-path (&optional depth) +(defun semantic-ia-sb-line-path (&optional _depth) "Return the file name associated with DEPTH." (save-match-data (let* ((tok (speedbar-line-token)) - (buff (if (semantic-tag-buffer tok) - (semantic-tag-buffer tok) - (current-buffer)))) + (buff (or (semantic-tag-buffer tok) + (current-buffer)))) (buffer-file-name buff)))) -(defun semantic-ia-sb-complete (text tag indent) +(defun semantic-ia-sb-complete (_text tag _indent) "At point in the attached buffer, complete the symbol clicked on. TEXT TAG and INDENT are the details." ;; Find the specified bounds from the current analysis. diff --git a/lisp/cedet/semantic/ia.el b/lisp/cedet/semantic/ia.el index 6d3ec7570b5..7186a781235 100644 --- a/lisp/cedet/semantic/ia.el +++ b/lisp/cedet/semantic/ia.el @@ -1,6 +1,6 @@ -;;; semantic/ia.el --- Interactive Analysis functions +;;; semantic/ia.el --- Interactive Analysis functions -*- lexical-binding: t; -*- -;;; Copyright (C) 2000-2021 Free Software Foundation, Inc. +;; Copyright (C) 2000-2021 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: syntax @@ -79,13 +79,8 @@ (insert "(")) (t nil)))) -(defalias 'semantic-ia-get-completions 'semantic-ia-get-completions-deprecated) -(make-obsolete 'semantic-ia-get-completions - #'semantic-analyze-possible-completions "28.1") - -(defun semantic-ia-get-completions-deprecated (context point) - "A function to help transition away from `semantic-ia-get-completions'. -Return completions based on CONTEXT at POINT." +(defun semantic-ia-get-completions (context _point) + "Fetch the completion of CONTEXT at POINT." (declare (obsolete semantic-analyze-possible-completions "28.1")) (semantic-analyze-possible-completions context)) diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el index 9f1bcfa6916..b883573a30f 100644 --- a/lisp/cedet/semantic/idle.el +++ b/lisp/cedet/semantic/idle.el @@ -1,4 +1,4 @@ -;;; idle.el --- Schedule parsing tasks in idle time +;;; idle.el --- Schedule parsing tasks in idle time -*- lexical-binding: t; -*- ;; Copyright (C) 2003-2006, 2008-2021 Free Software Foundation, Inc. @@ -47,8 +47,6 @@ ;; For the semantic-find-tags-by-name macro. (eval-when-compile (require 'semantic/find)) -(defvar eldoc-last-message) -(declare-function eldoc-message "eldoc") (declare-function semantic-analyze-unsplit-name "semantic/analyze/fcn") (declare-function semantic-complete-analyze-inline-idle "semantic/complete") (declare-function semanticdb-deep-find-tags-by-name "semantic/db-find") @@ -173,7 +171,8 @@ date, and reparses while the user is idle (not typing.) The minor mode can be turned on only if semantic feature is available and the current buffer was set up for parsing. Return -non-nil if the minor mode is enabled." nil nil nil +non-nil if the minor mode is enabled." + :lighter nil (if semantic-idle-scheduler-mode (if (not (and (featurep 'semantic) (semantic-active-p))) (progn @@ -218,22 +217,22 @@ And also manages services that depend on tag values." (let* ((inhibit-quit nil) (buffers (delq (current-buffer) (delq nil - (mapcar #'(lambda (b) - (and (buffer-file-name b) - b)) + (mapcar (lambda (b) + (and (buffer-file-name b) + b)) (buffer-list))))) - safe ;; This safe is not used, but could be. + ;; safe ;; This safe is not used, but could be. others mode) (when (semantic-idle-scheduler-enabled-p) (save-excursion ;; First, reparse the current buffer. - (setq mode major-mode - safe (semantic-safe "Idle Parse Error: %S" - ;(error "Goofy error 1") - (semantic-idle-scheduler-refresh-tags) - ) - ) + (setq mode major-mode) + ;; (setq safe + (semantic-safe "Idle Parse Error: %S" + ;(error "Goofy error 1") + (semantic-idle-scheduler-refresh-tags)) + ;; Now loop over other buffers with same major mode, trying to ;; update them as well. Stop on keypress. (dolist (b buffers) @@ -350,54 +349,56 @@ Returns t if all processing succeeded." Visits Semantic controlled buffers, and makes sure all needed include files have been parsed, and that the typecache is up to date. Uses `semantic-idle-work-for-on-buffer' to do the work." - (let ((errbuf nil) - (interrupted - (semantic-exit-on-input 'idle-work-timer - (let* ((inhibit-quit nil) - (cb (current-buffer)) - (buffers (delq (current-buffer) - (delq nil - (mapcar #'(lambda (b) - (and (buffer-file-name b) - b)) - (buffer-list))))) - safe errbuf) - ;; First, handle long tasks in the current buffer. - (when (semantic-idle-scheduler-enabled-p) - (save-excursion - (setq safe (semantic-idle-work-for-one-buffer (current-buffer)) - ))) - (when (not safe) (push (current-buffer) errbuf)) - - ;; Now loop over other buffers with same major mode, trying to - ;; update them as well. Stop on keypress. - (dolist (b buffers) - (semantic-throw-on-input 'parsing-mode-buffers) - (with-current-buffer b - (when (semantic-idle-scheduler-enabled-p) - (and (semantic-idle-scheduler-enabled-p) - (unless (semantic-idle-work-for-one-buffer (current-buffer)) - (push (current-buffer) errbuf))) - )) - ) - - (when (and (featurep 'semantic/db) (semanticdb-minor-mode-p)) - ;; Save everything. - (semanticdb-save-all-db-idle) - - ;; Parse up files near our active buffer - (when semantic-idle-work-parse-neighboring-files-flag - (semantic-safe "Idle Work Parse Neighboring Files: %S" - (set-buffer cb) - (semantic-idle-scheduler-work-parse-neighboring-files)) - t) + (let* + ((errbuf nil) + (interrupted + (semantic-exit-on-input 'idle-work-timer + (let* ((inhibit-quit nil) + (cb (current-buffer)) + (buffers (delq (current-buffer) + (delq nil + (mapcar (lambda (b) + (and (buffer-file-name b) + b)) + (buffer-list))))) + safe) ;; errbuf + ;; First, handle long tasks in the current buffer. + (when (semantic-idle-scheduler-enabled-p) + (save-excursion + (setq safe (semantic-idle-work-for-one-buffer (current-buffer)) + ))) + (when (not safe) (push (current-buffer) errbuf)) + + ;; Now loop over other buffers with same major mode, trying to + ;; update them as well. Stop on keypress. + (dolist (b buffers) + (semantic-throw-on-input 'parsing-mode-buffers) + (with-current-buffer b + (when (semantic-idle-scheduler-enabled-p) + (and (semantic-idle-scheduler-enabled-p) + (unless (semantic-idle-work-for-one-buffer + (current-buffer)) + (push (current-buffer) errbuf))) + )) + ) - ;; Save everything... again - (semanticdb-save-all-db-idle) - ) + (when (and (featurep 'semantic/db) (semanticdb-minor-mode-p)) + ;; Save everything. + (semanticdb-save-all-db-idle) + + ;; Parse up files near our active buffer + (when semantic-idle-work-parse-neighboring-files-flag + (semantic-safe "Idle Work Parse Neighboring Files: %S" + (set-buffer cb) + (semantic-idle-scheduler-work-parse-neighboring-files)) + t) + + ;; Save everything... again + (semanticdb-save-all-db-idle) + ) - ;; Done w/ processing - nil)))) + ;; Done w/ processing + nil)))) ;; Done (if interrupted @@ -430,6 +431,8 @@ datasets." (message "Long Work Idle Timer...%s" exit-type))) ) +(defvar ede-auto-add-method) + (defun semantic-idle-scheduler-work-parse-neighboring-files () "Parse all the files in similar directories to buffers being edited." ;; Let's tell EDE to ignore all the files we're about to load @@ -564,11 +567,12 @@ DOC will be a documentation string describing FORMS. FORMS will be called during idle time after the current buffer's semantic tag information has been updated. This routine creates the following functions and variables:" + (declare (indent 1) (debug (&define name stringp def-body))) (let ((global (intern (concat "global-" (symbol-name name) "-mode"))) (mode (intern (concat (symbol-name name) "-mode"))) (hook (intern (concat (symbol-name name) "-mode-hook"))) (map (intern (concat (symbol-name name) "-mode-map"))) - (setup (intern (concat (symbol-name name) "-mode-setup"))) + ;; (setup (intern (concat (symbol-name name) "-mode-setup"))) (func (intern (concat (symbol-name name) "-idle-function")))) `(progn @@ -618,11 +622,6 @@ turned on in every Semantic-supported buffer.") ,(concat "Perform idle activity for the minor mode `" (symbol-name mode) "'.") ,@forms)))) -(put 'define-semantic-idle-service 'lisp-indent-function 1) -(add-hook 'edebug-setup-hook - (lambda () - (def-edebug-spec define-semantic-idle-service - (&define name stringp def-body)))) ;;; SUMMARY MODE ;; @@ -732,32 +731,19 @@ specific to a major mode. For example, in jde mode: :group 'semantic :type 'hook) -(defun semantic-idle-summary-idle-function () - "Display a tag summary of the lexical token under the cursor. +(defun semantic--eldoc-info (_callback &rest _) + "Return the eldoc info for the current symbol. Call `semantic-idle-summary-current-symbol-info' for getting the current tag to display information." (or (eq major-mode 'emacs-lisp-mode) (not (semantic-idle-summary-useful-context-p)) - (let* ((found (semantic-idle-summary-current-symbol-info)) + (let* ((found (save-excursion + (semantic-idle-summary-current-symbol-info))) (str (cond ((stringp found) found) ((semantic-tag-p found) (funcall semantic-idle-summary-function found nil t))))) - ;; Show the message with eldoc functions - (unless (and str (boundp 'eldoc-echo-area-use-multiline-p) - eldoc-echo-area-use-multiline-p) - (let ((w (1- (window-width (minibuffer-window))))) - (if (> (length str) w) - (setq str (substring str 0 w))))) - ;; I borrowed some bits from eldoc to shorten the - ;; message. - (when semantic-idle-truncate-long-summaries - (let ((ea-width (1- (window-width (minibuffer-window)))) - (strlen (length str))) - (when (> strlen ea-width) - (setq str (substring str 0 ea-width))))) - ;; Display it - (eldoc-message str)))) + str))) (define-minor-mode semantic-idle-summary-mode "Toggle Semantic Idle Summary mode. @@ -766,30 +752,16 @@ When this minor mode is enabled, the echo area displays a summary of the lexical token at point whenever Emacs is idle." :group 'semantic :group 'semantic-modes - (if semantic-idle-summary-mode - ;; Enable the mode - (progn - (unless (and (featurep 'semantic) (semantic-active-p)) - ;; Disable minor mode if semantic stuff not available - (setq semantic-idle-summary-mode nil) - (error "Buffer %s was not set up for parsing" - (buffer-name))) - (require 'eldoc) - (semantic-idle-scheduler-add 'semantic-idle-summary-idle-function) - (add-hook 'pre-command-hook 'semantic-idle-summary-refresh-echo-area t)) - ;; Disable the mode - (semantic-idle-scheduler-remove 'semantic-idle-summary-idle-function) - (remove-hook 'pre-command-hook 'semantic-idle-summary-refresh-echo-area t))) - -(defun semantic-idle-summary-refresh-echo-area () - (and semantic-idle-summary-mode - eldoc-last-message - (if (and (not executing-kbd-macro) - (not (and (boundp 'edebug-active) edebug-active)) - (not cursor-in-echo-area) - (not (eq (selected-window) (minibuffer-window)))) - (eldoc-message eldoc-last-message) - (setq eldoc-last-message nil)))) + (remove-hook 'eldoc-documentation-functions #'semantic--eldoc-info t) + (when semantic-idle-summary-mode + ;; Enable the mode + (unless (and (featurep 'semantic) (semantic-active-p)) + ;; Disable minor mode if semantic stuff not available + (setq semantic-idle-summary-mode nil) + (error "Buffer %s was not set up for parsing" + (buffer-name))) + (add-hook 'eldoc-documentation-functions #'semantic--eldoc-info nil t) + (eldoc-mode 1))) (semantic-add-minor-mode 'semantic-idle-summary-mode "") @@ -821,6 +793,8 @@ turned on in every Semantic-supported buffer." (make-obsolete-variable 'semantic-idle-symbol-highlight-face "customize the face `semantic-idle-symbol-highlight' instead" "24.4" 'set) +(defvar pulse-flag) + (defun semantic-idle-symbol-maybe-highlight (tag) "Perhaps add highlighting to the symbol represented by TAG. TAG was found as the symbol under point. If it happens to be @@ -898,7 +872,7 @@ Call `semantic-symref-hits-in-region' to identify local references." (when (semantic-tag-p target) (require 'semantic/symref/filter) (semantic-symref-hits-in-region - target (lambda (start end prefix) + target (lambda (start end _prefix) (when (/= start (car Hbounds)) (pulse-momentary-highlight-region start end semantic-idle-symbol-highlight-face)) @@ -1065,21 +1039,20 @@ be called." (popup-menu semantic-idle-breadcrumbs-popup-menu) (select-window old-window))) -(defmacro semantic-idle-breadcrumbs--tag-function (function) +(defun semantic-idle-breadcrumbs--tag-function (function) "Return lambda expression calling FUNCTION when called from a popup." - `(lambda (event) - (interactive "e") - (let* ((old-window (selected-window)) - (window (semantic-event-window event)) - (column (car (nth 6 (nth 1 event)))) ;; TODO semantic-event-column? - (tag (progn - (select-window window t) - (plist-get - (text-properties-at column header-line-format) - 'tag)))) - (,function tag) - (select-window old-window))) - ) + (lambda (event) + (interactive "e") + (let* ((old-window (selected-window)) + (window (semantic-event-window event)) + (column (car (nth 6 (nth 1 event)))) ;; TODO semantic-event-column? + (tag (progn + (select-window window t) + (plist-get + (text-properties-at column header-line-format) + 'tag)))) + (funcall function tag) + (select-window old-window)))) ;; TODO does this work for mode-line case? (defvar semantic-idle-breadcrumbs-popup-map @@ -1087,12 +1060,11 @@ be called." ;; mouse-1 goes to clicked tag (define-key map [ header-line mouse-1 ] - (semantic-idle-breadcrumbs--tag-function - semantic-go-to-tag)) + (semantic-idle-breadcrumbs--tag-function #'semantic-go-to-tag)) ;; mouse-3 pops up a context menu (define-key map [ header-line mouse-3 ] - 'semantic-idle-breadcrumbs--popup-menu) + #'semantic-idle-breadcrumbs--popup-menu) map) "Keymap for semantic idle breadcrumbs minor mode.") @@ -1104,8 +1076,7 @@ be called." "Breadcrumb Tag" (vector "Go to Tag" - (semantic-idle-breadcrumbs--tag-function - semantic-go-to-tag) + (semantic-idle-breadcrumbs--tag-function #'semantic-go-to-tag) :active t :help "Jump to this tag") ;; TODO these entries need minor changes (optional tag argument) in @@ -1113,37 +1084,32 @@ be called." ;; (semantic-menu-item ;; (vector ;; "Copy Tag" - ;; (semantic-idle-breadcrumbs--tag-function - ;; senator-copy-tag) + ;; (semantic-idle-breadcrumbs--tag-function #'senator-copy-tag) ;; :active t ;; :help "Copy this tag")) ;; (semantic-menu-item ;; (vector ;; "Kill Tag" - ;; (semantic-idle-breadcrumbs--tag-function - ;; senator-kill-tag) + ;; (semantic-idle-breadcrumbs--tag-function #'senator-kill-tag) ;; :active t ;; :help "Kill tag text to the kill ring, and copy the tag to ;; the tag ring")) ;; (semantic-menu-item ;; (vector ;; "Copy Tag to Register" - ;; (semantic-idle-breadcrumbs--tag-function - ;; senator-copy-tag-to-register) + ;; (semantic-idle-breadcrumbs--tag-function #'senator-copy-tag-to-register) ;; :active t ;; :help "Copy this tag")) ;; (semantic-menu-item ;; (vector ;; "Narrow to Tag" - ;; (semantic-idle-breadcrumbs--tag-function - ;; senator-narrow-to-defun) + ;; (semantic-idle-breadcrumbs--tag-function #'senator-narrow-to-defun) ;; :active t ;; :help "Narrow to the bounds of the current tag")) ;; (semantic-menu-item ;; (vector ;; "Fold Tag" - ;; (semantic-idle-breadcrumbs--tag-function - ;; senator-fold-tag-toggle) + ;; (semantic-idle-breadcrumbs--tag-function #'senator-fold-tag-toggle) ;; :active t ;; :style 'toggle ;; :selected '(let ((tag (semantic-current-tag))) @@ -1231,7 +1197,7 @@ shortened at the beginning." ) (defun semantic-idle-breadcrumbs--format-linear - (tag-list &optional max-length) + (tag-list &optional _max-length) "Format TAG-LIST as a linear list, starting with the outermost tag. MAX-LENGTH is not used." (require 'semantic/analyze/fcn) diff --git a/lisp/cedet/semantic/imenu.el b/lisp/cedet/semantic/imenu.el index 4c13959ba1d..a5db85bb512 100644 --- a/lisp/cedet/semantic/imenu.el +++ b/lisp/cedet/semantic/imenu.el @@ -1,4 +1,4 @@ -;;; semantic/imenu.el --- Use Semantic as an imenu tag generator +;;; semantic/imenu.el --- Use Semantic as an imenu tag generator -*- lexical-binding: t; -*- ;; Copyright (C) 2000-2005, 2007-2008, 2010-2021 Free Software ;; Foundation, Inc. @@ -57,14 +57,12 @@ (defcustom semantic-imenu-summary-function 'semantic-format-tag-abbreviate "Function to use when creating items in Imenu. Some useful functions are found in `semantic-format-tag-functions'." - :group 'semantic-imenu :type semantic-format-tag-custom-list) (make-variable-buffer-local 'semantic-imenu-summary-function) ;;;###autoload (defcustom semantic-imenu-bucketize-file t "Non-nil if tags in a file are to be grouped into buckets." - :group 'semantic-imenu :type 'boolean) (make-variable-buffer-local 'semantic-imenu-bucketize-file) @@ -72,20 +70,17 @@ Some useful functions are found in `semantic-format-tag-functions'." "Non-nil if types in a file should adopt externally defined members. C++ and CLOS can define methods that are not in the body of a class definition." - :group 'semantic-imenu :type 'boolean) (defcustom semantic-imenu-buckets-to-submenu t "Non-nil if buckets of tags are to be turned into submenus. This option is ignored if `semantic-imenu-bucketize-file' is nil." - :group 'semantic-imenu :type 'boolean) (make-variable-buffer-local 'semantic-imenu-buckets-to-submenu) ;;;###autoload (defcustom semantic-imenu-expand-type-members t "Non-nil if types should have submenus with members in them." - :group 'semantic-imenu :type 'boolean) (make-variable-buffer-local 'semantic-imenu-expand-type-members) @@ -93,7 +88,6 @@ This option is ignored if `semantic-imenu-bucketize-file' is nil." "Non-nil if members of a type should be grouped into buckets. A nil value means to keep them in the same order. Overridden to nil if `semantic-imenu-bucketize-file' is nil." - :group 'semantic-imenu :type 'boolean) (make-variable-buffer-local 'semantic-imenu-bucketize-type-members) @@ -101,7 +95,6 @@ Overridden to nil if `semantic-imenu-bucketize-file' is nil." "Function to use when sorting tags in the buckets of functions. See `semantic-bucketize' and the FILTER argument for more details on this function." - :group 'semantic-imenu :type '(radio (const :tag "No Sorting" nil) (const semantic-sort-tags-by-name-increasing) (const semantic-sort-tags-by-name-decreasing) @@ -119,14 +112,12 @@ on this function." Doesn't actually parse the entire directory, but displays tags for all files currently listed in the current Semantic database. This variable has no meaning if semanticdb is not active." - :group 'semantic-imenu :type 'boolean) (defcustom semantic-imenu-auto-rebuild-directory-indexes nil "If non-nil automatically rebuild directory index imenus. That is when a directory index imenu is updated, automatically rebuild other buffer local ones based on the same semanticdb." - :group 'semantic-imenu :type 'boolean) (defvar semantic-imenu-directory-current-file nil @@ -206,7 +197,7 @@ Optional argument REST is some extra stuff." (setq imenu--index-alist nil))))) )) -(defun semantic-imenu-flush-fcn (&optional ignore) +(defun semantic-imenu-flush-fcn (&optional _ignore) "This function is called as a hook to clear the imenu cache. It is cleared after any parsing. IGNORE arguments." @@ -214,9 +205,9 @@ IGNORE arguments." (setq imenu--index-alist nil imenu-menubar-modified-tick 0)) (remove-hook 'semantic-after-toplevel-cache-change-hook - 'semantic-imenu-flush-fcn t) + #'semantic-imenu-flush-fcn t) (remove-hook 'semantic-after-partial-cache-change-hook - 'semantic-imenu-flush-fcn t) + #'semantic-imenu-flush-fcn t) ) ;;;###autoload @@ -224,7 +215,7 @@ IGNORE arguments." "Create an imenu index for any buffer which supports Semantic. Uses the output of the Semantic parser to create the index. Optional argument STREAM is an optional stream of tags used to create menus." - (setq imenu-default-goto-function 'semantic-imenu-goto-function) + (setq imenu-default-goto-function #'semantic-imenu-goto-function) (prog1 (if (and semantic-imenu-index-directory (featurep 'semantic/db) @@ -234,9 +225,9 @@ Optional argument STREAM is an optional stream of tags used to create menus." (semantic-create-imenu-index-1 (or stream (semantic-fetch-tags-fast)) nil)) (add-hook 'semantic-after-toplevel-cache-change-hook - 'semantic-imenu-flush-fcn nil t) + #'semantic-imenu-flush-fcn nil t) (add-hook 'semantic-after-partial-cache-change-hook - 'semantic-imenu-flush-fcn nil t))) + #'semantic-imenu-flush-fcn nil t))) (defun semantic-create-imenu-directory-index (&optional stream) "Create an imenu tag index based on all files active in semanticdb. @@ -438,14 +429,14 @@ Optional argument PARENT is a tag parent of STREAM." Clears all imenu menus that may be depending on the database." (require 'semantic/db-mode) (semantic-map-buffers - #'(lambda () - ;; Set up semanticdb environment if enabled. - (if (semanticdb-minor-mode-p) - (semanticdb-semantic-init-hook-fcn)) - ;; Clear imenu cache to redraw the imenu. - (semantic-imenu-flush-fcn)))) + (lambda () + ;; Set up semanticdb environment if enabled. + (if (semanticdb-minor-mode-p) + (semanticdb-semantic-init-hook-fcn)) + ;; Clear imenu cache to redraw the imenu. + (semantic-imenu-flush-fcn)))) -(add-hook 'semanticdb-mode-hook 'semantic-imenu-semanticdb-hook) +(add-hook 'semanticdb-mode-hook #'semantic-imenu-semanticdb-hook) ;;; Interactive Utilities ;; @@ -484,7 +475,6 @@ Clears all imenu menus that may be depending on the database." (defcustom semantic-which-function-use-color nil "Use color when displaying the current function with `which-function'." - :group 'semantic-imenu :type 'boolean) (defun semantic-default-which-function (taglist) diff --git a/lisp/cedet/semantic/java.el b/lisp/cedet/semantic/java.el index f60f6e87ab7..0c2fb843f0b 100644 --- a/lisp/cedet/semantic/java.el +++ b/lisp/cedet/semantic/java.el @@ -1,6 +1,6 @@ -;;; semantic/java.el --- Semantic functions for Java +;;; semantic/java.el --- Semantic functions for Java -*- lexical-binding: t; -*- -;;; Copyright (C) 1999-2021 Free Software Foundation, Inc. +;; Copyright (C) 1999-2021 Free Software Foundation, Inc. ;; Author: David Ponce <david@dponce.com> @@ -141,14 +141,14 @@ corresponding compound declaration." (semantic-tag-put-attribute clone :dereference (+ dim0 (cdr dim))) (semantic-tag-set-bounds clone start end))) - ((and (eq class 'type) (string-match "\\." (semantic-tag-name tag))) + ((and (eq class 'type) (string-search "." (semantic-tag-name tag))) ;; javap outputs files where the package name is stuck onto the class or interface ;; name. To make this more regular, we extract the package name into a package statement, ;; then make the class name regular. (let* ((name (semantic-tag-name tag)) (rsplit (nreverse (split-string name "\\." t))) (newclassname (car rsplit)) - (newpkg (mapconcat 'identity (reverse (cdr rsplit)) "."))) + (newpkg (mapconcat #'identity (reverse (cdr rsplit)) "."))) (semantic-tag-set-name tag newclassname) (setq xpand (list tag @@ -169,7 +169,7 @@ corresponding compound declaration." (define-mode-local-override semantic-ctxt-scoped-types java-mode (&optional point) "Return a list of type names currently in scope at POINT." - (mapcar 'semantic-tag-name + (mapcar #'semantic-tag-name (semantic-find-tags-by-class 'type (semantic-find-tag-by-overlay point)))) @@ -184,7 +184,7 @@ Override function for `semantic-tag-protection'." ;; Prototype handler ;; -(defun semantic-java-prototype-function (tag &optional parent color) +(defun semantic-java-prototype-function (tag &optional _parent color) "Return a function (method) prototype for TAG. Optional argument PARENT is a parent (containing) item. Optional argument COLOR indicates that color should be mixed in. @@ -212,7 +212,7 @@ See also `semantic-format-tag-prototype'." (or type "") (if type " " "") name "(" argp ")"))) -(defun semantic-java-prototype-variable (tag &optional parent color) +(defun semantic-java-prototype-variable (tag &optional _parent color) "Return a variable (field) prototype for TAG. Optional argument PARENT is a parent (containing) item. Optional argument COLOR indicates that color should be mixed in. @@ -227,7 +227,7 @@ See also `semantic-format-tag-prototype'." (semantic--format-colorize-text name 'variable) name)))) -(defun semantic-java-prototype-type (tag &optional parent color) +(defun semantic-java-prototype-type (tag &optional _parent color) "Return a type (class/interface) prototype for TAG. Optional argument PARENT is a parent (containing) item. Optional argument COLOR indicates that color should be mixed in. @@ -260,7 +260,7 @@ Optional argument COLOR indicates that color should be mixed in." (define-mode-local-override semantic-tag-include-filename java-mode (tag) "Return a suitable path for (some) Java imports." (let ((name (semantic-tag-name tag))) - (concat (mapconcat 'identity (split-string name "\\.") "/") ".java"))) + (concat (mapconcat #'identity (split-string name "\\.") "/") ".java"))) ;; Documentation handler ;; @@ -395,11 +395,11 @@ receives two arguments: the javadoc keyword and its associated removed from the result list." (delq nil (mapcar - #'(lambda (k) - (let* ((tag (semantic-java-doc-tag k)) - (plist (semantic-lex-keyword-get tag 'javadoc))) - (if (or (not property) (plist-get plist property)) - (funcall fun k plist)))) + (lambda (k) + (let* ((tag (semantic-java-doc-tag k)) + (plist (semantic-lex-keyword-get tag 'javadoc))) + (if (or (not property) (plist-get plist property)) + (funcall fun k plist)))) semantic-java-doc-line-tags))) @@ -417,61 +417,59 @@ removed from the result list." (or semantic-java-doc-with-name-tags (setq semantic-java-doc-with-name-tags (semantic-java-doc-keywords-map - #'(lambda (k p) - k) + (lambda (k _p) k) 'with-name))) (or semantic-java-doc-with-ref-tags (setq semantic-java-doc-with-ref-tags (semantic-java-doc-keywords-map - #'(lambda (k p) - k) + (lambda (k _p) k) 'with-ref))) (or semantic-java-doc-extra-type-tags (setq semantic-java-doc-extra-type-tags (semantic-java-doc-keywords-map - #'(lambda (k p) - (if (memq 'type (plist-get p 'usage)) - k)) + (lambda (k p) + (if (memq 'type (plist-get p 'usage)) + k)) 'opt))) (or semantic-java-doc-extra-function-tags (setq semantic-java-doc-extra-function-tags (semantic-java-doc-keywords-map - #'(lambda (k p) - (if (memq 'function (plist-get p 'usage)) - k)) + (lambda (k p) + (if (memq 'function (plist-get p 'usage)) + k)) 'opt))) (or semantic-java-doc-extra-variable-tags (setq semantic-java-doc-extra-variable-tags (semantic-java-doc-keywords-map - #'(lambda (k p) - (if (memq 'variable (plist-get p 'usage)) - k)) + (lambda (k p) + (if (memq 'variable (plist-get p 'usage)) + k)) 'opt))) (or semantic-java-doc-type-tags (setq semantic-java-doc-type-tags (semantic-java-doc-keywords-map - #'(lambda (k p) - (if (memq 'type (plist-get p 'usage)) - k))))) + (lambda (k p) + (if (memq 'type (plist-get p 'usage)) + k))))) (or semantic-java-doc-function-tags (setq semantic-java-doc-function-tags (semantic-java-doc-keywords-map - #'(lambda (k p) - (if (memq 'function (plist-get p 'usage)) - k))))) + (lambda (k p) + (if (memq 'function (plist-get p 'usage)) + k))))) (or semantic-java-doc-variable-tags (setq semantic-java-doc-variable-tags (semantic-java-doc-keywords-map - #'(lambda (k p) - (if (memq 'variable (plist-get p 'usage)) - k))))) + (lambda (k p) + (if (memq 'variable (plist-get p 'usage)) + k))))) ) diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el index 408011c6286..8073640a8bd 100644 --- a/lisp/cedet/semantic/lex-spp.el +++ b/lisp/cedet/semantic/lex-spp.el @@ -1,4 +1,4 @@ -;;; semantic/lex-spp.el --- Semantic Lexical Pre-processor +;;; semantic/lex-spp.el --- Semantic Lexical Pre-processor -*- lexical-binding: t; -*- ;; Copyright (C) 2006-2021 Free Software Foundation, Inc. @@ -106,22 +106,12 @@ added and removed from this symbol table.") Pushes NAME into the macro stack. The above stack is checked by `semantic-lex-spp-symbol' to not return true for any symbol currently being expanded." + (declare (indent 1) (debug (symbolp def-body))) `(unwind-protect (progn (push ,name semantic-lex-spp-expanded-macro-stack) ,@body) (pop semantic-lex-spp-expanded-macro-stack))) -(put 'semantic-lex-with-macro-used 'lisp-indent-function 1) - -(add-hook - 'edebug-setup-hook - #'(lambda () - - (def-edebug-spec semantic-lex-with-macro-used - (symbolp def-body) - ) - - )) ;;; MACRO TABLE UTILS ;; @@ -190,7 +180,7 @@ Disable debugging by entering nothing." (setq semantic-lex-spp-debug-symbol nil) (setq semantic-lex-spp-debug-symbol sym))) -(defmacro semantic-lex-spp-validate-value (name value) +(defmacro semantic-lex-spp-validate-value (_name _value) "Validate the NAME and VALUE of a macro before it is set." ; `(progn ; (when (not (semantic-lex-spp-value-valid-p ,value)) @@ -212,12 +202,11 @@ the dynamic map." (semantic-lex-spp-dynamic-map))) value)) -(defsubst semantic-lex-spp-symbol-remove (name &optional obarray) +(defsubst semantic-lex-spp-symbol-remove (name &optional map) "Remove the spp symbol with NAME. -If optional OBARRAY is non-nil, then use that obarray instead of +If optional obarray MAP is non-nil, then use that obarray instead of the dynamic map." - (unintern name (or obarray - (semantic-lex-spp-dynamic-map)))) + (unintern name (or map (semantic-lex-spp-dynamic-map)))) (defun semantic-lex-spp-symbol-push (name value) "Push macro NAME with VALUE into the map. @@ -246,7 +235,7 @@ Reverse with `semantic-lex-spp-symbol-pop'." (stack (semantic-lex-spp-dynamic-map-stack)) (mapsym (intern name map)) (stacksym (intern name stack)) - (oldvalue nil) + ;; (oldvalue nil) ) (if (or (not (boundp stacksym) ) (= (length (symbol-value stacksym)) 0)) @@ -289,10 +278,10 @@ The return list is meant to be saved in a semanticdb table." (let (macros) (when (obarrayp semantic-lex-spp-dynamic-macro-symbol-obarray) (mapatoms - #'(lambda (symbol) - (setq macros (cons (cons (symbol-name symbol) - (symbol-value symbol)) - macros))) + (lambda (symbol) + (setq macros (cons (cons (symbol-name symbol) + (symbol-value symbol)) + macros))) semantic-lex-spp-dynamic-macro-symbol-obarray)) macros)) @@ -302,18 +291,18 @@ The value of each symbol is the replacement stream." (let (macros) (when (obarrayp semantic-lex-spp-macro-symbol-obarray) (mapatoms - #'(lambda (symbol) - (setq macros (cons symbol macros))) + (lambda (symbol) + (setq macros (cons symbol macros))) semantic-lex-spp-macro-symbol-obarray)) (when (obarrayp semantic-lex-spp-project-macro-symbol-obarray) (mapatoms - #'(lambda (symbol) - (setq macros (cons symbol macros))) + (lambda (symbol) + (setq macros (cons symbol macros))) semantic-lex-spp-project-macro-symbol-obarray)) (when (obarrayp semantic-lex-spp-dynamic-macro-symbol-obarray) (mapatoms - #'(lambda (symbol) - (setq macros (cons symbol macros))) + (lambda (symbol) + (setq macros (cons symbol macros))) semantic-lex-spp-dynamic-macro-symbol-obarray)) macros)) @@ -324,7 +313,7 @@ For use with semanticdb restoration of state." ;; Default obarray for below is the dynamic map. (semantic-lex-spp-symbol-set (car e) (cdr e)))) -(defun semantic-lex-spp-reset-hook (start end) +(defun semantic-lex-spp-reset-hook (start _end) "Reset anything needed by SPP for parsing. In this case, reset the dynamic macro symbol table if START is (point-min). @@ -354,7 +343,7 @@ Return non-nil if it matches" (string-match regex value)) )) -(defun semantic-lex-spp-simple-macro-to-macro-stream (val beg end argvalues) +(defun semantic-lex-spp-simple-macro-to-macro-stream (val beg end _argvalues) "Convert lexical macro contents VAL into a macro expansion stream. These are for simple macro expansions that a user may have typed in directly. As such, we need to analyze the input text, to figure out what kind of real @@ -819,7 +808,7 @@ ARGVALUES are values for any arg list, or nil." ;; An analyzer that will push tokens from a macro in place ;; of the macro symbol. ;; -(defun semantic-lex-spp-analyzer-do-replace (sym val beg end) +(defun semantic-lex-spp-analyzer-do-replace (_sym val beg end) "Do the lexical replacement for SYM with VAL. Argument BEG and END specify the bounds of SYM in the buffer." (if (not val) @@ -861,7 +850,7 @@ Argument BEG and END specify the bounds of SYM in the buffer." )) (define-obsolete-function-alias 'semantic-lex-spp-anlyzer-do-replace - 'semantic-lex-spp-analyzer-do-replace "25.1") + #'semantic-lex-spp-analyzer-do-replace "25.1") (defvar semantic-lex-spp-replacements-enabled t "Non-nil means do replacements when finding keywords. @@ -1045,7 +1034,7 @@ and variable state from the current buffer." (fresh-toks nil) (toks nil) (origbuff (current-buffer)) - (analyzer semantic-lex-analyzer) + ;; (analyzer semantic-lex-analyzer) (important-vars '(semantic-lex-spp-macro-symbol-obarray semantic-lex-spp-project-macro-symbol-obarray semantic-lex-spp-dynamic-macro-symbol-obarray @@ -1081,7 +1070,7 @@ and variable state from the current buffer." (semantic-lex-init) (semantic-clear-toplevel-cache) (remove-hook 'semantic-lex-reset-functions - 'semantic-lex-spp-reset-hook t) + #'semantic-lex-spp-reset-hook t) )) ;; Second Cheat: copy key variables regarding macro state from the @@ -1176,6 +1165,7 @@ of type `spp-macro-def' is to be created. VALFORM are forms that return the value to be saved for this macro, or nil. When implementing a macro, you can use `semantic-lex-spp-stream-for-macro' to convert text into a lexical stream for storage in the macro." + (declare (debug (&define name stringp stringp form def-body))) (let ((start (make-symbol "start")) (end (make-symbol "end")) (val (make-symbol "val")) @@ -1209,6 +1199,7 @@ REGEXP is a regular expression for the analyzer to match. See `define-lex-regex-analyzer' for more on regexp. TOKIDX is an index into REGEXP for which a new lexical token of type `spp-macro-undef' is to be created." + (declare (debug (&define name stringp stringp form))) (let ((start (make-symbol "start")) (end (make-symbol "end"))) `(define-lex-regex-analyzer ,name @@ -1244,7 +1235,7 @@ Note: Not implemented yet." :group 'semantic :type 'boolean) -(defun semantic-lex-spp-merge-header (name) +(defun semantic-lex-spp-merge-header (_name) "Extract and merge any macros from the header with NAME. Finds the header file belonging to NAME, gets the macros from that file, and then merge the macros with our current @@ -1269,6 +1260,7 @@ type of include. The return value should be of the form: (NAME . TYPE) where NAME is the name of the include, and TYPE is the type of the include, where a valid symbol is `system', or nil." + (declare (debug (&define name stringp stringp form def-body))) (let ((start (make-symbol "start")) (end (make-symbol "end")) (val (make-symbol "val")) @@ -1369,23 +1361,6 @@ If BUFFER is not provided, use the current buffer." (princ "\n") )))) -;;; EDEBUG Handlers -;; -(add-hook - 'edebug-setup-hook - #'(lambda () - - (def-edebug-spec define-lex-spp-macro-declaration-analyzer - (&define name stringp stringp form def-body) - ) - - (def-edebug-spec define-lex-spp-macro-undeclaration-analyzer - (&define name stringp stringp form) - ) - - (def-edebug-spec define-lex-spp-include-analyzer - (&define name stringp stringp form def-body)))) - (provide 'semantic/lex-spp) ;; Local variables: diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el index 4cafc7d4fe7..69f20deeb76 100644 --- a/lisp/cedet/semantic/lex.el +++ b/lisp/cedet/semantic/lex.el @@ -192,9 +192,9 @@ If optional PROPERTY is non-nil, call FUN only on every symbol which as a PROPERTY value. FUN receives a symbol as argument." (if (obarrayp table) (mapatoms - #'(lambda (symbol) - (if (or (null property) (get symbol property)) - (funcall fun symbol))) + (lambda (symbol) + (if (or (null property) (get symbol property)) + (funcall fun symbol))) table))) ;;; Lexical keyword table handling. @@ -286,7 +286,7 @@ If optional PROPERTY is non-nil, return only keywords which have a PROPERTY set." (let (keywords) (semantic-lex-map-keywords - #'(lambda (symbol) (setq keywords (cons symbol keywords))) + (lambda (symbol) (setq keywords (cons symbol keywords))) property) keywords)) @@ -462,18 +462,16 @@ If optional PROPERTY is non-nil, return only type symbols which have PROPERTY set." (let (types) (semantic-lex-map-types - #'(lambda (symbol) (setq types (cons symbol types))) + (lambda (symbol) (setq types (cons symbol types))) property) types)) ;;; Lexical Analyzer framework settings ;; -;; FIXME change to non-obsolete default. -(defvar-local semantic-lex-analyzer 'semantic-flex +(defvar-local semantic-lex-analyzer #'semantic-lex "The lexical analyzer used for a given buffer. -See `semantic-lex' for documentation. -For compatibility with Semantic 1.x it defaults to `semantic-flex'.") +See `semantic-lex' for documentation.") (defvar semantic-lex-tokens '( @@ -762,6 +760,7 @@ If two analyzers can match the same text, it is important to order the analyzers so that the one you want to match first occurs first. For example, it is good to put a number analyzer in front of a symbol analyzer which might mistake a number for a symbol." + (declare (debug (&define name stringp (&rest symbolp)))) `(defun ,name (start end &optional depth length) ,(concat doc "\nSee `semantic-lex' for more information.") ;; Make sure the state of block parsing starts over. @@ -1066,14 +1065,13 @@ the desired syntax, and a position returned. If `debug-on-error' is set, errors are not caught, so that you can debug them. Avoid using a large FORMS since it is duplicated." + (declare (indent 1) (debug t)) `(if (and debug-on-error semantic-lex-debug-analyzers) (progn ,@forms) (condition-case nil (progn ,@forms) (error (semantic-lex-unterminated-syntax-detected ,syntax))))) -(put 'semantic-lex-unterminated-syntax-protection - 'lisp-indent-function 1) (defmacro define-lex-analyzer (name doc condition &rest forms) "Create a single lexical analyzer NAME with DOC. @@ -1098,32 +1096,29 @@ Proper action in FORMS is to move the value of `semantic-lex-end-point' to after the location of the analyzed entry, and to add any discovered tokens at the beginning of `semantic-lex-token-stream'. This can be done by using `semantic-lex-push-token'." + (declare (debug (&define name stringp form def-body))) `(eval-and-compile - (defvar ,name nil ,doc) - (defun ,name nil) - ;; Do this part separately so that re-evaluation rebuilds this code. - (setq ,name '(,condition ,@forms)) + ;; This is the real info used by `define-lex' (via semantic-lex-one-token). + (defconst ,name '(,condition ,@forms) ,doc) ;; Build a single lexical analyzer function, so the doc for ;; function help is automatically provided, and perhaps the ;; function could be useful for testing and debugging one ;; analyzer. - (fset ',name (lambda () ,doc - (let ((semantic-lex-token-stream nil) - (semantic-lex-end-point (point)) - (semantic-lex-analysis-bounds - (cons (point) (point-max))) - (semantic-lex-current-depth 0) - (semantic-lex-maximum-depth - semantic-lex-depth) - ) - (when ,condition ,@forms) - semantic-lex-token-stream))) - )) + (defun ,name () + ,doc + (let ((semantic-lex-token-stream nil) + (semantic-lex-end-point (point)) + (semantic-lex-analysis-bounds (cons (point) (point-max))) + (semantic-lex-current-depth 0) + (semantic-lex-maximum-depth semantic-lex-depth)) + (when ,condition ,@forms) + semantic-lex-token-stream)))) (defmacro define-lex-regex-analyzer (name doc regexp &rest forms) "Create a lexical analyzer with NAME and DOC that will match REGEXP. FORMS are evaluated upon a successful match. See `define-lex-analyzer' for more about analyzers." + (declare (debug (&define name stringp form def-body))) `(define-lex-analyzer ,name ,doc (looking-at ,regexp) @@ -1141,6 +1136,8 @@ expression. FORMS are evaluated upon a successful match BEFORE the new token is created. It is valid to ignore FORMS. See `define-lex-analyzer' for more about analyzers." + (declare (debug + (&define name stringp form symbolp [ &optional form ] def-body))) `(define-lex-analyzer ,name ,doc (looking-at ,regexp) @@ -1165,6 +1162,7 @@ where BLOCK-SYM is the symbol returned in a block token. OPEN-DELIM and CLOSE-DELIM are respectively the open and close delimiters identifying a block. OPEN-SYM and CLOSE-SYM are respectively the symbols returned in open and close tokens." + (declare (debug (&define name stringp form (&rest form)))) (let ((specs (cons spec1 specs)) spec open olist clist) (while specs @@ -1686,6 +1684,7 @@ the error will be caught here without the buffer's cache being thrown out of date. If there is an error, the syntax that failed is returned. If there is no error, then the last value of FORMS is returned." + (declare (indent 1) (debug (symbolp def-body))) (let ((ret (make-symbol "ret")) (syntax (make-symbol "syntax")) (start (make-symbol "start")) @@ -1709,35 +1708,7 @@ If there is no error, then the last value of FORMS is returned." ;;(message "Buffer not currently parsable (%S)." ,ret) (semantic-parse-tree-unparseable)) ,ret))) -(put 'semantic-lex-catch-errors 'lisp-indent-function 1) - - -;;; Interfacing with edebug -;; -(add-hook - 'edebug-setup-hook - #'(lambda () - - (def-edebug-spec define-lex - (&define name stringp (&rest symbolp)) - ) - (def-edebug-spec define-lex-analyzer - (&define name stringp form def-body) - ) - (def-edebug-spec define-lex-regex-analyzer - (&define name stringp form def-body) - ) - (def-edebug-spec define-lex-simple-regex-analyzer - (&define name stringp form symbolp [ &optional form ] def-body) - ) - (def-edebug-spec define-lex-block-analyzer - (&define name stringp form (&rest form)) - ) - (def-edebug-spec semantic-lex-catch-errors - (symbolp def-body) - ) - )) ;;; Compatibility with Semantic 1.x lexical analysis diff --git a/lisp/cedet/semantic/mru-bookmark.el b/lisp/cedet/semantic/mru-bookmark.el index 956eb681f2c..2e77e6b75fb 100644 --- a/lisp/cedet/semantic/mru-bookmark.el +++ b/lisp/cedet/semantic/mru-bookmark.el @@ -1,4 +1,4 @@ -;;; semantic/mru-bookmark.el --- Automatic bookmark tracking +;;; semantic/mru-bookmark.el --- Automatic bookmark tracking -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. @@ -85,7 +85,7 @@ Nice values include the following: ) "A single bookmark.") -(cl-defmethod initialize-instance :after ((sbm semantic-bookmark) &rest fields) +(cl-defmethod initialize-instance :after ((sbm semantic-bookmark) &rest _fields) "Initialize the bookmark SBM with details about :tag." (condition-case nil (save-excursion @@ -216,7 +216,7 @@ Cause tags in the ring to become unlinked." (setq idx (1+ idx))))) (add-hook 'semantic-before-toplevel-cache-flush-hook - 'semantic-mrub-cache-flush-fcn) + #'semantic-mrub-cache-flush-fcn) ;;; EDIT tracker ;; @@ -246,8 +246,8 @@ been edited, and you can re-visit them with \\[semantic-mrub-switch-tags]." :group 'semantic-modes :type 'boolean :require 'semantic/util-modes - :initialize 'custom-initialize-default - :set (lambda (sym val) + :initialize #'custom-initialize-default + :set (lambda (_sym val) (global-semantic-mru-bookmark-mode (if val 1 -1)))) ;;;###autoload @@ -266,7 +266,7 @@ been edited, and you can re-visit them with \\[semantic-mrub-switch-tags]." (defvar semantic-mru-bookmark-mode-map (let ((km (make-sparse-keymap))) - (define-key km "\C-xB" 'semantic-mrub-switch-tags) + (define-key km "\C-xB" #'semantic-mrub-switch-tags) km) "Keymap for mru-bookmark minor mode.") @@ -289,14 +289,14 @@ non-nil if the minor mode is enabled." (error "Buffer %s was not set up for parsing" (buffer-name))) (add-hook 'semantic-edits-new-change-functions - 'semantic-mru-bookmark-change-hook-fcn nil t) + #'semantic-mru-bookmark-change-hook-fcn nil t) (add-hook 'semantic-edits-move-change-hooks - 'semantic-mru-bookmark-change-hook-fcn nil t)) + #'semantic-mru-bookmark-change-hook-fcn nil t)) ;; Remove hooks (remove-hook 'semantic-edits-new-change-functions - 'semantic-mru-bookmark-change-hook-fcn t) + #'semantic-mru-bookmark-change-hook-fcn t) (remove-hook 'semantic-edits-move-change-hooks - 'semantic-mru-bookmark-change-hook-fcn t))) + #'semantic-mru-bookmark-change-hook-fcn t))) (semantic-add-minor-mode 'semantic-mru-bookmark-mode "k") diff --git a/lisp/cedet/semantic/sb.el b/lisp/cedet/semantic/sb.el index d7cd8e1940c..fe981d34fb7 100644 --- a/lisp/cedet/semantic/sb.el +++ b/lisp/cedet/semantic/sb.el @@ -1,4 +1,4 @@ -;;; semantic/sb.el --- Semantic tag display for speedbar +;;; semantic/sb.el --- Semantic tag display for speedbar -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2021 Free Software Foundation, Inc. @@ -73,10 +73,10 @@ use the `speedbar-line-file' to get this info if needed." (defmacro semantic-sb-with-tag-buffer (tag &rest forms) "Set the current buffer to the origin of TAG and execute FORMS. Restore the old current buffer when completed." + (declare (indent 1) (debug t)) `(save-excursion (semantic-sb-tag-set-buffer ,tag) ,@forms)) -(put 'semantic-sb-with-tag-buffer 'lisp-indent-function 1) ;;; Button Generation ;; @@ -279,7 +279,7 @@ Optional MODIFIERS is additional text needed for variables." (defun semantic-sb-show-extra (text token indent) "Display additional information about the token as an expansion. TEXT TOKEN and INDENT are the details." - (cond ((string-match "\\+" text) ;we have to expand this file + (cond ((string-search "+" text) ;we have to expand this file (speedbar-change-expand-button-char ?-) (speedbar-with-writable (save-excursion @@ -288,13 +288,13 @@ TEXT TOKEN and INDENT are the details." (narrow-to-region (point) (point)) ;; Add in stuff specific to this type of token. (semantic-sb-insert-details token (1+ indent)))))) - ((string-match "-" text) ;we have to contract this node + ((string-search "-" text) ;we have to contract this node (speedbar-change-expand-button-char ?+) (speedbar-delete-subblock indent)) (t (error "Ooops... not sure what to do"))) (speedbar-center-buffer-smartly)) -(defun semantic-sb-token-jump (text token indent) +(defun semantic-sb-token-jump (_text token indent) "Jump to the location specified in token. TEXT TOKEN and INDENT are the details." (let ((file @@ -325,7 +325,7 @@ TEXT TOKEN and INDENT are the details." (defun semantic-sb-expand-group (text token indent) "Expand a group which has semantic tokens. TEXT TOKEN and INDENT are the details." - (cond ((string-match "\\+" text) ;we have to expand this file + (cond ((string-search "+" text) ;we have to expand this file (speedbar-change-expand-button-char ?-) (speedbar-with-writable (save-excursion @@ -333,7 +333,7 @@ TEXT TOKEN and INDENT are the details." (save-restriction (narrow-to-region (point-min) (point)) (semantic-sb-buttons-plain (1+ indent) token))))) - ((string-match "-" text) ;we have to contract this node + ((string-search "-" text) ;we have to contract this node (speedbar-change-expand-button-char ?+) (speedbar-delete-subblock indent)) (t (error "Ooops... not sure what to do"))) diff --git a/lisp/cedet/semantic/scope.el b/lisp/cedet/semantic/scope.el index 31576d29bc6..2d806e58eeb 100644 --- a/lisp/cedet/semantic/scope.el +++ b/lisp/cedet/semantic/scope.el @@ -1,4 +1,4 @@ -;;; semantic/scope.el --- Analyzer Scope Calculations +;;; semantic/scope.el --- Analyzer Scope Calculations -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. @@ -115,7 +115,7 @@ Saves scoping information between runs of the analyzer.") ) (cl-defmethod semanticdb-synchronize ((cache semantic-scope-cache) - new-tags) + _new-tags) "Synchronize a CACHE with some NEW-TAGS." (semantic-reset cache)) @@ -262,7 +262,7 @@ are from nesting data types." (semantic-go-to-tag pparent) (setq stack (semantic-find-tag-by-overlay (point))) ;; Step one, find the merged version of stack in the typecache. - (let* ((stacknames (reverse (mapcar 'semantic-tag-name stack))) + (let* ((stacknames (reverse (mapcar #'semantic-tag-name stack))) (tc nil) ) ;; @todo - can we use the typecache ability to @@ -317,7 +317,7 @@ are from nesting data types." ;; returnlist is empty. (while snlist (setq fullsearchname - (append (mapcar 'semantic-tag-name returnlist) + (append (mapcar #'semantic-tag-name returnlist) (list (car snlist)))) ;; Next one (setq ptag (semanticdb-typecache-find fullsearchname)) @@ -325,8 +325,8 @@ are from nesting data types." (when (or (not ptag) (not (semantic-tag-of-class-p ptag 'type))) (let ((rawscope - (apply 'append - (mapcar 'semantic-tag-type-members + (apply #'append + (mapcar #'semantic-tag-type-members (cons (car returnlist) scopetypes) ))) ) @@ -541,7 +541,7 @@ tag is not something you can complete from within TYPE." (setq leftover (cons S leftover))))) (nreverse leftover))) -(defun semantic-analyze-scoped-type-parts (type &optional scope noinherit protection) +(defun semantic-analyze-scoped-type-parts (type &optional scope noinherit _protection) "Return all parts of TYPE, a tag representing a TYPE declaration. SCOPE is the scope object. NOINHERIT turns off searching of inherited tags. @@ -562,7 +562,7 @@ such as `public' or `private'." ;; @TODO - is this line needed?? Try w/out for a while ;; @note - I think C++ says no. elisp might, but methods ;; look like defuns, so it makes no difference. - (extmeth nil) ; (semantic-tag-external-member-children type t)) + ;;(extmeth nil) ; (semantic-tag-external-member-children type t)) ;; INHERITED are tags found in classes that our TYPE tag ;; inherits from. Do not do this if it was not requested. @@ -584,7 +584,7 @@ such as `public' or `private'." (setq slots (nreverse copyslots)) )) ;; Flatten the database output. - (append slots extmeth inherited) + (append slots nil inherited) ;; extmeth ))) (defun semantic-analyze-scoped-inherited-tags (type scope access) diff --git a/lisp/cedet/semantic/senator.el b/lisp/cedet/semantic/senator.el index f33356a170c..19530094fbe 100644 --- a/lisp/cedet/semantic/senator.el +++ b/lisp/cedet/semantic/senator.el @@ -1,4 +1,4 @@ -;;; semantic/senator.el --- SEmantic NAvigaTOR +;;; semantic/senator.el --- SEmantic NAvigaTOR -*- lexical-binding: t; -*- ;; Copyright (C) 2000-2021 Free Software Foundation, Inc. @@ -60,7 +60,6 @@ A tag class is a symbol, such as `variable', `function', or `type'. As a special exception, if the value is nil, Senator's navigation commands recognize all tag classes." - :group 'senator :type '(repeat (symbol))) ;;;###autoload (make-variable-buffer-local 'senator-step-at-tag-classes) @@ -78,7 +77,6 @@ commands stop at the beginning of every tag. If t, the navigation commands stop at the start and end of any tag, where possible." - :group 'senator :type '(choice :tag "Identifiers" (repeat :menu-tag "Symbols" (symbol)) (const :tag "All" t))) @@ -87,7 +85,6 @@ tag, where possible." (defcustom senator-highlight-found nil "If non-nil, Senator commands momentarily highlight found tags." - :group 'senator :type 'boolean) (make-variable-buffer-local 'senator-highlight-found) @@ -193,7 +190,6 @@ source." '(code block) "List of ignored tag classes. Tags of those classes are excluded from search." - :group 'senator :type '(repeat (symbol :tag "class"))) (defun senator-search-default-tag-filter (tag) @@ -461,7 +457,7 @@ filters in `senator-search-tag-filter-functions' remain active." ((symbolp classes) (list classes)) ((stringp classes) - (mapcar 'read (split-string classes))) + (mapcar #'read (split-string classes))) (t (signal 'wrong-type-argument (list classes))) )) @@ -470,11 +466,10 @@ filters in `senator-search-tag-filter-functions' remain active." senator--search-filter t) (kill-local-variable 'senator--search-filter) (if classes - (let ((tag (make-symbol "tag")) - (names (mapconcat 'symbol-name classes "', `"))) + (let ((names (mapconcat #'symbol-name classes "', `"))) (setq-local senator--search-filter - `(lambda (,tag) - (memq (semantic-tag-class ,tag) ',classes))) + (lambda (tag) + (memq (semantic-tag-class tag) classes))) (add-hook 'senator-search-tag-filter-functions senator--search-filter nil t) (message "Limit search to `%s' tags" names)) @@ -605,7 +600,7 @@ Makes C/C++ language like assumptions." "Non-nil if isearch does semantic search. This is a buffer local variable.") -(defun senator-beginning-of-defun (&optional arg) +(defun senator-beginning-of-defun (&optional _arg) "Move backward to the beginning of a defun. Use semantic tags to navigate. ARG is the number of tags to navigate (not yet implemented)." @@ -620,7 +615,7 @@ ARG is the number of tags to navigate (not yet implemented)." (goto-char (semantic-tag-start tag))) (beginning-of-line)))) -(defun senator-end-of-defun (&optional arg) +(defun senator-end-of-defun (&optional _arg) "Move forward to next end of defun. Use semantic tags to navigate. ARG is the number of tags to navigate (not yet implemented)." @@ -859,7 +854,7 @@ Use a senator search function when semantic isearch mode is enabled." (setq-local senator-old-isearch-search-fun isearch-search-fun-function)) (setq-local isearch-search-fun-function - 'senator-isearch-search-fun)) + #'senator-isearch-search-fun)) ;; When `senator-isearch-semantic-mode' is off restore the ;; previous `isearch-search-fun-function'. (when (eq isearch-search-fun-function 'senator-isearch-search-fun) diff --git a/lisp/cedet/semantic/sort.el b/lisp/cedet/semantic/sort.el index 19f46ff7f15..b4b09dc02c8 100644 --- a/lisp/cedet/semantic/sort.el +++ b/lisp/cedet/semantic/sort.el @@ -1,6 +1,6 @@ -;;; semantic/sort.el --- Utilities for sorting and re-arranging tag tables. +;;; semantic/sort.el --- Utilities for sorting and re-arranging tag tables. -*- lexical-binding: t; -*- -;;; Copyright (C) 1999-2005, 2007-2021 Free Software Foundation, Inc. +;; Copyright (C) 1999-2021 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: syntax @@ -233,8 +233,7 @@ unmodified as components of their parent tags." (semantic-flatten-tags-table components) lists))))) table) - (apply 'append (nreverse lists)) - )) + (apply #'append (nreverse lists)))) ;;; Buckets: @@ -520,12 +519,11 @@ See `semantic-tag-external-member-children' for details." (semantic-tag-name tag) tag))) (if m (apply #'append (mapcar #'cdr m)))) (semantic--find-tags-by-function - `(lambda (tok) - ;; This bit of annoying backquote forces the contents of - ;; tag into the generated lambda. - (semantic-tag-external-member-p ',tag tok)) - (current-buffer)) - )) + (lambda (tok) + ;; This bit of annoying backquote forces the contents of + ;; tag into the generated lambda. + (semantic-tag-external-member-p tag tok)) + (current-buffer)))) (define-overloadable-function semantic-tag-external-class (tag) "Return a list of real tags that faux TAG might represent. @@ -540,6 +538,8 @@ likely derived, then this function is needed." (:override) ) +(defvar semanticdb-search-system-databases) + (defun semantic-tag-external-class-default (tag) "Return a list of real tags that faux TAG might represent. See `semantic-tag-external-class' for details." diff --git a/lisp/cedet/semantic/symref.el b/lisp/cedet/semantic/symref.el index d7f91573d3d..701f9ad3e03 100644 --- a/lisp/cedet/semantic/symref.el +++ b/lisp/cedet/semantic/symref.el @@ -1,4 +1,4 @@ -;;; semantic/symref.el --- Symbol Reference API +;;; semantic/symref.el --- Symbol Reference API -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -144,7 +144,7 @@ ARGS are the initialization arguments to pass to the created class." ) (when (not (class-p class)) (error "Unknown symref tool %s" semantic-symref-tool)) - (setq inst (apply 'make-instance class args)) + (setq inst (apply #'make-instance class args)) inst)) (defvar semantic-symref-last-result nil @@ -427,7 +427,7 @@ until the next command is executed." (kill-buffer buff))) semantic-symref-recently-opened-buffers) (setq semantic-symref-recently-opened-buffers nil) - (remove-hook 'post-command-hook 'semantic-symref-cleanup-recent-buffers-fcn) + (remove-hook 'post-command-hook #'semantic-symref-cleanup-recent-buffers-fcn) ) (cl-defmethod semantic-symref-result-get-tags ((result semantic-symref-result) @@ -453,7 +453,7 @@ already." lines))) ;; Kill off dead buffers, unless we were requested to leave them open. (if (not open-buffers) - (add-hook 'post-command-hook 'semantic-symref-cleanup-recent-buffers-fcn) + (add-hook 'post-command-hook #'semantic-symref-cleanup-recent-buffers-fcn) ;; Else, just clear the saved buffers so they aren't deleted later. (setq semantic-symref-recently-opened-buffers nil) ) diff --git a/lisp/cedet/semantic/symref/cscope.el b/lisp/cedet/semantic/symref/cscope.el index 3686e519460..e63b7a7e914 100644 --- a/lisp/cedet/semantic/symref/cscope.el +++ b/lisp/cedet/semantic/symref/cscope.el @@ -1,6 +1,6 @@ -;;; semantic/symref/cscope.el --- Semantic-symref support via cscope. +;;; semantic/symref/cscope.el --- Semantic-symref support via cscope -*- lexical-binding: t; -*- -;;; Copyright (C) 2009-2021 Free Software Foundation, Inc. +;; Copyright (C) 2009-2021 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> diff --git a/lisp/cedet/semantic/symref/filter.el b/lisp/cedet/semantic/symref/filter.el index a40ce13f3d6..7ef3cd90d67 100644 --- a/lisp/cedet/semantic/symref/filter.el +++ b/lisp/cedet/semantic/symref/filter.el @@ -1,4 +1,4 @@ -;;; semantic/symref/filter.el --- Filter symbol reference hits for accuracy. +;;; semantic/symref/filter.el --- Filter symbol reference hits for accuracy -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2021 Free Software Foundation, Inc. @@ -48,7 +48,7 @@ "Determine if the tag TARGET is used at POSITION in the current buffer. Return non-nil for a match." (semantic-analyze-current-symbol - (lambda (start end prefix) + (lambda (_start _end prefix) (let ((tag (car (nreverse prefix)))) (and (semantic-tag-p tag) (semantic-equivalent-tag-p target tag)))) @@ -97,7 +97,7 @@ tag that contains point, and return that." (Lcount 0)) (when (semantic-tag-p target) (semantic-symref-hits-in-region - target (lambda (start end prefix) (setq Lcount (1+ Lcount))) + target (lambda (_start _end _prefix) (setq Lcount (1+ Lcount))) (semantic-tag-start tag) (semantic-tag-end tag)) (when (called-interactively-p 'interactive) @@ -106,6 +106,8 @@ tag that contains point, and return that." (semantic-elapsed-time start nil))) Lcount))) +(defvar srecode-field-archive) + (defun semantic-symref-rename-local-variable () "Fancy way to rename the local variable under point. Depends on the SRecode Field editing API." @@ -140,7 +142,7 @@ Depends on the SRecode Field editing API." (region nil) ) (semantic-symref-hits-in-region - target (lambda (start end prefix) + target (lambda (start end _prefix) ;; For every valid hit, create one field. (srecode-field "LOCAL" :name "LOCAL" :start start :end end)) (semantic-tag-start tag) (semantic-tag-end tag)) diff --git a/lisp/cedet/semantic/symref/global.el b/lisp/cedet/semantic/symref/global.el index 7f63e4ddbc0..23e40349a6b 100644 --- a/lisp/cedet/semantic/symref/global.el +++ b/lisp/cedet/semantic/symref/global.el @@ -1,4 +1,4 @@ -;;; semantic/symref/global.el --- Use GNU Global for symbol references +;;; semantic/symref/global.el --- Use GNU Global for symbol references -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. diff --git a/lisp/cedet/semantic/symref/grep.el b/lisp/cedet/semantic/symref/grep.el index 9f0ac38ec75..180d779a780 100644 --- a/lisp/cedet/semantic/symref/grep.el +++ b/lisp/cedet/semantic/symref/grep.el @@ -1,4 +1,4 @@ -;;; semantic/symref/grep.el --- Symref implementation using find/grep +;;; semantic/symref/grep.el --- Symref implementation using find/grep -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -168,7 +168,7 @@ This shell should support pipe redirect syntax." (erase-buffer) (setq default-directory rootdir) (let ((cmd (semantic-symref-grep-use-template - (file-name-as-directory (file-local-name rootdir)) + (directory-file-name (file-local-name rootdir)) filepattern grepflags greppat))) (process-file semantic-symref-grep-shell nil b nil shell-command-switch cmd))) diff --git a/lisp/cedet/semantic/symref/idutils.el b/lisp/cedet/semantic/symref/idutils.el index 4a41355dd69..3e3e3b0a940 100644 --- a/lisp/cedet/semantic/symref/idutils.el +++ b/lisp/cedet/semantic/symref/idutils.el @@ -1,6 +1,6 @@ -;;; semantic/symref/idutils.el --- Symref implementation for idutils +;;; semantic/symref/idutils.el --- Symref implementation for idutils -*- lexical-binding: t; -*- -;;; Copyright (C) 2009-2021 Free Software Foundation, Inc. +;; Copyright (C) 2009-2021 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> diff --git a/lisp/cedet/semantic/symref/list.el b/lisp/cedet/semantic/symref/list.el index 7d3a5ddc2dc..2e447bbc582 100644 --- a/lisp/cedet/semantic/symref/list.el +++ b/lisp/cedet/semantic/symref/list.el @@ -1,4 +1,4 @@ -;;; semantic/symref/list.el --- Symref Output List UI. +;;; semantic/symref/list.el --- Symref Output List UI -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -108,20 +108,20 @@ Display the references in `semantic-symref-results-mode'." (defvar semantic-symref-results-mode-map (let ((km (make-sparse-keymap))) (suppress-keymap km) - (define-key km "\C-i" 'forward-button) - (define-key km "\M-C-i" 'backward-button) - (define-key km " " 'push-button) - (define-key km "-" 'semantic-symref-list-toggle-showing) - (define-key km "=" 'semantic-symref-list-toggle-showing) - (define-key km "+" 'semantic-symref-list-toggle-showing) - (define-key km "n" 'semantic-symref-list-next-line) - (define-key km "p" 'semantic-symref-list-prev-line) - (define-key km "q" 'quit-window) - (define-key km "\C-c\C-e" 'semantic-symref-list-expand-all) - (define-key km "\C-c\C-r" 'semantic-symref-list-contract-all) - (define-key km "R" 'semantic-symref-list-rename-open-hits) - (define-key km "(" 'semantic-symref-list-create-macro-on-open-hit) - (define-key km "E" 'semantic-symref-list-call-macro-on-open-hits) + (define-key km "\C-i" #'forward-button) + (define-key km "\M-C-i" #'backward-button) + (define-key km " " #'push-button) + (define-key km "-" #'semantic-symref-list-toggle-showing) + (define-key km "=" #'semantic-symref-list-toggle-showing) + (define-key km "+" #'semantic-symref-list-toggle-showing) + (define-key km "n" #'semantic-symref-list-next-line) + (define-key km "p" #'semantic-symref-list-prev-line) + (define-key km "q" #'quit-window) + (define-key km "\C-c\C-e" #'semantic-symref-list-expand-all) + (define-key km "\C-c\C-r" #'semantic-symref-list-contract-all) + (define-key km "R" #'semantic-symref-list-rename-open-hits) + (define-key km "(" #'semantic-symref-list-create-macro-on-open-hit) + (define-key km "E" #'semantic-symref-list-call-macro-on-open-hits) km) "Keymap used in `semantic-symref-results-mode'.") diff --git a/lisp/cedet/semantic/tag-file.el b/lisp/cedet/semantic/tag-file.el index fc5c27752a0..06dd274b323 100644 --- a/lisp/cedet/semantic/tag-file.el +++ b/lisp/cedet/semantic/tag-file.el @@ -1,4 +1,4 @@ -;;; semantic/tag-file.el --- Routines that find files based on tags. +;;; semantic/tag-file.el --- Routines that find files based on tags. -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2005, 2007-2021 Free Software Foundation, Inc. diff --git a/lisp/cedet/semantic/tag-ls.el b/lisp/cedet/semantic/tag-ls.el index 6cef603af35..3aa1a62901c 100644 --- a/lisp/cedet/semantic/tag-ls.el +++ b/lisp/cedet/semantic/tag-ls.el @@ -1,4 +1,4 @@ -;;; semantic/tag-ls.el --- Language Specific override functions for tags +;;; semantic/tag-ls.el --- Language Specific override functions for tags -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2004, 2006-2021 Free Software Foundation, Inc. @@ -97,7 +97,7 @@ Modes that override this function can call `semantic--tag-attribute-similar-p-default' to do the default equality tests if ATTR is not special for that mode.") -(defun semantic--tag-attribute-similar-p-default (attr value1 value2 ignorable-attributes) +(defun semantic--tag-attribute-similar-p-default (_attr value1 value2 ignorable-attributes) "For ATTR, VALUE1, VALUE2 and IGNORABLE-ATTRIBUTES, test for similarity." (cond ;; Tag sublists require special testing. @@ -109,7 +109,7 @@ ATTR is not special for that mode.") (when (not (eq (length taglist1) (length taglist2))) (setq ans nil)) (while (and ans taglist1 taglist2) - (setq ans (apply 'semantic-tag-similar-p + (setq ans (apply #'semantic-tag-similar-p (car taglist1) (car taglist2) ignorable-attributes) taglist1 (cdr taglist1) @@ -205,7 +205,7 @@ stream for a tag of class `package', and return that." (or stream-or-buffer tag)))) (:override-with-args (tag stream)))) -(defun semantic-tag-full-package-default (tag stream) +(defun semantic-tag-full-package-default (_tag stream) "Default method for `semantic-tag-full-package' for TAG. Return the name of the first tag of class `package' in STREAM." (let ((pack (car-safe (semantic-find-tags-by-class 'package stream)))) @@ -285,7 +285,7 @@ is to return a symbol based on type modifiers." (setq parent (semantic-tag-calculate-parent tag))) (:override)) -(defun semantic-tag-protection-default (tag &optional parent) +(defun semantic-tag-protection-default (tag &optional _parent) "Return the protection of TAG as a child of PARENT default action. See `semantic-tag-protection'." (let ((mods (semantic-tag-modifiers tag)) @@ -295,9 +295,7 @@ See `semantic-tag-protection'." (let ((s (car mods))) (setq prot ;; A few silly defaults to get things started. - (cond ((or (string= s "public") - (string= s "extern") - (string= s "export")) + (cond ((member s '("public" "extern" "export")) 'public) ((string= s "private") 'private) @@ -372,15 +370,14 @@ in how methods are overridden. In UML, abstract methods are italicized. The default behavior (if not overridden with `tag-abstract-p' is to return true if `abstract' is in the type modifiers.") -(defun semantic-tag-abstract-p-default (tag &optional parent) +(defun semantic-tag-abstract-p-default (tag &optional _parent) "Return non-nil if TAG is abstract as a child of PARENT default action. See `semantic-tag-abstract-p'." (let ((mods (semantic-tag-modifiers tag)) (abs nil)) (while (and (not abs) mods) (if (stringp (car mods)) - (setq abs (or (string= (car mods) "abstract") - (string= (car mods) "virtual")))) + (setq abs (member (car mods) '("abstract" "virtual")))) (setq mods (cdr mods))) abs)) @@ -392,7 +389,7 @@ In UML, leaf methods and classes have special meaning and behavior. The default behavior (if not overridden with `tag-leaf-p' is to return true if `leaf' is in the type modifiers.") -(defun semantic-tag-leaf-p-default (tag &optional parent) +(defun semantic-tag-leaf-p-default (tag &optional _parent) "Return non-nil if TAG is leaf as a child of PARENT default action. See `semantic-tag-leaf-p'." (let ((mods (semantic-tag-modifiers tag)) @@ -412,7 +409,7 @@ In UML, static methods and attributes mean that they are allocated in the parent class, and are not instance specific. UML notation specifies that STATIC entries are underlined.") -(defun semantic-tag-static-p-default (tag &optional parent) +(defun semantic-tag-static-p-default (tag &optional _parent) "Return non-nil if TAG is static as a child of PARENT default action. See `semantic-tag-static-p'." (let ((mods (semantic-tag-modifiers tag)) diff --git a/lisp/cedet/semantic/tag-write.el b/lisp/cedet/semantic/tag-write.el index f705c89c904..9d5aeea098b 100644 --- a/lisp/cedet/semantic/tag-write.el +++ b/lisp/cedet/semantic/tag-write.el @@ -1,4 +1,4 @@ -;;; semantic/tag-write.el --- Write tags to a text stream +;;; semantic/tag-write.el --- Write tags to a text stream -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -88,7 +88,7 @@ INDENT is the amount of indentation to use for this tag." (if (semantic-tag-with-position-p tag) (let ((bounds (semantic-tag-bounds tag))) (princ " ") - (prin1 (apply 'vector bounds)) + (prin1 (apply #'vector bounds)) ) (princ " nil")) ;; End it. 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. diff --git a/lisp/cedet/semantic/texi.el b/lisp/cedet/semantic/texi.el index 377cec5455d..5a38280d2a2 100644 --- a/lisp/cedet/semantic/texi.el +++ b/lisp/cedet/semantic/texi.el @@ -1,4 +1,4 @@ -;;; semantic/texi.el --- Semantic details for Texinfo files +;;; semantic/texi.el --- Semantic details for Texinfo files -*- lexical-binding: t; -*- ;; Copyright (C) 2001-2005, 2007-2021 Free Software Foundation, Inc. @@ -55,7 +55,7 @@ The field position is the field number (based at 1) where the name of this section is.") ;;; Code: -(defun semantic-texi-parse-region (&rest ignore) +(defun semantic-texi-parse-region (&rest _ignore) "Parse the current texinfo buffer for semantic tags. IGNORE any arguments, always parse the whole buffer. Each tag returned is of the form: @@ -79,7 +79,7 @@ function `semantic-install-function-overrides'." (let ((chil (semantic-tag-components tag))) (if chil (semantic-tag-put-attribute - tag :members (mapcar 'semantic-texi-expand-tag chil))) + tag :members (mapcar #'semantic-texi-expand-tag chil))) (car (semantic--tag-expand tag)))) (defun semantic-texi-parse-headings () @@ -297,7 +297,7 @@ can handle the @menu environment.") nil)) (define-mode-local-override semantic-ctxt-current-class-list - texinfo-mode (&optional point) + texinfo-mode (&optional _point) "Determine the class of tags that can be used at POINT. For texinfo, there two possibilities returned. 1) `function' - for a call to a texinfo function @@ -368,7 +368,7 @@ Optional argument POINT is where to look for the environment." (declare-function semantic-analyze-context "semantic/analyze") (define-mode-local-override semantic-analyze-current-context - texinfo-mode (point) + texinfo-mode (_point) "Analysis context makes no sense for texinfo. Return nil." (let* ((prefixandbounds (semantic-ctxt-current-symbol-and-bounds (point))) (prefix (car prefixandbounds)) @@ -408,7 +408,7 @@ Optional argument POINT is where to look for the environment." "List of commands that we might bother completing.") (define-mode-local-override semantic-analyze-possible-completions - texinfo-mode (context &rest flags) + texinfo-mode (context &rest _flags) "List smart completions at point. Since texinfo is not a programming language the default version is not useful. Instead, look at the current symbol. If it is a command @@ -451,7 +451,7 @@ that start with that symbol." (setq semantic-parser-name "TEXI" ;; Setup a dummy parser table to enable parsing! semantic--parse-table t - imenu-create-index-function 'semantic-create-imenu-index + imenu-create-index-function #'semantic-create-imenu-index semantic-command-separation-character "@" semantic-type-relation-separator-character '(":") semantic-symbol->name-assoc-list '((section . "Section") @@ -466,7 +466,7 @@ that start with that symbol." ;; (local-set-key [(f9)] 'semantic-texi-update-doc-from-texi) ) -(add-hook 'texinfo-mode-hook 'semantic-default-texi-setup) +(add-hook 'texinfo-mode-hook #'semantic-default-texi-setup) ;;; Special features of Texinfo tag streams @@ -500,7 +500,7 @@ that start with that symbol." ;; Turns out this might not be useful. ;; Delete later if that is true. -(defun semantic-texi-find-documentation (name &optional type) +(defun semantic-texi-find-documentation (name &optional _type) "Find the function or variable NAME of TYPE in the texinfo source. NAME is a string representing some functional symbol. TYPE is a string, such as \"variable\" or \"Command\" used to find diff --git a/lisp/cedet/semantic/util-modes.el b/lisp/cedet/semantic/util-modes.el index 0de66d29e3e..106862837a1 100644 --- a/lisp/cedet/semantic/util-modes.el +++ b/lisp/cedet/semantic/util-modes.el @@ -1,4 +1,4 @@ -;;; semantic/util-modes.el --- Semantic minor modes +;;; semantic/util-modes.el --- Semantic minor modes -*- lexical-binding: t; -*- ;; Copyright (C) 2000-2005, 2007-2021 Free Software Foundation, Inc. @@ -48,7 +48,7 @@ line." :group 'semantic :type 'boolean :require 'semantic/util-modes - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :set (lambda (sym val) (set-default sym val) ;; Update status of all Semantic enabled buffers @@ -60,7 +60,7 @@ line." :group 'semantic :type 'string :require 'semantic/util-modes - :initialize 'custom-initialize-default) + :initialize #'custom-initialize-default) (defvar semantic-minor-modes-format nil "Mode line format showing Semantic minor modes which are locally enabled. @@ -93,7 +93,7 @@ Only minor modes that are locally enabled are shown in the mode line." (match-string 1 semantic-mode-line-prefix) "S"))) (setq semantic-minor-modes-format - `((:eval (if (or ,@(mapcar 'car locals)) + `((:eval (if (or ,@(mapcar #'car locals)) ,(concat " " prefix))))) ;; It would be easier to just put `locals' inside ;; semantic-minor-modes-format, but then things like @@ -111,7 +111,7 @@ Only minor modes that are locally enabled are shown in the mode line." (cons elem minor-mode-alist))))) (setcdr tail (nconc locals (cdr tail))))))))) -(defun semantic-desktop-ignore-this-minor-mode (buffer) +(defun semantic-desktop-ignore-this-minor-mode (_buffer) "Installed as a minor-mode initializer for Desktop mode. BUFFER is the buffer to not initialize a Semantic minor mode in." nil) @@ -162,7 +162,7 @@ too an interactive function used to toggle the mode." ;; Update the minor mode format. (semantic-mode-line-update) ;; Then turn MODE on or off in every Semantic enabled buffer. - (semantic-map-buffers #'(lambda () (funcall mode arg)))) + (semantic-map-buffers (lambda () (funcall mode arg)))) ;;;; ;;;; Minor mode to highlight areas that a user edits. @@ -221,10 +221,10 @@ non-nil if the minor mode is enabled." (error "Buffer %s was not set up for parsing" (buffer-name))) (add-hook 'semantic-edits-new-change-functions - 'semantic-highlight-edits-new-change-hook-fcn nil t)) + #'semantic-highlight-edits-new-change-hook-fcn nil t)) ;; Remove hooks (remove-hook 'semantic-edits-new-change-functions - 'semantic-highlight-edits-new-change-hook-fcn t))) + #'semantic-highlight-edits-new-change-hook-fcn t))) (semantic-add-minor-mode 'semantic-highlight-edits-mode "e") @@ -345,7 +345,7 @@ Do not search past BOUND if non-nil." (defvar semantic-show-unmatched-syntax-mode-map (let ((km (make-sparse-keymap))) - (define-key km "\C-c,`" 'semantic-show-unmatched-syntax-next) + (define-key km "\C-c,`" #'semantic-show-unmatched-syntax-next) km) "Keymap for command `semantic-show-unmatched-syntax-mode'.") @@ -372,18 +372,18 @@ non-nil if the minor mode is enabled. (buffer-name))) ;; Add hooks (add-hook 'semantic-unmatched-syntax-hook - 'semantic-show-unmatched-syntax nil t) + #'semantic-show-unmatched-syntax nil t) (add-hook 'semantic-pre-clean-token-hooks - 'semantic-clean-token-of-unmatched-syntax nil t) + #'semantic-clean-token-of-unmatched-syntax nil t) ;; Show unmatched syntax elements (if (not (semantic--umatched-syntax-needs-refresh-p)) (semantic-show-unmatched-syntax (semantic-unmatched-syntax-tokens)))) ;; Remove hooks (remove-hook 'semantic-unmatched-syntax-hook - 'semantic-show-unmatched-syntax t) + #'semantic-show-unmatched-syntax t) (remove-hook 'semantic-pre-clean-token-hooks - 'semantic-clean-token-of-unmatched-syntax t) + #'semantic-clean-token-of-unmatched-syntax t) ;; Cleanup unmatched-syntax highlighting (semantic-clean-unmatched-syntax-in-buffer))) @@ -454,46 +454,46 @@ non-nil if the minor mode is enabled." '(semantic-show-parser-state-string)))) ;; Add hooks (add-hook 'semantic-edits-new-change-functions - 'semantic-show-parser-state-marker nil t) + #'semantic-show-parser-state-marker nil t) (add-hook 'semantic-edits-incremental-reparse-failed-hook - 'semantic-show-parser-state-marker nil t) + #'semantic-show-parser-state-marker nil t) (add-hook 'semantic-after-partial-cache-change-hook - 'semantic-show-parser-state-marker nil t) + #'semantic-show-parser-state-marker nil t) (add-hook 'semantic-after-toplevel-cache-change-hook - 'semantic-show-parser-state-marker nil t) + #'semantic-show-parser-state-marker nil t) (semantic-show-parser-state-marker) (add-hook 'semantic-before-auto-parse-hooks - 'semantic-show-parser-state-auto-marker nil t) + #'semantic-show-parser-state-auto-marker nil t) (add-hook 'semantic-after-auto-parse-hooks - 'semantic-show-parser-state-marker nil t) + #'semantic-show-parser-state-marker nil t) (add-hook 'semantic-before-idle-scheduler-reparse-hook - 'semantic-show-parser-state-auto-marker nil t) + #'semantic-show-parser-state-auto-marker nil t) (add-hook 'semantic-after-idle-scheduler-reparse-hook - 'semantic-show-parser-state-marker nil t)) + #'semantic-show-parser-state-marker nil t)) ;; Remove parts of mode line (setq mode-line-modified (delq 'semantic-show-parser-state-string mode-line-modified)) ;; Remove hooks (remove-hook 'semantic-edits-new-change-functions - 'semantic-show-parser-state-marker t) + #'semantic-show-parser-state-marker t) (remove-hook 'semantic-edits-incremental-reparse-failed-hook - 'semantic-show-parser-state-marker t) + #'semantic-show-parser-state-marker t) (remove-hook 'semantic-after-partial-cache-change-hook - 'semantic-show-parser-state-marker t) + #'semantic-show-parser-state-marker t) (remove-hook 'semantic-after-toplevel-cache-change-hook - 'semantic-show-parser-state-marker t) + #'semantic-show-parser-state-marker t) (remove-hook 'semantic-before-auto-parse-hooks - 'semantic-show-parser-state-auto-marker t) + #'semantic-show-parser-state-auto-marker t) (remove-hook 'semantic-after-auto-parse-hooks - 'semantic-show-parser-state-marker t) + #'semantic-show-parser-state-marker t) (remove-hook 'semantic-before-idle-scheduler-reparse-hook - 'semantic-show-parser-state-auto-marker t) + #'semantic-show-parser-state-auto-marker t) (remove-hook 'semantic-after-idle-scheduler-reparse-hook - 'semantic-show-parser-state-marker t))) + #'semantic-show-parser-state-marker t))) (semantic-add-minor-mode 'semantic-show-parser-state-mode "") @@ -502,7 +502,7 @@ non-nil if the minor mode is enabled." "String showing the parser state for this buffer. See `semantic-show-parser-state-marker' for details.") -(defun semantic-show-parser-state-marker (&rest ignore) +(defun semantic-show-parser-state-marker (&rest _ignore) "Set `semantic-show-parser-state-string' to indicate parser state. This marker is one of the following: `-' -> The cache is up to date. @@ -555,7 +555,7 @@ to indicate a parse in progress." (defvar semantic-stickyfunc-mode-map (let ((km (make-sparse-keymap))) - (define-key km [ header-line down-mouse-1 ] 'semantic-stickyfunc-menu) + (define-key km [ header-line down-mouse-1 ] #'semantic-stickyfunc-menu) km) "Keymap for stickyfunc minor mode.") @@ -826,7 +826,7 @@ Argument EVENT describes the event that caused this function to be called." (defvar semantic-highlight-func-mode-map (let ((km (make-sparse-keymap))) - (define-key km [mouse-3] 'semantic-highlight-func-menu) + (define-key km [mouse-3] #'semantic-highlight-func-menu) km) "Keymap for highlight-func minor mode.") @@ -916,10 +916,10 @@ non-nil if the minor mode is enabled." (error "Buffer %s was not set up for parsing" (buffer-name))) ;; Setup our hook (add-hook 'post-command-hook - 'semantic-highlight-func-highlight-current-tag nil t)) + #'semantic-highlight-func-highlight-current-tag nil t)) ;; Disable highlight func mode (remove-hook 'post-command-hook - 'semantic-highlight-func-highlight-current-tag t) + #'semantic-highlight-func-highlight-current-tag t) (semantic-highlight-func-highlight-current-tag t))) (defun semantic-highlight-func-highlight-current-tag (&optional disable) diff --git a/lisp/cedet/semantic/util.el b/lisp/cedet/semantic/util.el index 8c487e14ed5..bfc923c75b4 100644 --- a/lisp/cedet/semantic/util.el +++ b/lisp/cedet/semantic/util.el @@ -1,6 +1,6 @@ -;;; semantic/util.el --- Utilities for use with semantic tag tables +;;; semantic/util.el --- Utilities for use with semantic tag tables -*- lexical-binding: t; -*- -;;; Copyright (C) 1999-2005, 2007-2021 Free Software Foundation, Inc. +;; Copyright (C) 1999-2021 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: syntax @@ -114,7 +114,10 @@ buffer, or a filename. If SOMETHING is nil return nil." ((and (featurep 'semantic/db) (require 'semantic/db-mode) (semanticdb-minor-mode-p) - (cl-typep something 'semanticdb-abstract-table)) + (progn + (declare-function semanticdb-abstract-table--eieio-childp + "semantic/db") + (cl-typep something 'semanticdb-abstract-table))) (semanticdb-refresh-table something) (semanticdb-get-tags something)) ;; Semanticdb find-results @@ -427,7 +430,7 @@ determining which symbols are considered." (setq completion (try-completion pattern collection predicate)) (if (string= pattern completion) (let ((list (all-completions pattern collection predicate))) - (setq list (sort list 'string<)) + (setq list (sort list #'string<)) (if (> (length list) 1) (with-output-to-temp-buffer "*Completions*" (display-completion-list diff --git a/lisp/cedet/semantic/wisent.el b/lisp/cedet/semantic/wisent.el index d5b73244a08..f5f381d4079 100644 --- a/lisp/cedet/semantic/wisent.el +++ b/lisp/cedet/semantic/wisent.el @@ -1,4 +1,4 @@ -;;; semantic/wisent.el --- Wisent - Semantic gateway +;;; semantic/wisent.el --- Wisent - Semantic gateway -*- lexical-binding: t; -*- ;; Copyright (C) 2001-2007, 2009-2021 Free Software Foundation, Inc. @@ -22,13 +22,10 @@ ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: -;; + ;; Here are functions necessary to use the Wisent LALR parser from ;; Semantic environment. -;;; History: -;; - ;;; Code: (require 'semantic) @@ -69,6 +66,7 @@ Returned tokens must have the form: (TOKSYM VALUE START . END) where VALUE is the buffer substring between START and END positions." + (declare (debug (&define name stringp def-body))) `(defun ,name () ,doc (cond @@ -223,7 +221,7 @@ the standard function `semantic-parse-stream'." (error-message-string error-to-filter)) (message "wisent-parse-max-stack-size \ might need to be increased")) - (apply 'signal error-to-filter)))))) + (apply #'signal error-to-filter)))))) ;; Manage returned lookahead token (if wisent-lookahead (if (eq (caar la-elt) wisent-lookahead) @@ -251,6 +249,17 @@ might need to be increased")) (if (consp cache) cache '(nil)) ))) +(defmacro wisent-compiled-grammar (grammar &optional start-list) + "Return a compiled form of the LALR(1) Wisent GRAMMAR. +See `wisent--compile-grammar' for a description of the arguments +and return value." + ;; Ensure that the grammar compiler is available. + (require 'semantic/wisent/comp) + (declare-function wisent-automaton-lisp-form "semantic/wisent/comp" (x)) + (declare-function wisent--compile-grammar "semantic/wisent/comp" (grm st)) + (wisent-automaton-lisp-form + (wisent--compile-grammar grammar start-list))) + (defun wisent-parse-region (start end &optional goal depth returnonerror) "Parse the area between START and END using the Wisent LALR parser. Return the list of semantic tags found. @@ -319,18 +328,6 @@ the standard function `semantic-parse-region'." (point-max)))))) ;; Return parse tree (nreverse ptree))) - -;;; Interfacing with edebug -;; -(add-hook - 'edebug-setup-hook - #'(lambda () - - (def-edebug-spec define-wisent-lexer - (&define name stringp def-body) - ) - - )) (provide 'semantic/wisent) diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el index 755d30a371b..a87ed518909 100644 --- a/lisp/cedet/semantic/wisent/comp.el +++ b/lisp/cedet/semantic/wisent/comp.el @@ -1,4 +1,4 @@ -;;; semantic/wisent/comp.el --- GNU Bison for Emacs - Grammar compiler +;;; semantic/wisent/comp.el --- GNU Bison for Emacs - Grammar compiler -*- lexical-binding: t; -*- ;; Copyright (C) 1984, 1986, 1989, 1992, 1995, 2000-2007, 2009-2021 Free ;; Software Foundation, Inc. @@ -35,9 +35,6 @@ ;; ;; For more details on Wisent itself read the Wisent manual. -;;; History: -;; - ;;; Code: (require 'semantic/wisent) (eval-when-compile (require 'cl-lib)) @@ -54,21 +51,22 @@ ;; bound locally, without all these "reference to free variable" ;; compiler warnings! -(defmacro wisent-context-name (name) - "Return the context name from NAME." - `(if (and ,name (symbolp ,name)) - (intern (format "wisent-context-%s" ,name)) - (error "Invalid context name: %S" ,name))) +(eval-when-compile + (defun wisent-context-name (name) + "Return the context name from NAME." + (if (and name (symbolp name)) + (intern (format "wisent-context-%s" name)) + (error "Invalid context name: %S" name))) -(defmacro wisent-context-bindings (name) - "Return the variables in context NAME." - `(symbol-value (wisent-context-name ,name))) + (defun wisent-context-bindings (name) + "Return the variables in context NAME." + (symbol-value (wisent-context-name name)))) (defmacro wisent-defcontext (name &rest vars) "Define a context NAME that will bind variables VARS." (declare (indent 1)) (let* ((context (wisent-context-name name)) - (declarations (mapcar #'(lambda (v) (list 'defvar v)) vars))) + (declarations (mapcar (lambda (v) (list 'defvar v)) vars))) `(progn ,@declarations (eval-when-compile @@ -77,12 +75,8 @@ (defmacro wisent-with-context (name &rest body) "Bind variables in context NAME then eval BODY." (declare (indent 1)) - (let ((bindings (wisent-context-bindings name))) - `(progn - ,@(mapcar (lambda (binding) `(defvar ,(or (car-safe binding) binding))) - bindings) - (let* ,bindings - ,@body)))) + `(dlet ,(wisent-context-bindings name) + ,@body)) ;; Other utilities @@ -101,6 +95,8 @@ If optional LEFT is non-nil insert spaces on left." ;;;; Environment dependencies ;;;; ------------------------ +;; FIXME: Use bignums or bool-vectors? + (defconst wisent-BITS-PER-WORD (logcount most-positive-fixnum)) (defsubst wisent-WORDSIZE (n) @@ -159,13 +155,9 @@ Its name is defined in constant `wisent-log-buffer-name'." '(with-current-buffer (wisent-log-buffer) (erase-buffer))) -(defvar byte-compile-current-file) - (defun wisent-source () "Return the current source file name or nil." - (let ((source (or (and (boundp 'byte-compile-current-file) - byte-compile-current-file) - load-file-name (buffer-file-name)))) + (let ((source (macroexp-file-name))) (if source (file-relative-name source)))) @@ -2241,7 +2233,7 @@ there are any reduce/reduce conflicts." ;; output warnings. (and src (intern (format "wisent-%s--expected-conflicts" - (replace-regexp-in-string "\\.el$" "" src)))))) + (replace-regexp-in-string "\\.el\\'" "" src)))))) (when (or (not (zerop rrc-total)) (and (not (zerop src-total)) (not (= src-total (or wisent-expected-conflicts 0))) @@ -2778,7 +2770,7 @@ that likes a token gets to handle it." "Figure out the actions for every state. Return the action table." ;; Store the semantic action obarray in (unused) RCODE[0]. - (aset rcode 0 (make-vector 13 0)) + (aset rcode 0 (obarray-make 13)) (let (i j action-table actrow action) (setq action-table (make-vector nstates nil) actrow (make-vector ntokens nil) @@ -3392,7 +3384,7 @@ NONTERMS is the list of non terminal definitions (see function ;;;; Compile input grammar ;;;; --------------------- -(defun wisent-compile-grammar (grammar &optional start-list) +(defun wisent--compile-grammar (grammar start-list) "Compile the LALR(1) GRAMMAR. GRAMMAR is a list (TOKENS ASSOCS . NONTERMS) where: @@ -3435,7 +3427,7 @@ where: (if (wisent-automaton-p grammar) grammar ;; Grammar already compiled just return it (wisent-with-context compile-grammar - (let* ((gc-cons-threshold 1000000)) + (let* ((gc-cons-threshold (max gc-cons-threshold 1000000))) (garbage-collect) (setq wisent-new-log-flag t) ;; Parse input grammar @@ -3444,7 +3436,7 @@ where: (wisent-parser-automaton))))) ;;;; -------------------------- -;;;; Byte compile input grammar +;;;; Obsolete byte compile support ;;;; -------------------------- (require 'bytecomp) @@ -3453,25 +3445,32 @@ where: "Byte compile the `wisent-compile-grammar' FORM. Automatically called by the Emacs Lisp byte compiler as a `byte-compile' handler." - ;; Eval the `wisent-compile-grammar' form to obtain an LALR - ;; automaton internal data structure. Then, because the internal - ;; data structure contains an obarray, convert it to a lisp form so - ;; it can be byte-compiled. (byte-compile-form - ;; FIXME: we macroexpand here since `byte-compile-form' expects - ;; macroexpanded code, but that's just a workaround: for lexical-binding - ;; the lisp form should have to pass through closure-conversion and - ;; `wisent-byte-compile-grammar' is called much too late for that. - ;; Why isn't this `wisent-automaton-lisp-form' performed at - ;; macroexpansion time? --Stef (macroexpand-all - (wisent-automaton-lisp-form (eval form))))) + (wisent-automaton-lisp-form (eval form t))))) -;; FIXME: We shouldn't use a `byte-compile' handler. Maybe using a hash-table -;; instead of an obarray would work around the problem that obarrays -;; aren't printable. Then (put 'wisent-compile-grammar 'side-effect-free t). -(put 'wisent-compile-grammar 'byte-compile 'wisent-byte-compile-grammar) +(defun wisent-compile-grammar (grammar &optional start-list) + ;; This is kept for compatibility with FOO-wy.el files generated + ;; with older Emacsen. + (declare (obsolete wisent-compiled-grammar "Mar 2021")) + (wisent--compile-grammar grammar start-list)) + +(put 'wisent-compile-grammar 'byte-compile #'wisent-byte-compile-grammar) + +;;;; -------------------------- +;;;; Byte compile input grammar +;;;; -------------------------- +;; `wisent--compile-grammar' generates the actual parse table +;; we need at run-time, but in order to be able to compile the code it +;; contains, we need to "reify" it back into a piece of ELisp code +;; which (re)builds it. +;; This is needed for 2 reasons: +;; - The parse tables include an obarray and these don't survive the print+read +;; steps involved in generating a `.elc' file and reading it back in. +;; - Within the parse table vectors/obarrays we have ELisp functions which +;; we want to byte-compile, but if we were to just `quote' the table +;; we'd get them with the same non-compiled functions. (defun wisent-automaton-lisp-form (automaton) "Return a Lisp form that produces AUTOMATON. See also `wisent-compile-grammar' for more details on AUTOMATON." @@ -3481,16 +3480,16 @@ See also `wisent-compile-grammar' for more details on AUTOMATON." (let ((obn (make-symbol "ob")) ; Generated obarray name (obv (aref automaton 3)) ; Semantic actions obarray ) - `(let ((,obn (make-vector 13 0))) + `(let ((,obn (obarray-make 13))) ;; Generate code to initialize the semantic actions obarray, ;; in local variable OBN. ,@(let (obcode) (mapatoms - #'(lambda (s) - (setq obcode - (cons `(fset (intern ,(symbol-name s) ,obn) - #',(symbol-function s)) - obcode))) + (lambda (s) + (setq obcode + (cons `(fset (intern ,(symbol-name s) ,obn) + #',(symbol-function s)) + obcode))) obv) obcode) ;; Generate code to create the automaton. @@ -3500,18 +3499,20 @@ See also `wisent-compile-grammar' for more details on AUTOMATON." ;; obarray. (vector ,@(mapcar - #'(lambda (state) ;; for each state - `(list - ,@(mapcar - #'(lambda (tr) ;; for each transition - (let ((k (car tr)) ; token - (a (cdr tr))) ; action - (if (and (symbolp a) - (intern-soft (symbol-name a) obv)) - `(cons ,(if (symbolp k) `(quote ,k) k) - (intern-soft ,(symbol-name a) ,obn)) - `(quote ,tr)))) - state))) + ;; Use name `st' rather than `state' since `state' is + ;; defined as dynbound in `semantic-actions' context above :-( ! + (lambda (st) ;; for each state + `(list + ,@(mapcar + (lambda (tr) ;; for each transition + (let ((k (car tr)) ; token + (a (cdr tr))) ; action + (if (and (symbolp a) + (intern-soft (symbol-name a) obv)) + `(cons ,(if (symbolp k) `(quote ,k) k) + (intern-soft ,(symbol-name a) ,obn)) + `(quote ,tr)))) + st))) (aref automaton 0))) ;; The code of the goto table is unchanged. ,(aref automaton 1) diff --git a/lisp/cedet/semantic/wisent/grammar.el b/lisp/cedet/semantic/wisent/grammar.el index cfd4899186b..c5e4554082e 100644 --- a/lisp/cedet/semantic/wisent/grammar.el +++ b/lisp/cedet/semantic/wisent/grammar.el @@ -1,4 +1,4 @@ -;;; semantic/wisent/grammar.el --- Wisent's input grammar mode +;;; semantic/wisent/grammar.el --- Wisent's input grammar mode -*- lexical-binding: t; -*- ;; Copyright (C) 2002-2021 Free Software Foundation, Inc. ;; @@ -198,10 +198,10 @@ See also the function `wisent-skip-token'." (defun wisent-grammar-assocs () "Return associativity and precedence level definitions." (mapcar - #'(lambda (tag) - (cons (intern (semantic-tag-name tag)) - (mapcar #'semantic-grammar-item-value - (semantic-tag-get-attribute tag :value)))) + (lambda (tag) + (cons (intern (semantic-tag-name tag)) + (mapcar #'semantic-grammar-item-value + (semantic-tag-get-attribute tag :value)))) (semantic-find-tags-by-class 'assoc (current-buffer)))) (defun wisent-grammar-terminals () @@ -209,14 +209,14 @@ See also the function `wisent-skip-token'." Keep order of declaration in the WY file without duplicates." (let (terms) (mapc - #'(lambda (tag) - (mapcar #'(lambda (name) - (add-to-list 'terms (intern name))) - (cons (semantic-tag-name tag) - (semantic-tag-get-attribute tag :rest)))) + (lambda (tag) + (mapcar (lambda (name) + (add-to-list 'terms (intern name))) + (cons (semantic-tag-name tag) + (semantic-tag-get-attribute tag :rest)))) (semantic--find-tags-by-function - #'(lambda (tag) - (memq (semantic-tag-class tag) '(token keyword))) + (lambda (tag) + (memq (semantic-tag-class tag) '(token keyword))) (current-buffer))) (nreverse terms))) @@ -228,7 +228,7 @@ Keep order of declaration in the WY file without duplicates." Return the expanded expression." (if (or (atom expr) (semantic-grammar-quote-p (car expr))) expr ;; Just return atom or quoted expression. - (let* ((expr (mapcar 'wisent-grammar-expand-macros expr)) + (let* ((expr (mapcar #'wisent-grammar-expand-macros expr)) (macro (assq (car expr) wisent--grammar-macros))) (if macro ;; Expand Semantic built-in. (apply (cdr macro) (cdr expr)) @@ -286,12 +286,9 @@ Return the expanded expression." (defun wisent-grammar-parsetable-builder () "Return the value of the parser table." - `(progn - ;; Ensure that the grammar [byte-]compiler is available. - (eval-when-compile (require 'semantic/wisent/comp)) - (wisent-compile-grammar - ',(wisent-grammar-grammar) - ',(semantic-grammar-start)))) + `(wisent-compiled-grammar + ,(wisent-grammar-grammar) + ,(semantic-grammar-start))) (defun wisent-grammar-setupcode-builder () "Return the parser setup code." @@ -305,7 +302,7 @@ Return the expanded expression." semantic-lex-types-obarray %s)\n\ ;; Collect unmatched syntax lexical tokens\n\ (add-hook 'wisent-discarding-token-functions\n\ - 'wisent-collect-unmatched-syntax nil t)" + #'wisent-collect-unmatched-syntax nil t)" (semantic-grammar-parsetable) (buffer-name) (semantic-grammar-keywordtable) @@ -325,6 +322,7 @@ Menu items are appended to the common grammar menu.") (define-derived-mode wisent-grammar-mode semantic-grammar-mode "WY" "Major mode for editing Wisent grammars." (semantic-grammar-setup-menu wisent-grammar-menu) + (setq-local semantic-grammar-require-form '(require 'semantic/wisent)) (semantic-install-function-overrides '((semantic-grammar-parsetable-builder . wisent-grammar-parsetable-builder) (semantic-grammar-setupcode-builder . wisent-grammar-setupcode-builder)))) @@ -479,7 +477,7 @@ Menu items are appended to the common grammar menu.") (condition-case err (with-current-buffer (find-file-noselect infile) (if outdir (setq default-directory outdir)) - (semantic-grammar-create-package nil t)) + (semantic-grammar-create-package t t)) (error (message "%s" (error-message-string err)) nil))) output-data) (when (setq output-data (assoc packagename wisent-make-parsers--parser-file-name)) @@ -514,7 +512,8 @@ Menu items are appended to the common grammar menu.") (goto-char (point-min)) (delete-region (point-min) (line-end-position)) (insert ";;; " packagename - " --- Generated parser support file") + " --- Generated parser support file " + "-*- lexical-binding:t -*-") (re-search-forward ";;; \\(.*\\) ends here") (replace-match packagename nil nil nil 1) (delete-trailing-whitespace)))))) diff --git a/lisp/cedet/semantic/wisent/java-tags.el b/lisp/cedet/semantic/wisent/java-tags.el index d455c02d1b5..90dd40c51a0 100644 --- a/lisp/cedet/semantic/wisent/java-tags.el +++ b/lisp/cedet/semantic/wisent/java-tags.el @@ -1,4 +1,4 @@ -;;; semantic/wisent/java-tags.el --- Java LALR parser for Emacs +;;; semantic/wisent/java-tags.el --- Java LALR parser for Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 2001-2006, 2009-2021 Free Software Foundation, Inc. @@ -24,9 +24,6 @@ ;;; Commentary: ;; -;;; History: -;; - ;;; Code: (require 'semantic/wisent) @@ -92,7 +89,7 @@ This function override `get-local-variables'." (define-mode-local-override semantic-analyze-unsplit-name java-mode (namelist) "Assemble the list of names NAMELIST into a namespace name." - (mapconcat 'identity namelist ".")) + (mapconcat #'identity namelist ".")) @@ -111,12 +108,12 @@ Use the alternate LALR(1) parser." (setq ;; Lexical analysis semantic-lex-number-expression semantic-java-number-regexp - semantic-lex-analyzer 'wisent-java-tags-lexer + semantic-lex-analyzer #'wisent-java-tags-lexer ;; Parsing - semantic-tag-expand-function 'semantic-java-expand-tag + semantic-tag-expand-function #'semantic-java-expand-tag ;; Environment - semantic-imenu-summary-function 'semantic-format-tag-prototype - imenu-create-index-function 'semantic-create-imenu-index + semantic-imenu-summary-function #'semantic-format-tag-prototype + imenu-create-index-function #'semantic-create-imenu-index semantic-type-relation-separator-character '(".") semantic-command-separation-character ";" ;; speedbar and imenu buckets name diff --git a/lisp/cedet/semantic/wisent/javascript.el b/lisp/cedet/semantic/wisent/javascript.el index 684eea1d93d..1932f205ee0 100644 --- a/lisp/cedet/semantic/wisent/javascript.el +++ b/lisp/cedet/semantic/wisent/javascript.el @@ -1,4 +1,4 @@ -;;; semantic/wisent/javascript.el --- javascript parser support +;;; semantic/wisent/javascript.el --- javascript parser support -*- lexical-binding: t; -*- ;; Copyright (C) 2005, 2009-2021 Free Software Foundation, Inc. @@ -70,7 +70,7 @@ This function overrides `get-local-variables'." ;; Does javascript have identifiable local variables? nil) -(define-mode-local-override semantic-tag-protection js-mode (tag &optional parent) +(define-mode-local-override semantic-tag-protection js-mode (_tag &optional _parent) "Return protection information about TAG with optional PARENT. This function returns on of the following symbols: nil - No special protection. Language dependent. @@ -85,7 +85,7 @@ The default behavior (if not overridden with `tag-protection' is to return a symbol based on type modifiers." nil) -(define-mode-local-override semantic-analyze-scope-calculate-access js-mode (type scope) +(define-mode-local-override semantic-analyze-scope-calculate-access js-mode (_type _scope) "Calculate the access class for TYPE as defined by the current SCOPE. Access is related to the :parents in SCOPE. If type is a member of SCOPE then access would be `private'. If TYPE is inherited by a member of SCOPE, @@ -101,7 +101,7 @@ This is currently needed for the mozrepl omniscient database." (save-excursion (if point (goto-char point)) (let* ((case-fold-search semantic-case-fold) - symlist tmp end) + tmp end) ;; symlist (with-syntax-table semantic-lex-syntax-table (save-excursion (when (looking-at "\\w\\|\\s_") @@ -110,10 +110,11 @@ This is currently needed for the mozrepl omniscient database." (unless (re-search-backward "\\s-" (point-at-bol) t) (beginning-of-line)) (setq tmp (buffer-substring-no-properties (point) end)) + ;; (setq symlist (if (string-match "\\(.+\\)\\." tmp) - (setq symlist (list (match-string 1 tmp) - (substring tmp (1+ (match-end 1)) (length tmp)))) - (setq symlist (list tmp)))))))) + (list (match-string 1 tmp) + (substring tmp (1+ (match-end 1)) (length tmp))) + (list tmp)))))));; ) ;;; Setup Function ;; @@ -127,14 +128,14 @@ This is currently needed for the mozrepl omniscient database." (wisent-javascript-jv-wy--install-parser) (setq ;; Lexical Analysis - semantic-lex-analyzer 'javascript-lexer-jv + semantic-lex-analyzer #'javascript-lexer-jv semantic-lex-number-expression semantic-java-number-regexp ;; semantic-lex-depth nil ;; Full lexical analysis ;; Parsing - semantic-tag-expand-function 'wisent-javascript-jv-expand-tag + semantic-tag-expand-function #'wisent-javascript-jv-expand-tag ;; Environment - semantic-imenu-summary-function 'semantic-format-tag-name - imenu-create-index-function 'semantic-create-imenu-index + semantic-imenu-summary-function #'semantic-format-tag-name + imenu-create-index-function #'semantic-create-imenu-index semantic-command-separation-character ";" )) diff --git a/lisp/cedet/semantic/wisent/python.el b/lisp/cedet/semantic/wisent/python.el index 7769ad1961b..fb878dde712 100644 --- a/lisp/cedet/semantic/wisent/python.el +++ b/lisp/cedet/semantic/wisent/python.el @@ -1,4 +1,4 @@ -;;; wisent-python.el --- Semantic support for Python +;;; wisent-python.el --- Semantic support for Python -*- lexical-binding: t; -*- ;; Copyright (C) 2002, 2004, 2006-2021 Free Software Foundation, Inc. @@ -27,8 +27,6 @@ ;;; Code: -(require 'rx) - ;; Try to load python support, but fail silently since it is only used ;; for optional functionality (require 'python nil t) @@ -464,19 +462,19 @@ To be implemented for Python! For now just return nil." (define-mode-local-override semantic-tag-include-filename python-mode (tag) "Return a suitable path for (some) Python imports." (let ((name (semantic-tag-name tag))) - (concat (mapconcat 'identity (split-string name "\\.") "/") ".py"))) + (concat (mapconcat #'identity (split-string name "\\.") "/") ".py"))) ;; Override ctxt-current-function/assignment defaults, since they do ;; not work properly with Python code, even leading to endless loops ;; (see bug #xxxxx). -(define-mode-local-override semantic-ctxt-current-function python-mode (&optional point) +(define-mode-local-override semantic-ctxt-current-function python-mode (&optional _point) "Return the current function call the cursor is in at POINT. The function returned is the one accepting the arguments that the cursor is currently in. It will not return function symbol if the cursor is on the text representing that function." nil) -(define-mode-local-override semantic-ctxt-current-assignment python-mode (&optional point) +(define-mode-local-override semantic-ctxt-current-assignment python-mode (&optional _point) "Return the current assignment near the cursor at POINT. Return a list as per `semantic-ctxt-current-symbol'. Return nil if there is nothing relevant." @@ -512,12 +510,12 @@ Shortens `code' tags, but passes through for others." semantic-type-relation-separator-character '(".") semantic-command-separation-character ";" ;; Parsing - semantic-tag-expand-function 'semantic-python-expand-tag + semantic-tag-expand-function #'semantic-python-expand-tag ;; Semantic to take over from the one provided by python. ;; The python one, if it uses the senator advice, will hang ;; Emacs unrecoverably. - imenu-create-index-function 'semantic-create-imenu-index + imenu-create-index-function #'semantic-create-imenu-index ;; I need a python guru to update this list: semantic-symbol->name-assoc-list-for-type-parts '((variable . "Variables") @@ -557,7 +555,7 @@ SELF or the instance name \"self\" if SELF is nil." (rx-to-string `(seq string-start ,(or self "self") ".")) name) - (not (string-match "\\." (substring name 5))))))) + (not (string-search "." (substring name 5))))))) (defun semantic-python-docstring-p (tag) "Return non-nil, when TAG is a Python documentation string." diff --git a/lisp/cedet/semantic/wisent/wisent.el b/lisp/cedet/semantic/wisent/wisent.el index 26cf87f8425..62d99ef6972 100644 --- a/lisp/cedet/semantic/wisent/wisent.el +++ b/lisp/cedet/semantic/wisent/wisent.el @@ -1,6 +1,6 @@ -;;; semantic/wisent/wisent.el --- GNU Bison for Emacs - Runtime +;;; semantic/wisent/wisent.el --- GNU Bison for Emacs - Runtime -*- lexical-binding: t; -*- -;;; Copyright (C) 2002-2007, 2009-2021 Free Software Foundation, Inc. +;; Copyright (C) 2002-2021 Free Software Foundation, Inc. ;; Author: David Ponce <david@dponce.com> ;; Created: 30 January 2002 @@ -34,9 +34,6 @@ ;; ;; For more details on Wisent itself read the Wisent manual. -;;; History: -;; - ;;; Code: (defgroup wisent nil @@ -139,7 +136,7 @@ POSITIONS are available." "Print a one-line message if `wisent-parse-verbose-flag' is set. Pass STRING and ARGS arguments to `message'." (and wisent-parse-verbose-flag - (apply 'message string args))) + (apply #'message string args))) ;;;; -------------------- ;;;; The LR parser engine @@ -147,13 +144,11 @@ Pass STRING and ARGS arguments to `message'." (defcustom wisent-parse-max-stack-size 500 "The parser stack size." - :type 'integer - :group 'wisent) + :type 'integer) (defcustom wisent-parse-max-recover 3 "Number of tokens to shift before turning off error status." - :type 'integer - :group 'wisent) + :type 'integer) (defvar wisent-discarding-token-functions nil "List of functions to be called when discarding a lexical token. @@ -397,9 +392,9 @@ automaton has only one entry point." (wisent-error (format "Syntax error, unexpected %s, expecting %s" (wisent-token-to-string wisent-input) - (mapconcat 'wisent-item-to-string + (mapconcat #'wisent-item-to-string (delq wisent-error-term - (mapcar 'car (cdr choices))) + (mapcar #'car (cdr choices))) ", ")))) ;; Increment the error counter (setq wisent-nerrs (1+ wisent-nerrs)) |