diff options
Diffstat (limited to 'lisp/cedet')
145 files changed, 2310 insertions, 3127 deletions
diff --git a/lisp/cedet/cedet-cscope.el b/lisp/cedet/cedet-cscope.el index 75a69db0a8c..6ffc2765d68 100644 --- a/lisp/cedet/cedet-cscope.el +++ b/lisp/cedet/cedet-cscope.el @@ -1,6 +1,6 @@ -;;; cedet-cscope.el --- CScope support for CEDET +;;; cedet-cscope.el --- CScope support for CEDET -*- 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> ;; Package: cedet @@ -26,8 +26,6 @@ ;;; Code: -(declare-function inversion-check-version "inversion") - (defvar cedet-cscope-min-version "15.7" "Minimum version of CScope required.") @@ -36,7 +34,7 @@ :type 'string :group 'cedet) -(defun cedet-cscope-search (searchtext texttype type scope) +(defun cedet-cscope-search (searchtext texttype type _scope) "Perform a search with CScope, return the created buffer. SEARCHTEXT is text to find. TEXTTYPE is the type of text, such as `regexp', `string', `tagname', @@ -87,7 +85,7 @@ options -cR." (with-current-buffer b (setq default-directory cd) (erase-buffer)) - (apply 'call-process cedet-cscope-command + (apply #'call-process cedet-cscope-command nil b nil flags) b)) @@ -139,7 +137,6 @@ If optional programmatic argument NOERROR is non-nil, then instead of throwing an error if CScope isn't available, return nil." (interactive) - (require 'inversion) (let ((b (condition-case nil (cedet-cscope-call (list "-V")) (error nil))) @@ -153,7 +150,7 @@ return nil." (goto-char (point-min)) (re-search-forward "cscope: version \\([0-9.]+\\)" nil t) (setq rev (match-string 1)) - (if (inversion-check-version rev nil cedet-cscope-min-version) + (if (version< rev cedet-cscope-min-version) (if noerror nil (error "Version of CScope is %s. Need at least %s" diff --git a/lisp/cedet/cedet-files.el b/lisp/cedet/cedet-files.el index 31608159cc1..f540fb5540f 100644 --- a/lisp/cedet/cedet-files.el +++ b/lisp/cedet/cedet-files.el @@ -1,4 +1,4 @@ -;;; cedet-files.el --- Common routines dealing with file names. +;;; cedet-files.el --- Common routines dealing with file names. -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. @@ -59,7 +59,7 @@ to the file's truename, and dodging platform tricks." ;; doubling `!'s in the original name... (setq file (subst-char-in-string ?/ ?! - (replace-regexp-in-string "!" "!!" file))) + (string-replace "!" "!!" file))) file)) (defun cedet-file-name-to-directory-name (referencefile &optional testmode) @@ -71,7 +71,7 @@ specific conversions during tests." ;; Replace the ! with / (setq file (subst-char-in-string ?! ?/ file)) ;; Occurrences of // meant there was once a single !. - (setq file (replace-regexp-in-string "//" "!" file)) + (setq file (string-replace "//" "!" file)) ;; Handle Windows special cases (when (or (memq system-type '(windows-nt ms-dos)) testmode) diff --git a/lisp/cedet/cedet-global.el b/lisp/cedet/cedet-global.el index 5878ec1f485..227ebd54b86 100644 --- a/lisp/cedet/cedet-global.el +++ b/lisp/cedet/cedet-global.el @@ -1,4 +1,4 @@ -;;; cedet-global.el --- GNU Global support for CEDET. +;;; cedet-global.el --- GNU Global support for CEDET. -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -24,8 +24,6 @@ ;; ;; Basic support for calling GNU Global, and testing version numbers. -(declare-function inversion-check-version "inversion") - (defvar cedet-global-min-version "5.0" "Minimum version of GNU Global required.") @@ -77,7 +75,7 @@ SCOPE is the scope of the search, such as `project' or `subdirs'." (with-current-buffer b (setq default-directory cd) (erase-buffer)) - (apply 'call-process cedet-global-command + (apply #'call-process cedet-global-command nil b nil flags) b)) @@ -90,7 +88,7 @@ SCOPE is the scope of the search, such as `project' or `subdirs'." (with-current-buffer b (setq default-directory cd) (erase-buffer)) - (apply 'call-process cedet-global-gtags-command + (apply #'call-process cedet-global-gtags-command nil b nil flags) @@ -143,7 +141,6 @@ If optional programmatic argument NOERROR is non-nil, then instead of throwing an error if Global isn't available, return nil." (interactive) - (require 'inversion) (let ((b (condition-case nil (cedet-gnu-global-call (list "--version")) (error nil))) @@ -157,7 +154,7 @@ return nil." (goto-char (point-min)) (re-search-forward "(?GNU GLOBAL)? \\([0-9.]+\\)" nil t) (setq rev (match-string 1)) - (if (inversion-check-version rev nil cedet-global-min-version) + (if (version< rev cedet-global-min-version) (if noerror nil (error "Version of GNU Global is %s. Need at least %s" diff --git a/lisp/cedet/cedet-idutils.el b/lisp/cedet/cedet-idutils.el index fc5e05af88e..a2b8cb35240 100644 --- a/lisp/cedet/cedet-idutils.el +++ b/lisp/cedet/cedet-idutils.el @@ -1,4 +1,4 @@ -;;; cedet-idutils.el --- ID Utils support for CEDET. +;;; cedet-idutils.el --- ID Utils support for CEDET. -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2021 Free Software Foundation, Inc. @@ -29,8 +29,6 @@ ;;; Code: -(declare-function inversion-check-version "inversion") - (defvar cedet-idutils-min-version "4.0" "Minimum version of ID Utils required.") @@ -49,7 +47,7 @@ :type 'string :group 'cedet) -(defun cedet-idutils-search (searchtext texttype type scope) +(defun cedet-idutils-search (searchtext texttype type _scope) "Perform a search with ID Utils, return the created buffer. SEARCHTEXT is text to find. TEXTTYPE is the type of text, such as `regexp', `string', `tagname', @@ -66,7 +64,7 @@ Note: Scope is not yet supported." (let* ((resultflg (if (eq texttype 'tagcompletions) (list "--key=token") (list "--result=grep"))) - (scopeflgs nil) ; (cond ((eq scope 'project) "" ) ((eq scope 'target) "l"))) + ;; (scopeflgs (cond ((eq scope 'project) "" ) ((eq scope 'target) "l"))) (stflag (cond ((or (eq texttype 'tagname) (eq texttype 'tagregexp)) (list "-r" "-w")) @@ -79,7 +77,7 @@ Note: Scope is not yet supported." ;; t means 'symbol (t (list "-l" "-w")))) ) - (cedet-idutils-lid-call (append resultflg scopeflgs stflag + (cedet-idutils-lid-call (append resultflg nil stflag ;; scopeflgs (list searchtext)))))) (defun cedet-idutils-fnid-call (flags) @@ -91,7 +89,7 @@ Return the created buffer with program output." (with-current-buffer b (setq default-directory cd) (erase-buffer)) - (apply 'call-process cedet-idutils-file-command + (apply #'call-process cedet-idutils-file-command nil b nil flags) b)) @@ -105,7 +103,7 @@ Return the created buffer with program output." (with-current-buffer b (setq default-directory cd) (erase-buffer)) - (apply 'call-process cedet-idutils-token-command + (apply #'call-process cedet-idutils-token-command nil b nil flags) b)) @@ -119,7 +117,7 @@ Return the created buffer with program output." (with-current-buffer b (setq default-directory cd) (erase-buffer)) - (apply 'call-process cedet-idutils-make-command + (apply #'call-process cedet-idutils-make-command nil b nil flags) b)) @@ -135,7 +133,7 @@ Return a filename relative to the default directory." (if (looking-at "[^ \n]*fnid: ") (error "ID Utils not available") (split-string (buffer-string) "\n" t))))) - (setq ans (mapcar 'expand-file-name ans)) + (setq ans (mapcar #'expand-file-name ans)) (when (called-interactively-p 'interactive) (if ans (if (= (length ans) 1) @@ -167,7 +165,6 @@ If optional programmatic argument NOERROR is non-nil, then instead of throwing an error if Global isn't available, return nil." (interactive) - (require 'inversion) (let ((b (condition-case nil (cedet-idutils-fnid-call (list "--version")) (error nil))) @@ -182,7 +179,7 @@ return nil." (if (re-search-forward "fnid - \\([0-9.]+\\)" nil t) (setq rev (match-string 1)) (setq rev "0")) - (if (inversion-check-version rev nil cedet-idutils-min-version) + (if (version< rev cedet-idutils-min-version) (if noerror nil (error "Version of ID Utils is %s. Need at least %s" diff --git a/lisp/cedet/cedet.el b/lisp/cedet/cedet.el index caaec473a2c..b6043f1403e 100644 --- a/lisp/cedet/cedet.el +++ b/lisp/cedet/cedet.el @@ -1,4 +1,4 @@ -;;; cedet.el --- Setup CEDET environment +;;; cedet.el --- Setup CEDET environment -*- lexical-binding: t; -*- ;; Copyright (C) 2002-2021 Free Software Foundation, Inc. @@ -48,25 +48,25 @@ (defvar cedet-menu-map ;(make-sparse-keymap "CEDET menu") (let ((map (make-sparse-keymap "CEDET menu"))) - (define-key map [semantic-force-refresh] 'undefined) - (define-key map [semantic-edit-menu] 'undefined) - (define-key map [navigate-menu] 'undefined) - (define-key map [semantic-options-separator] 'undefined) - (define-key map [global-semantic-highlight-func-mode] 'undefined) - (define-key map [global-semantic-stickyfunc-mode] 'undefined) - (define-key map [global-semantic-decoration-mode] 'undefined) - (define-key map [global-semantic-idle-completions-mode] 'undefined) - (define-key map [global-semantic-idle-summary-mode] 'undefined) - (define-key map [global-semantic-idle-scheduler-mode] 'undefined) - (define-key map [global-semanticdb-minor-mode] 'undefined) - (define-key map [cedet-menu-separator] 'undefined) - (define-key map [ede-find-file] 'undefined) - (define-key map [ede-speedbar] 'undefined) - (define-key map [ede] 'undefined) - (define-key map [ede-new] 'undefined) - (define-key map [ede-target-options] 'undefined) - (define-key map [ede-project-options] 'undefined) - (define-key map [ede-build-forms-menu] 'undefined) + (define-key map [semantic-force-refresh] #'undefined) + (define-key map [semantic-edit-menu] #'undefined) + (define-key map [navigate-menu] #'undefined) + (define-key map [semantic-options-separator] #'undefined) + (define-key map [global-semantic-highlight-func-mode] #'undefined) + (define-key map [global-semantic-stickyfunc-mode] #'undefined) + (define-key map [global-semantic-decoration-mode] #'undefined) + (define-key map [global-semantic-idle-completions-mode] #'undefined) + (define-key map [global-semantic-idle-summary-mode] #'undefined) + (define-key map [global-semantic-idle-scheduler-mode] #'undefined) + (define-key map [global-semanticdb-minor-mode] #'undefined) + (define-key map [cedet-menu-separator] #'undefined) + (define-key map [ede-find-file] #'undefined) + (define-key map [ede-speedbar] #'undefined) + (define-key map [ede] #'undefined) + (define-key map [ede-new] #'undefined) + (define-key map [ede-target-options] #'undefined) + (define-key map [ede-project-options] #'undefined) + (define-key map [ede-build-forms-menu] #'undefined) map) "Menu keymap for the CEDET package. This is used by `semantic-mode' and `global-ede-mode'.") @@ -85,6 +85,7 @@ for the specified PACKAGE. LOADED VERSION is the version of PACKAGE currently loaded in Emacs memory and (presumably) running in this Emacs instance. Value is X if the package has not been loaded." + (declare (obsolete emacs-version "28.1")) (interactive) (require 'inversion) (with-output-to-temp-buffer "*CEDET*" diff --git a/lisp/cedet/data-debug.el b/lisp/cedet/data-debug.el index a062a5a5853..428848be04d 100644 --- a/lisp/cedet/data-debug.el +++ b/lisp/cedet/data-debug.el @@ -1,4 +1,4 @@ -;;; data-debug.el --- Data structure debugger +;;; data-debug.el --- Data structure debugger -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. @@ -48,9 +48,9 @@ ;;; Compatibility ;; -(define-obsolete-function-alias 'data-debug-overlay-properties 'overlay-properties "28.1") -(define-obsolete-function-alias 'data-debug-overlay-p 'overlayp "28.1") -(define-obsolete-function-alias 'dd-propertize 'propertize "28.1") +(define-obsolete-function-alias 'data-debug-overlay-properties #'overlay-properties "28.1") +(define-obsolete-function-alias 'data-debug-overlay-p #'overlayp "28.1") +(define-obsolete-function-alias 'dd-propertize #'propertize "28.1") ;;; GENERIC STUFF ;; @@ -100,14 +100,14 @@ PREBUTTONTEXT is some text between prefix and the overlay button." (let ((start (point)) (end nil) (str (format "%s" overlay)) - (tip nil)) + ) ;; (tip nil) (insert prefix prebuttontext str) (setq end (point)) (put-text-property (- end (length str)) end 'face 'font-lock-comment-face) (put-text-property start end 'ddebug overlay) (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-overlay-from-point) (insert "\n") @@ -149,14 +149,14 @@ PREBUTTONTEXT is some text between prefix and the overlay list button." (let ((start (point)) (end nil) (str (format "#<overlay list: %d entries>" (length overlaylist))) - (tip nil)) + ) ;; (tip nil) (insert prefix prebuttontext str) (setq end (point)) (put-text-property (- end (length str)) end 'face 'font-lock-comment-face) (put-text-property start end 'ddebug overlaylist) (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-overlay-list-from-point) (insert "\n") @@ -204,14 +204,14 @@ PREBUTTONTEXT is some text between prefix and the buffer button." (let ((start (point)) (end nil) (str (format "%S" buffer)) - (tip nil)) + ) ;; (tip nil) (insert prefix prebuttontext str) (setq end (point)) (put-text-property (- end (length str)) end 'face 'font-lock-comment-face) (put-text-property start end 'ddebug buffer) (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-buffer-from-point) (insert "\n") @@ -253,14 +253,14 @@ PREBUTTONTEXT is some text between prefix and the buffer list button." (let ((start (point)) (end nil) (str (format "#<buffer list: %d entries>" (length bufferlist))) - (tip nil)) + ) ;; (tip nil) (insert prefix prebuttontext str) (setq end (point)) (put-text-property (- end (length str)) end 'face 'font-lock-comment-face) (put-text-property start end 'ddebug bufferlist) (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-buffer-list-from-point) (insert "\n") @@ -309,14 +309,14 @@ PREBUTTONTEXT is some text between prefix and the process button." (let ((start (point)) (end nil) (str (format "%S : %s" process (process-status process))) - (tip nil)) + ) ;; (tip nil) (insert prefix prebuttontext str) (setq end (point)) (put-text-property (- end (length str)) end 'face 'font-lock-comment-face) (put-text-property start end 'ddebug process) (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-process-from-point) (insert "\n") @@ -363,8 +363,8 @@ PREBUTTONTEXT is some text between prefix and the stuff list button." (str (format "#<RING: %d, %d max>" (ring-length ring) (ring-size ring))) - (ringthing - (if (= (ring-length ring) 0) nil (ring-ref ring 0))) + ;; (ringthing + ;; (if (= (ring-length ring) 0) nil (ring-ref ring 0))) (tip (format "Ring max-size %d, length %d." (ring-size ring) (ring-length ring))) @@ -437,7 +437,7 @@ PREBUTTONTEXT is some text between prefix and the stuff list button." ;; Widgets have a long list of properties (defun data-debug-insert-widget-properties (widget prefix) "Insert the contents of WIDGET inserting PREFIX before each element." - (let ((type (car widget)) + (let (;; (type (car widget)) (rest (cdr widget))) (while rest (data-debug-insert-thing (car (cdr rest)) @@ -683,7 +683,7 @@ PREBUTTONTEXT is some text between prefix and the thing." ) ;;; nil thing -(defun data-debug-insert-nil (thing prefix prebuttontext) +(defun data-debug-insert-nil (_thing prefix prebuttontext) "Insert one simple THING with a face. PREFIX is the text that precedes the button. PREBUTTONTEXT is some text between prefix and the thing. @@ -856,19 +856,18 @@ If PARENT is non-nil, it is somehow related as a parent to thing." (defvar data-debug-mode-map (let ((km (make-sparse-keymap))) (suppress-keymap km) - (define-key km [mouse-2] 'data-debug-expand-or-contract-mouse) - (define-key km " " 'data-debug-expand-or-contract) - (define-key km "\C-m" 'data-debug-expand-or-contract) - (define-key km "n" 'data-debug-next) - (define-key km "p" 'data-debug-prev) - (define-key km "N" 'data-debug-next-expando) - (define-key km "P" 'data-debug-prev-expando) + (define-key km [mouse-2] #'data-debug-expand-or-contract-mouse) + (define-key km " " #'data-debug-expand-or-contract) + (define-key km "\C-m" #'data-debug-expand-or-contract) + (define-key km "n" #'data-debug-next) + (define-key km "p" #'data-debug-prev) + (define-key km "N" #'data-debug-next-expando) + (define-key km "P" #'data-debug-prev-expando) km) "Keymap used in data-debug.") (defcustom data-debug-mode-hook nil "Hook run when data-debug starts." - :group 'data-debug :type 'hook) (define-derived-mode data-debug-mode fundamental-mode "DATA-DEBUG" @@ -1032,7 +1031,7 @@ Do nothing if already contracted." nil read-expression-map t 'read-expression-history)) )) - (let ((v (eval expr))) + (let ((v (eval expr t))) (if (not v) (message "Expression %s is nil." expr) (data-debug-show-stuff v "expression")))) @@ -1045,30 +1044,30 @@ If the result is a list or vector, then use the data debugger to display it." (list (let ((minibuffer-completing-symbol t)) (read-from-minibuffer "Eval: " nil read-expression-map t - 'read-expression-history)) - )) - - (if (null eval-expression-debug-on-error) - (setq values (cons (eval expr) values)) - (let ((old-value (make-symbol "t")) new-value) - ;; Bind debug-on-error to something unique so that we can - ;; detect when evalled code changes it. - (let ((debug-on-error old-value)) - (setq values (cons (eval expr) values)) - (setq new-value debug-on-error)) - ;; If evalled code has changed the value of debug-on-error, - ;; propagate that change to the global binding. - (unless (eq old-value new-value) - (setq debug-on-error new-value)))) - - (if (or (consp (car values)) (vectorp (car values))) - (let ((v (car values))) - (data-debug-show-stuff v "Expression")) - ;; Old style - (prog1 - (prin1 (car values) t) - (let ((str (eval-expression-print-format (car values)))) - (if str (princ str t)))))) + 'read-expression-history)))) + + (let (result) + (if (null eval-expression-debug-on-error) + (setq result (values--store-value (eval expr t))) + (let ((old-value (make-symbol "t")) new-value) + ;; Bind debug-on-error to something unique so that we can + ;; detect when evalled code changes it. + (let ((debug-on-error old-value)) + (setq result (values--store-value (eval expr t))) + (setq new-value debug-on-error)) + ;; If evalled code has changed the value of debug-on-error, + ;; propagate that change to the global binding. + (unless (eq old-value new-value) + (setq debug-on-error new-value)))) + + (if (or (consp result) (vectorp result)) + (let ((v result)) + (data-debug-show-stuff v "Expression")) + ;; Old style + (prog1 + (prin1 result t) + (let ((str (eval-expression-print-format result))) + (if str (princ str t))))))) (provide 'data-debug) diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el index e3cc9062ed4..2ec9f5d9d67 100644 --- a/lisp/cedet/ede.el +++ b/lisp/cedet/ede.el @@ -1,4 +1,4 @@ -;;; ede.el --- Emacs Development Environment gloss +;;; ede.el --- Emacs Development Environment gloss -*- lexical-binding: t; -*- ;; Copyright (C) 1998-2005, 2007-2021 Free Software Foundation, Inc. @@ -87,7 +87,6 @@ target wants the file, the user is asked. If only one target wants the file, then it is automatically added to that target. If the value is `ask', then the user is always asked, unless there is no target willing to take the file. `never' means never perform the check." - :group 'ede :type '(choice (const always) (const multi-ask) (const ask) @@ -95,7 +94,6 @@ target willing to take the file. `never' means never perform the check." (defcustom ede-debug-program-function 'gdb "Default Emacs command used to debug a target." - :group 'ede :type 'function) ; make this be a list of options some day (defcustom ede-project-directories nil @@ -112,7 +110,6 @@ If you invoke the commands \\[ede] or \\[ede-new] on a directory that is not listed, Emacs will offer to add it to the list. Any other value disables searching for EDE project files." - :group 'ede :type '(choice (const :tag "Any directory" t) (repeat :tag "List of directories" (directory)) @@ -186,21 +183,23 @@ Argument LIST-O-O is the list of objects to choose from." ;;; Menu and Keymap +(declare-function ede-speedbar "ede/speedbar" ()) + (defvar ede-minor-mode-map (let ((map (make-sparse-keymap)) (pmap (make-sparse-keymap))) - (define-key pmap "e" 'ede-edit-file-target) - (define-key pmap "a" 'ede-add-file) - (define-key pmap "d" 'ede-remove-file) - (define-key pmap "t" 'ede-new-target) - (define-key pmap "g" 'ede-rescan-toplevel) - (define-key pmap "s" 'ede-speedbar) - (define-key pmap "f" 'ede-find-file) - (define-key pmap "C" 'ede-compile-project) - (define-key pmap "c" 'ede-compile-target) - (define-key pmap "\C-c" 'ede-compile-selected) - (define-key pmap "D" 'ede-debug-target) - (define-key pmap "R" 'ede-run-target) + (define-key pmap "e" #'ede-edit-file-target) + (define-key pmap "a" #'ede-add-file) + (define-key pmap "d" #'ede-remove-file) + (define-key pmap "t" #'ede-new-target) + (define-key pmap "g" #'ede-rescan-toplevel) + (define-key pmap "s" #'ede-speedbar) + (define-key pmap "f" #'ede-find-file) + (define-key pmap "C" #'ede-compile-project) + (define-key pmap "c" #'ede-compile-target) + (define-key pmap "\C-c" #'ede-compile-selected) + (define-key pmap "D" #'ede-debug-target) + (define-key pmap "R" #'ede-run-target) ;; bind our submap into map (define-key map "\C-c." pmap) map) @@ -476,7 +475,7 @@ To be used in hook functions." If this file is contained, or could be contained in an EDE controlled project, then this mode is activated automatically provided `global-ede-mode' is enabled." - :group 'ede + :global nil (cond ((or (eq major-mode 'dired-mode) (eq major-mode 'vc-dir-mode)) (ede-dired-minor-mode (if ede-minor-mode 1 -1))) @@ -486,6 +485,9 @@ provided `global-ede-mode' is enabled." ;; If we fail to have a project here, turn it back off. (ede-minor-mode -1))))) +(declare-function ede-directory-project-cons "ede/files" (dir &optional force)) +(declare-function ede-toplevel-project-or-nil "ede/files" (dir)) + (defun ede-initialize-state-current-buffer () "Initialize the current buffer's state for EDE. Sets buffer local variables for EDE." @@ -496,7 +498,7 @@ Sets buffer local variables for EDE." ;; Init the buffer. (let* ((ROOT nil) (proj (ede-directory-get-open-project default-directory - 'ROOT))) + (gv-ref ROOT)))) (when (not proj) ;; If there is no open project, look up the project @@ -517,7 +519,8 @@ Sets buffer local variables for EDE." (ede-directory-safe-p top))) ;; The project is safe, so load it in. - (setq proj (ede-load-project-file default-directory projdetect 'ROOT)))))) + (setq proj (ede-load-project-file default-directory projdetect + (gv-ref ROOT))))))) ;; If PROJ is now loaded in, we can initialize our buffer to it. (when proj @@ -561,30 +564,29 @@ Sets buffer local variables for EDE." This global minor mode enables `ede-minor-mode' in all buffers in an EDE controlled project." :global t - :group 'ede (if global-ede-mode ;; Turn on global-ede-mode (progn (if semantic-mode (define-key cedet-menu-map [cedet-menu-separator] '("--"))) - (add-hook 'semanticdb-project-predicate-functions 'ede-directory-project-p) - (add-hook 'semanticdb-project-root-functions 'ede-toplevel-project-or-nil) - (add-hook 'ecb-source-path-functions 'ede-ecb-project-paths) + (add-hook 'semanticdb-project-predicate-functions #'ede-directory-project-p) + (add-hook 'semanticdb-project-root-functions #'ede-toplevel-project-or-nil) + (add-hook 'ecb-source-path-functions #'ede-ecb-project-paths) ;; Append our hook to the end. This allows mode-local to finish ;; it's stuff before we start doing misc file loads, etc. - (add-hook 'find-file-hook 'ede-turn-on-hook t) - (add-hook 'dired-mode-hook 'ede-turn-on-hook) - (add-hook 'kill-emacs-hook 'ede-save-cache) + (add-hook 'find-file-hook #'ede-turn-on-hook t) + (add-hook 'dired-mode-hook #'ede-turn-on-hook) + (add-hook 'kill-emacs-hook #'ede-save-cache) (ede-load-cache) (ede-reset-all-buffers)) ;; Turn off global-ede-mode (define-key cedet-menu-map [cedet-menu-separator] nil) - (remove-hook 'semanticdb-project-predicate-functions 'ede-directory-project-p) - (remove-hook 'semanticdb-project-root-functions 'ede-toplevel-project-or-nil) - (remove-hook 'ecb-source-path-functions 'ede-ecb-project-paths) - (remove-hook 'find-file-hook 'ede-turn-on-hook) - (remove-hook 'dired-mode-hook 'ede-turn-on-hook) - (remove-hook 'kill-emacs-hook 'ede-save-cache) + (remove-hook 'semanticdb-project-predicate-functions #'ede-directory-project-p) + (remove-hook 'semanticdb-project-root-functions #'ede-toplevel-project-or-nil) + (remove-hook 'ecb-source-path-functions #'ede-ecb-project-paths) + (remove-hook 'find-file-hook #'ede-turn-on-hook) + (remove-hook 'dired-mode-hook #'ede-turn-on-hook) + (remove-hook 'kill-emacs-hook #'ede-save-cache) (ede-save-cache) (ede-reset-all-buffers))) @@ -1080,7 +1082,7 @@ Flush the dead projects from the project cache." (let ((dead nil)) (dolist (P ede-projects) (when (not (file-exists-p (oref P file))) - (add-to-list 'dead P))) + (cl-pushnew P dead :test #'equal))) (dolist (D dead) (ede-delete-project-from-global-list D)) )) @@ -1108,7 +1110,7 @@ Flush the dead projects from the project cache." "Project file independent way to read a project in from DIR. Optional DETECTIN is an autoload cons from `ede-detect-directory-for-project' which can be passed in to save time. -Optional ROOTRETURN will return the root project for DIR." +Optional ROOTRETURN reference will return the root project for DIR." ;; Don't do anything if we are in the process of ;; constructing an EDE object. ;; @@ -1147,7 +1149,8 @@ Optional ROOTRETURN will return the root project for DIR." (setq o (ede-auto-load-project autoloader toppath)))) ;; Return the found root project. - (when rootreturn (set rootreturn o)) + (when rootreturn (if (symbolp rootreturn) (set rootreturn o) + (setf (gv-deref rootreturn) o))) ;; The project has been found (in the global list) or loaded from ;; disk (via autoloader.) We can now search for the project asked @@ -1504,6 +1507,8 @@ It does not apply the value to buffers." ;;; Integration with project.el (defun project-try-ede (dir) + ;; FIXME: This passes the `ROOT' dynbound variable, but I don't know + ;; where it comes from! (let ((project-dir (locate-dominating-file dir @@ -1518,12 +1523,12 @@ It does not apply the value to buffers." ;;; FIXME: Could someone look into implementing `project-ignores' for ;;; EDE and/or a faster `project-files'? -(add-hook 'project-find-functions #'project-try-ede) +(add-hook 'project-find-functions #'project-try-ede 50) (provide 'ede) ;; Include this last because it depends on ede. -(require 'ede/files) +(if t (require 'ede/files)) ;; Don't bother loading it at compile-time. ;; If this does not occur after the provide, we can get a recursive ;; load. Yuck! diff --git a/lisp/cedet/ede/auto.el b/lisp/cedet/ede/auto.el index e1417d7806c..ee9d0116af3 100644 --- a/lisp/cedet/ede/auto.el +++ b/lisp/cedet/ede/auto.el @@ -1,4 +1,4 @@ -;;; ede/auto.el --- Autoload features for EDE +;;; ede/auto.el --- Autoload features for EDE -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2021 Free Software Foundation, Inc. @@ -325,13 +325,13 @@ NOTE: Do not call this - it should only be called from `ede-load-project-file'." ;; See if we can do without them. ;; @FIXME - delete from loaddefs to remove this. -(cl-defmethod ede-project-root ((this ede-project-autoload)) +(cl-defmethod ede-project-root ((_this ede-project-autoload)) "If a project knows its root, return it here. Allows for one-project-object-for-a-tree type systems." nil) ;; @FIXME - delete from loaddefs to remove this. -(cl-defmethod ede-project-root-directory ((this ede-project-autoload) &optional file) +(cl-defmethod ede-project-root-directory ((_this ede-project-autoload) &optional _file) "" nil) (provide 'ede/auto) diff --git a/lisp/cedet/ede/autoconf-edit.el b/lisp/cedet/ede/autoconf-edit.el index ca8535fdf23..d6f0a86f9ad 100644 --- a/lisp/cedet/ede/autoconf-edit.el +++ b/lisp/cedet/ede/autoconf-edit.el @@ -1,4 +1,4 @@ -;;; ede/autoconf-edit.el --- Keymap for autoconf +;;; ede/autoconf-edit.el --- Keymap for autoconf -*- lexical-binding: t; -*- ;; Copyright (C) 1998-2000, 2009-2021 Free Software Foundation, Inc. diff --git a/lisp/cedet/ede/base.el b/lisp/cedet/ede/base.el index 810d6ef3bd4..103a37045cc 100644 --- a/lisp/cedet/ede/base.el +++ b/lisp/cedet/ede/base.el @@ -1,4 +1,4 @@ -;;; ede/base.el --- Baseclasses for EDE. +;;; ede/base.el --- Baseclasses for EDE -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2021 Free Software Foundation, Inc. @@ -47,7 +47,7 @@ ;; and features of those files. (defclass ede-target (eieio-speedbar-directory-button eieio-named) - ((buttonface :initform speedbar-file-face) ;override for superclass + ((buttonface :initform 'speedbar-file-face) ;override for superclass (name :initarg :name :type string :custom string @@ -91,16 +91,16 @@ This is used to match target objects with the compilers they can use, and which files this object is interested in." :accessor ede-object-sourcecode) (keybindings :allocation :class - :initform (("D" . ede-debug-target)) + :initform '(("D" . ede-debug-target)) :documentation "Keybindings specialized to this type of target." :accessor ede-object-keybindings) (menu :allocation :class - :initform ( [ "Debug target" ede-debug-target - (ede-buffer-belongs-to-target-p) ] - [ "Run target" ede-run-target - (ede-buffer-belongs-to-target-p) ] - ) + :initform '( [ "Debug target" ede-debug-target + (ede-buffer-belongs-to-target-p) ] + [ "Run target" ede-run-target + (ede-buffer-belongs-to-target-p) ] + ) :documentation "Menu specialized to this type of target." :accessor ede-object-menu) ) @@ -236,7 +236,7 @@ also be of a form used by TRAMP for use with scp, or rcp.") This FTP site should be in Emacs form as needed by `ange-ftp'. If this slot is nil, then use `ftp-site' instead.") (configurations :initarg :configurations - :initform ("debug" "release") + :initform '("debug" "release") :type list :custom (repeat string) :label "Configuration Options" @@ -258,25 +258,25 @@ and target specific elements such as build variables.") :group (settings) :documentation "Project local variables") (keybindings :allocation :class - :initform (("D" . ede-debug-target) - ("R" . ede-run-target)) + :initform '(("D" . ede-debug-target) + ("R" . ede-run-target)) :documentation "Keybindings specialized to this type of target." :accessor ede-object-keybindings) (menu :allocation :class :initform - ( - [ "Update Version" ede-update-version ede-object ] - [ "Version Control Status" ede-vc-project-directory ede-object ] - [ "Edit Project Homepage" ede-edit-web-page - (and ede-object (oref (ede-toplevel) web-site-file)) ] - [ "Browse Project URL" ede-web-browse-home - (and ede-object - (not (string= "" (oref (ede-toplevel) web-site-url)))) ] - "--" - [ "Rescan Project Files" ede-rescan-toplevel t ] - [ "Edit Projectfile" ede-edit-file-target - (ede-buffer-belongs-to-project-p) ] - ) + '( + [ "Update Version" ede-update-version ede-object ] + [ "Version Control Status" ede-vc-project-directory ede-object ] + [ "Edit Project Homepage" ede-edit-web-page + (and ede-object (oref (ede-toplevel) web-site-file)) ] + [ "Browse Project URL" ede-web-browse-home + (and ede-object + (not (string= "" (oref (ede-toplevel) web-site-url)))) ] + "--" + [ "Rescan Project Files" ede-rescan-toplevel t ] + [ "Edit Projectfile" ede-edit-file-target + (ede-buffer-belongs-to-project-p) ] + ) :documentation "Menu specialized to this type of target." :accessor ede-object-menu) ) @@ -288,7 +288,7 @@ All specific project types must derive from this project." ;; (defmacro ede-with-projectfile (obj &rest forms) "For the project in which OBJ resides, execute FORMS." - (declare (indent 1)) + (declare (indent 1) (debug t)) (unless (symbolp obj) (message "Beware! ede-with-projectfile's first arg is copied: %S" obj)) `(let* ((pf (if (obj-of-class-p ,obj 'ede-target) @@ -317,13 +317,15 @@ If set to nil, then the cache is not saved." (defvar ede-project-cache-files nil "List of project files EDE has seen before.") +(defvar recentf-exclude) + (defun ede-save-cache () "Save a cache of EDE objects that Emacs has seen before." (interactive) (when ede-project-placeholder-cache-file (let ((p ede-projects) (c ede-project-cache-files) - (recentf-exclude '( (lambda (f) t) )) + (recentf-exclude `( ,(lambda (_) t) )) ) (condition-case nil (progn @@ -461,7 +463,7 @@ Not all buffers need headers, so return nil if no applicable." (ede-buffer-header-file ede-object (current-buffer)) nil)) -(cl-defmethod ede-buffer-header-file ((this ede-project) buffer) +(cl-defmethod ede-buffer-header-file ((_this ede-project) _buffer) "Return nil, projects don't have header files." nil) @@ -487,12 +489,12 @@ Some projects may have multiple documentation files, so return a list." (ede-buffer-documentation-files ede-object (current-buffer)) nil)) -(cl-defmethod ede-buffer-documentation-files ((this ede-project) buffer) +(cl-defmethod ede-buffer-documentation-files ((this ede-project) _buffer) "Return all documentation in project THIS based on BUFFER." ;; Find the info node. (ede-documentation this)) -(cl-defmethod ede-buffer-documentation-files ((this ede-target) buffer) +(cl-defmethod ede-buffer-documentation-files ((_this ede-target) buffer) "Check for some documentation files for THIS. Also do a quick check to see if there is a Documentation tag in this BUFFER." (with-current-buffer buffer @@ -518,7 +520,7 @@ files in the project." proj (cdr proj))) found)) -(cl-defmethod ede-documentation ((this ede-target)) +(cl-defmethod ede-documentation ((_this ede-target)) "Return a list of files that provide documentation. Documentation is not for object THIS, but is provided by THIS for other files in the project." @@ -529,7 +531,7 @@ files in the project." (ede-html-documentation (ede-toplevel)) ) -(cl-defmethod ede-html-documentation ((this ede-project)) +(cl-defmethod ede-html-documentation ((_this ede-project)) "Return a list of HTML files provided by project THIS." ) @@ -636,18 +638,7 @@ PROJECT-FILE-NAME is a name of project file (short name, like `pom.xml', etc." (oset this directory (file-name-directory (oref this file)))) ) - - -;;; Hooks & Autoloads -;; -;; These let us watch various activities, and respond appropriately. - -;; (add-hook 'edebug-setup-hook -;; (lambda () -;; (def-edebug-spec ede-with-projectfile -;; (form def-body)))) - (provide 'ede/base) ;; Local variables: diff --git a/lisp/cedet/ede/config.el b/lisp/cedet/ede/config.el index 19686216cd5..98a0419e8bf 100644 --- a/lisp/cedet/ede/config.el +++ b/lisp/cedet/ede/config.el @@ -1,4 +1,4 @@ -;;; ede/config.el --- Configuration Handler baseclass +;;; ede/config.el --- Configuration Handler baseclass -*- lexical-binding: t; -*- ;; Copyright (C) 2014-2021 Free Software Foundation, Inc. @@ -96,7 +96,7 @@ and also want to save some extra level of configuration.") This filename excludes the directory name and is used to initialize the :file slot of the persistent baseclass.") (config-class - :initform ede-extra-config + :initform 'ede-extra-config :allocation :class :type class :documentation @@ -171,7 +171,7 @@ the directory isn't on the `safe' list, ask to add it to the safe list." (oset config project proj))) config)) -(cl-defmethod ede-config-setup-configuration ((proj ede-project-with-config) config) +(cl-defmethod ede-config-setup-configuration ((_proj ede-project-with-config) _config) "Default configuration setup method." nil) @@ -187,7 +187,7 @@ the directory isn't on the `safe' list, ask to add it to the safe list." (let ((config (ede-config-get-configuration proj t))) (eieio-customize-object config))) -(cl-defmethod ede-customize ((target ede-target-with-config)) +(cl-defmethod ede-customize ((_target ede-target-with-config)) "Customize the EDE TARGET by actually configuring the config object." ;; Nothing unique for the targets, use the project. (ede-customize-project)) @@ -302,14 +302,14 @@ This class brings in method overloads for building.") "Class to mix into a project with configuration for builds. This class brings in method overloads for building.") -(cl-defmethod project-compile-project ((proj ede-project-with-config-build) &optional command) +(cl-defmethod project-compile-project ((proj ede-project-with-config-build) &optional _command) "Compile the entire current project PROJ. Argument COMMAND is the command to use when compiling." (let* ((config (ede-config-get-configuration proj t)) (comp (oref config build-command))) (compile comp))) -(cl-defmethod project-compile-target ((obj ede-target-with-config-build) &optional command) +(cl-defmethod project-compile-target ((_obj ede-target-with-config-build) &optional command) "Compile the current target OBJ. Argument COMMAND is the command to use for compiling the target." (project-compile-project (ede-current-project) command)) diff --git a/lisp/cedet/ede/cpp-root.el b/lisp/cedet/ede/cpp-root.el index 41f0c682892..652d6476f02 100644 --- a/lisp/cedet/ede/cpp-root.el +++ b/lisp/cedet/ede/cpp-root.el @@ -1,4 +1,4 @@ -;;; ede/cpp-root.el --- A simple way to wrap a C++ project with a single root +;;; ede/cpp-root.el --- A simple way to wrap a C++ project with a single root -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. @@ -275,7 +275,7 @@ Each directory needs a project file to control it.") ;; objects is deleted. (cl-defmethod initialize-instance ((this ede-cpp-root-project) - &rest fields) + &rest _fields) "Make sure the :file is fully expanded." ;; Add ourselves to the master list (cl-call-next-method) @@ -310,7 +310,7 @@ Each directory needs a project file to control it.") ;; project, simplifying authoring new single-point projects. (cl-defmethod ede-find-subproject-for-directory ((proj ede-cpp-root-project) - dir) + _dir) "Return PROJ, for handling all subdirs below DIR." proj) @@ -319,7 +319,7 @@ Each directory needs a project file to control it.") ;; Creating new targets on a per directory basis is a good way to keep ;; files organized. See ede-emacs for an example with multiple file ;; types. -(cl-defmethod ede-find-target ((proj ede-cpp-root-project) buffer) +(cl-defmethod ede-find-target ((proj ede-cpp-root-project) _buffer) "Find an EDE target in PROJ for BUFFER. If one doesn't exist, create a new one for this directory." (let* ((targets (oref proj targets)) @@ -451,7 +451,7 @@ This is for project include paths and spp source files." "Get the pre-processor map for project THIS." (ede-preprocessor-map (ede-target-parent this))) -(cl-defmethod project-compile-project ((proj ede-cpp-root-project) &optional command) +(cl-defmethod project-compile-project ((proj ede-cpp-root-project) &optional _command) "Compile the entire current project PROJ. Argument COMMAND is the command to use when compiling." ;; we need to be in the proj root dir for this to work @@ -474,7 +474,7 @@ Argument COMMAND is the command to use for compiling the target." (project-compile-project (oref obj project) command))) -(cl-defmethod project-rescan ((this ede-cpp-root-project)) +(cl-defmethod project-rescan ((_this ede-cpp-root-project)) "Don't rescan this project from the sources." (message "cpp-root has nothing to rescan.")) diff --git a/lisp/cedet/ede/custom.el b/lisp/cedet/ede/custom.el index aada872cd0a..ac4f9f66846 100644 --- a/lisp/cedet/ede/custom.el +++ b/lisp/cedet/ede/custom.el @@ -1,4 +1,4 @@ -;;; ede/custom.el --- customization of EDE projects. +;;; ede/custom.el --- customization of EDE projects. -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2021 Free Software Foundation, Inc. @@ -53,7 +53,7 @@ (setq-local eieio-ede-old-variables ov))) ;;;###autoload -(defalias 'customize-project 'ede-customize-project) +(defalias 'customize-project #'ede-customize-project) ;;;###autoload (defun ede-customize-current-target() @@ -65,7 +65,7 @@ (ede-customize-target ede-object)) ;;;###autoload -(defalias 'customize-target 'ede-customize-current-target) +(defalias 'customize-target #'ede-customize-current-target) (defun ede-customize-target (obj) "Edit fields of the current target through EIEIO & Custom. @@ -97,13 +97,13 @@ OBJ is the target object to customize." "Create a custom-like buffer for sorting targets of current project." (interactive) (let ((proj (ede-current-project)) - (count 1) - current order) + ;; (count 1) + ) ;; current order (switch-to-buffer (get-buffer-create "*EDE sort targets*")) (erase-buffer) (setq ede-object-project proj) (widget-create 'push-button - :notify (lambda (&rest ignore) + :notify (lambda (&rest _ignore) (let ((targets (oref ede-object-project targets)) cur newtargets) (while (setq cur (pop ede-project-sort-targets-order)) @@ -115,7 +115,7 @@ OBJ is the target object to customize." " Accept ") (widget-insert " ") (widget-create 'push-button - :notify (lambda (&rest ignore) + :notify (lambda (&rest _ignore) (kill-buffer)) " Cancel ") (widget-insert "\n\n") @@ -133,45 +133,45 @@ OBJ is the target object to customize." (defun ede-project-sort-targets-list () "Sort the target list while using `ede-project-sort-targets'." (save-excursion - (let ((count 0) - (targets (oref ede-object-project targets)) + (let ((targets (oref ede-object-project targets)) (inhibit-read-only t) (inhibit-modification-hooks t)) (goto-char (point-min)) (forward-line 2) (delete-region (point) (point-max)) - (while (< count (length targets)) + (dotimes (count (length targets)) (if (> count 0) (widget-create 'push-button - :notify `(lambda (&rest ignore) - (let ((cur ede-project-sort-targets-order)) - (add-to-ordered-list - 'ede-project-sort-targets-order - (nth ,count cur) - (1- ,count)) - (add-to-ordered-list - 'ede-project-sort-targets-order - (nth (1- ,count) cur) ,count)) - (ede-project-sort-targets-list)) + :notify (lambda (&rest _ignore) + (let ((cur ede-project-sort-targets-order)) + (add-to-ordered-list + 'ede-project-sort-targets-order + (nth count cur) + (1- count)) + (add-to-ordered-list + 'ede-project-sort-targets-order + (nth (1- count) cur) count)) + (ede-project-sort-targets-list)) " Up ") (widget-insert " ")) (if (< count (1- (length targets))) (widget-create 'push-button - :notify `(lambda (&rest ignore) - (let ((cur ede-project-sort-targets-order)) - (add-to-ordered-list - 'ede-project-sort-targets-order - (nth ,count cur) (1+ ,count)) - (add-to-ordered-list - 'ede-project-sort-targets-order - (nth (1+ ,count) cur) ,count)) - (ede-project-sort-targets-list)) + :notify (lambda (&rest _ignore) + (let ((cur ede-project-sort-targets-order)) + (add-to-ordered-list + 'ede-project-sort-targets-order + (nth count cur) (1+ count)) + (add-to-ordered-list + 'ede-project-sort-targets-order + (nth (1+ count) cur) count)) + (ede-project-sort-targets-list)) " Down ") (widget-insert " ")) (widget-insert (concat " " (number-to-string (1+ count)) ".: " (oref (nth (nth count ede-project-sort-targets-order) - targets) name) "\n")) - (setq count (1+ count)))))) + targets) + name) + "\n")))))) ;;; Customization hooks ;; @@ -195,11 +195,11 @@ OBJ is the target object to customize." ;; These two methods should be implemented by subclasses of ;; project and targets in order to account for user specified ;; changes. -(cl-defmethod eieio-done-customizing ((target ede-target)) +(cl-defmethod eieio-done-customizing ((_target ede-target)) "Call this when a user finishes customizing TARGET." nil) -(cl-defmethod ede-commit-project ((proj ede-project)) +(cl-defmethod ede-commit-project ((_proj ede-project)) "Commit any change to PROJ to its file." nil ) diff --git a/lisp/cedet/ede/detect.el b/lisp/cedet/ede/detect.el index 027d008ea38..c933fc4515e 100644 --- a/lisp/cedet/ede/detect.el +++ b/lisp/cedet/ede/detect.el @@ -1,4 +1,4 @@ -;;; ede/detect.el --- EDE project detection and file associations +;;; ede/detect.el --- EDE project detection and file associations -*- lexical-binding: t; -*- ;; Copyright (C) 2014-2021 Free Software Foundation, Inc. diff --git a/lisp/cedet/ede/dired.el b/lisp/cedet/ede/dired.el index c85d4ee7924..27735176c2a 100644 --- a/lisp/cedet/ede/dired.el +++ b/lisp/cedet/ede/dired.el @@ -1,4 +1,4 @@ -;;; ede/dired.el --- EDE extensions to dired. +;;; ede/dired.el --- EDE extensions to dired. -*- lexical-binding: t -*- ;; Copyright (C) 1998-2000, 2003, 2009-2021 Free Software Foundation, ;; Inc. @@ -30,17 +30,16 @@ ;;; Code: -(require 'easymenu) (require 'dired) (require 'ede) (defvar ede-dired-keymap (let ((map (make-sparse-keymap))) - (define-key map ".a" 'ede-dired-add-to-target) - (define-key map ".t" 'ede-new-target) - (define-key map ".s" 'ede-speedbar) - (define-key map ".C" 'ede-compile-project) - (define-key map ".d" 'ede-make-dist) + (define-key map ".a" #'ede-dired-add-to-target) + (define-key map ".t" #'ede-new-target) + (define-key map ".s" #'ede-speedbar) + (define-key map ".C" #'ede-compile-project) + (define-key map ".d" #'ede-make-dist) (easy-menu-define ede-dired-menu map "EDE Dired Minor Mode Menu" diff --git a/lisp/cedet/ede/emacs.el b/lisp/cedet/ede/emacs.el index 1eb4c6395a4..00496ace16f 100644 --- a/lisp/cedet/ede/emacs.el +++ b/lisp/cedet/ede/emacs.el @@ -1,4 +1,4 @@ -;;; ede/emacs.el --- Special project for Emacs +;;; ede/emacs.el --- Special project for Emacs -*- lexical-binding: t -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -54,31 +54,6 @@ Return a tuple of ( EMACSNAME . VERSION )." (erase-buffer) (setq default-directory (file-name-as-directory dir)) (cond - ;; Maybe XEmacs? - ((file-exists-p "version.sh") - (setq emacs "XEmacs") - (insert-file-contents "version.sh") - (goto-char (point-min)) - (re-search-forward "emacs_major_version=\\([0-9]+\\) -emacs_minor_version=\\([0-9]+\\) -emacs_beta_version=\\([0-9]+\\)") - (setq ver (concat (match-string 1) "." - (match-string 2) "." - (match-string 3))) - ) - ((file-exists-p "sxemacs.pc.in") - (setq emacs "SXEmacs") - (insert-file-contents "sxemacs_version.m4") - (goto-char (point-min)) - (re-search-forward "m4_define(\\[SXEM4CS_MAJOR_VERSION\\], \\[\\([0-9]+\\)\\]) -m4_define(\\[SXEM4CS_MINOR_VERSION\\], \\[\\([0-9]+\\)\\]) -m4_define(\\[SXEM4CS_BETA_VERSION\\], \\[\\([0-9]+\\)\\])") - (setq ver (concat (match-string 1) "." - (match-string 2) "." - (match-string 3))) - ) - ;; Insert other Emacs here... - ;; Vaguely recent version of GNU Emacs? ((or (file-exists-p configure_ac) (file-exists-p (setq configure_ac "configure.in"))) diff --git a/lisp/cedet/ede/files.el b/lisp/cedet/ede/files.el index cf5396ad00e..6b7e1595646 100644 --- a/lisp/cedet/ede/files.el +++ b/lisp/cedet/ede/files.el @@ -1,4 +1,4 @@ -;;; ede/files.el --- Associate projects with files and directories. +;;; ede/files.el --- Associate projects with files and directories. -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -33,6 +33,7 @@ ;; till no ede-project-autoload structure matches. ;; +(require 'eieio) (require 'ede) (declare-function ede-locate-file-in-hash "ede/locate") @@ -75,13 +76,13 @@ Allows for one-project-object-for-a-tree type systems." (oref this rootproject)) (cl-defmethod ede-project-root-directory ((this ede-project-placeholder) - &optional file) + &optional _file) "If a project knows its root, return it here. Allows for one-project-object-for-a-tree type systems. Optional FILE is the file to test. It is ignored in preference of the anchor file for the project." - (let ((root (or (ede-project-root this) this))) - (file-name-directory (expand-file-name (oref this file))))) + ;; (let ((root (or (ede-project-root this) this))) + (file-name-directory (expand-file-name (oref this file)))) ;; ) ;; Why INODEs? @@ -141,7 +142,7 @@ Does not check subprojects." (defun ede-directory-get-open-project (dir &optional rootreturn) "Return an already open project that is managing DIR. -Optional ROOTRETURN specifies a symbol to set to the root project. +Optional ROOTRETURN specifies a `gv-ref' to set to the root project. If DIR is the root project, then it is the same." (let* ((inode (ede--inode-for-dir dir)) (ft (file-name-as-directory (expand-file-name dir))) @@ -153,7 +154,8 @@ If DIR is the root project, then it is the same." ;; Default answer is this project (setq ans proj) ;; Save. - (when rootreturn (set rootreturn proj)) + (when rootreturn (if (symbolp rootreturn) (set rootreturn proj) + (setf (gv-deref rootreturn) proj))) ;; Find subprojects. (when (and proj (if ede--disable-inode (not (string= ft (expand-file-name @@ -272,7 +274,7 @@ Do this whenever a new project is created, as opposed to loaded." (remhash (file-name-as-directory dir) ede-project-directory-hash) ;; Look for all subdirs of D, and remove them. (let ((match (concat "^" (regexp-quote dir)))) - (maphash (lambda (K O) + (maphash (lambda (K _O) (when (string-match match K) (remhash K ede-project-directory-hash))) ede-project-directory-hash))) @@ -363,7 +365,7 @@ If DIR is not part of a project, return nil." (t nil)))) -(defalias 'ede-toplevel-project-or-nil 'ede-toplevel-project) +(defalias 'ede-toplevel-project-or-nil #'ede-toplevel-project) ;;; DIRECTORY CONVERSION STUFF ;; @@ -469,15 +471,15 @@ is returned." ans)) -(cl-defmethod ede-expand-filename-impl ((this ede-project) filename &optional force) +(cl-defmethod ede-expand-filename-impl ((this ede-project) filename &optional _force) "Return a fully qualified file name based on project THIS. FILENAME should be just a filename which occurs in a directory controlled by this project. Optional argument FORCE forces the default filename to be provided even if it doesn't exist." (let ((loc (ede-get-locator-object this)) - (path (ede-project-root-directory this)) - (proj (oref this subproj)) + ;; (path (ede-project-root-directory this)) + ;; (proj (oref this subproj)) (found nil)) ;; find it Locally. (setq found (or (ede-expand-filename-local this filename) diff --git a/lisp/cedet/ede/generic.el b/lisp/cedet/ede/generic.el index 3d1e1c5818e..4537f59ac9d 100644 --- a/lisp/cedet/ede/generic.el +++ b/lisp/cedet/ede/generic.el @@ -1,4 +1,4 @@ -;;; ede/generic.el --- Base Support for generic build systems +;;; ede/generic.el --- Base Support for generic build systems -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2021 Free Software Foundation, Inc. @@ -93,7 +93,7 @@ ) "User Configuration object for a generic project.") -(defun ede-generic-load (dir &optional rootproj) +(defun ede-generic-load (dir &optional _rootproj) "Return a Generic Project object if there is a match. Return nil if there isn't one. Argument DIR is the directory it is created for. @@ -137,7 +137,7 @@ subclasses of this base target will override the default value.") ede-project-with-config-program ede-project-with-config-c ede-project-with-config-java) - ((config-class :initform ede-generic-config) + ((config-class :initform 'ede-generic-config) (config-file-basename :initform "EDEConfig.el") (buildfile :initform "" :type string @@ -149,7 +149,7 @@ The class allocated value is replace by different sub classes.") :abstract t) (cl-defmethod initialize-instance ((this ede-generic-project) - &rest fields) + &rest _fields) "Make sure the targets slot is bound." (cl-call-next-method) (unless (slot-boundp this 'targets) @@ -161,7 +161,7 @@ The class allocated value is replace by different sub classes.") this) (cl-defmethod ede-find-subproject-for-directory ((proj ede-generic-project) - dir) + _dir) "Return PROJ, for handling all subdirs below DIR." proj) @@ -324,7 +324,7 @@ CLASS is the EIEIO class that is used to track this project. It should subclass ) "Generic Project for makefiles.") -(cl-defmethod ede-generic-setup-configuration ((proj ede-generic-makefile-project) config) +(cl-defmethod ede-generic-setup-configuration ((_proj ede-generic-makefile-project) config) "Setup a configuration for Make." (oset config build-command "make -k") (oset config debug-command "gdb ") @@ -337,7 +337,7 @@ CLASS is the EIEIO class that is used to track this project. It should subclass ) "Generic Project for scons.") -(cl-defmethod ede-generic-setup-configuration ((proj ede-generic-scons-project) config) +(cl-defmethod ede-generic-setup-configuration ((_proj ede-generic-scons-project) config) "Setup a configuration for SCONS." (oset config build-command "scons") (oset config debug-command "gdb ") @@ -350,7 +350,7 @@ CLASS is the EIEIO class that is used to track this project. It should subclass ) "Generic Project for cmake.") -(cl-defmethod ede-generic-setup-configuration ((proj ede-generic-cmake-project) config) +(cl-defmethod ede-generic-setup-configuration ((_proj ede-generic-cmake-project) config) "Setup a configuration for CMake." (oset config build-command "cmake") (oset config debug-command "gdb ") @@ -361,9 +361,9 @@ CLASS is the EIEIO class that is used to track this project. It should subclass () "Generic project found via Version Control files.") -(cl-defmethod ede-generic-setup-configuration ((proj ede-generic-vc-project) config) +(cl-defmethod ede-generic-setup-configuration ((_proj ede-generic-vc-project) _config) "Setup a configuration for projects identified by revision control." - ) + nil) (provide 'ede/generic) diff --git a/lisp/cedet/ede/linux.el b/lisp/cedet/ede/linux.el index 7a1c4c9e262..4b5530d6aca 100644 --- a/lisp/cedet/ede/linux.el +++ b/lisp/cedet/ede/linux.el @@ -1,4 +1,4 @@ -;;; ede/linux.el --- Special project for Linux +;;; ede/linux.el --- Special project for Linux -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -47,26 +47,22 @@ (defcustom project-linux-build-directory-default 'ask "Build directory." :version "24.4" - :group 'project-linux :type '(choice (const :tag "Same as source directory" same) (const :tag "Ask the user" ask))) (defcustom project-linux-architecture-default 'ask "Target architecture to assume when not auto-detected." :version "24.4" - :group 'project-linux :type '(choice (string :tag "Architecture name") (const :tag "Ask the user" ask))) (defcustom project-linux-compile-target-command (concat ede-make-command " -k -C %s SUBDIRS=%s") "Default command used to compile a target." - :group 'project-linux :type 'string) (defcustom project-linux-compile-project-command (concat ede-make-command " -k -C %s") "Default command used to compile a project." - :group 'project-linux :type 'string) (defun ede-linux-version (dir) diff --git a/lisp/cedet/ede/locate.el b/lisp/cedet/ede/locate.el index e6a89533cca..016092cd8bf 100644 --- a/lisp/cedet/ede/locate.el +++ b/lisp/cedet/ede/locate.el @@ -1,4 +1,4 @@ -;;; ede/locate.el --- Locate support +;;; ede/locate.el --- Locate support -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -110,7 +110,7 @@ based on `ede-locate-setup-options'." ) "Baseclass for LOCATE feature in EDE.") -(cl-defmethod initialize-instance ((loc ede-locate-base) &rest fields) +(cl-defmethod initialize-instance ((loc ede-locate-base) &rest _fields) "Make sure we have a hash table." ;; Basic setup. (cl-call-next-method) @@ -118,8 +118,8 @@ based on `ede-locate-setup-options'." (ede-locate-flush-hash loc) ) -(cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-base)) - root) +(cl-defmethod ede-locate-ok-in-project ((_loc (subclass ede-locate-base)) + _root) "Is it ok to use this project type under ROOT." t) @@ -149,17 +149,15 @@ that created this EDE locate object." (oset loc lastanswer ans) ans)) -(cl-defmethod ede-locate-file-in-project-impl ((loc ede-locate-base) - filesubstring - ) +(cl-defmethod ede-locate-file-in-project-impl ((_loc ede-locate-base) + _filesubstring) "Locate with LOC occurrences of FILESUBSTRING. Searches are done under the current root of the EDE project that created this EDE locate object." - nil - ) + nil) (cl-defmethod ede-locate-create/update-root-database - ((loc (subclass ede-locate-base)) root) + ((loc (subclass ede-locate-base)) _root) "Create or update the database for the current project. You cannot create projects for the baseclass." (error "Cannot create/update a database of type %S" @@ -177,8 +175,8 @@ You cannot create projects for the baseclass." Configure the Emacs `locate-program' variable to also configure the use of EDE locate.") -(cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-locate)) - root) +(cl-defmethod ede-locate-ok-in-project ((_loc (subclass ede-locate-locate)) + _root) "Is it ok to use this project type under ROOT." (or (featurep 'locate) (locate-library "locate")) ) @@ -198,7 +196,7 @@ that created this EDE locate object." (with-current-buffer b (setq default-directory cd) (erase-buffer)) - (apply 'call-process locate-command + (apply #'call-process locate-command nil b nil searchstr nil) (with-current-buffer b @@ -221,7 +219,7 @@ Configure EDE's use of GNU Global through the cedet-global.el variable `cedet-global-command'.") (cl-defmethod initialize-instance ((loc ede-locate-global) - &rest slots) + &rest _slots) "Make sure that we can use GNU Global." (require 'cedet-global) ;; Get ourselves initialized. @@ -235,8 +233,8 @@ variable `cedet-global-command'.") (oref loc root)))) ) -(cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-global)) - root) +(cl-defmethod ede-locate-ok-in-project ((_loc (subclass ede-locate-global)) + root) "Is it ok to use this project type under ROOT." (require 'cedet-global) (cedet-gnu-global-version-check) @@ -252,7 +250,7 @@ variable `cedet-global-command'.") (cedet-gnu-global-expand-filename filesubstring))) (cl-defmethod ede-locate-create/update-root-database - ((loc (subclass ede-locate-global)) root) + ((_loc (subclass ede-locate-global)) root) "Create or update the GNU Global database for the current project." (cedet-gnu-global-create/update-database root)) @@ -271,7 +269,7 @@ Configure EDE's use of IDUtils through the cedet-idutils.el file name searching variable `cedet-idutils-file-command'.") (cl-defmethod initialize-instance ((loc ede-locate-idutils) - &rest slots) + &rest _slots) "Make sure that we can use IDUtils." ;; Get ourselves initialized. (cl-call-next-method) @@ -283,8 +281,8 @@ file name searching variable `cedet-idutils-file-command'.") (oref loc root))) ) -(cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-idutils)) - root) +(cl-defmethod ede-locate-ok-in-project ((_loc (subclass ede-locate-idutils)) + root) "Is it ok to use this project type under ROOT." (require 'cedet-idutils) (cedet-idutils-version-check) @@ -301,7 +299,7 @@ that created this EDE locate object." (cedet-idutils-expand-filename filesubstring))) (cl-defmethod ede-locate-create/update-root-database - ((loc (subclass ede-locate-idutils)) root) + ((_loc (subclass ede-locate-idutils)) root) "Create or update the GNU Global database for the current project." (cedet-idutils-create/update-database root)) @@ -320,7 +318,7 @@ Configure EDE's use of Cscope through the cedet-cscope.el file name searching variable `cedet-cscope-file-command'.") (cl-defmethod initialize-instance ((loc ede-locate-cscope) - &rest slots) + &rest _slots) "Make sure that we can use Cscope." ;; Get ourselves initialized. (cl-call-next-method) @@ -332,8 +330,8 @@ file name searching variable `cedet-cscope-file-command'.") (oref loc root))) ) -(cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-cscope)) - root) +(cl-defmethod ede-locate-ok-in-project ((_loc (subclass ede-locate-cscope)) + root) "Is it ok to use this project type under ROOT." (require 'cedet-cscope) (cedet-cscope-version-check) @@ -350,7 +348,7 @@ that created this EDE locate object." (cedet-cscope-expand-filename filesubstring))) (cl-defmethod ede-locate-create/update-root-database - ((loc (subclass ede-locate-cscope)) root) + ((_loc (subclass ede-locate-cscope)) root) "Create or update the Cscope database for the current project." (require 'cedet-cscope) (cedet-cscope-create/update-database root)) diff --git a/lisp/cedet/ede/make.el b/lisp/cedet/ede/make.el index 863d715e4f1..3402020fc4a 100644 --- a/lisp/cedet/ede/make.el +++ b/lisp/cedet/ede/make.el @@ -1,6 +1,6 @@ -;;; ede/make.el --- General information about "make" +;;; ede/make.el --- General information about "make" -*- 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> @@ -30,8 +30,6 @@ ;;; Code: -(declare-function inversion-check-version "inversion") - (defsubst ede--find-executable (exec) "Return an expanded file name for a program EXEC on the exec path." (declare (obsolete locate-file "28.1")) @@ -60,8 +58,7 @@ If NOERROR is nil, then throw an error on failure. Return t otherwise." (let ((b (get-buffer-create "*EDE Make Version*")) (cd default-directory) (rev nil) - (ans nil) - ) + (ans nil)) (with-current-buffer b ;; Setup, and execute make. (setq default-directory cd) @@ -70,18 +67,18 @@ If NOERROR is nil, then throw an error on failure. Return t otherwise." "--version") ;; Check the buffer for the string (goto-char (point-min)) - (when (looking-at "GNU Make\\(?: version\\)? \\([0-9][^,]+\\),") + (when (looking-at "GNU Make\\(?: version\\)? \\([0-9][^,[:space:]]+\\),?") (setq rev (match-string 1)) - (require 'inversion) - (setq ans (not (inversion-check-version rev nil ede-make-min-version)))) + (setq ans (not (version< rev ede-make-min-version)))) ;; Answer reporting. (when (and (called-interactively-p 'interactive) ans) (message "GNU Make version %s. Good enough for CEDET." rev)) (when (and (not noerror) (not ans)) - (error "EDE requires GNU Make version %s or later. Configure `ede-make-command' to fix" - ede-make-min-version)) + (error "EDE requires GNU Make version %s or later (found %s). Configure `ede-make-command' to fix" + ede-make-min-version + rev)) ans))) (provide 'ede/make) diff --git a/lisp/cedet/ede/makefile-edit.el b/lisp/cedet/ede/makefile-edit.el index 43655a5d1e3..d6965945494 100644 --- a/lisp/cedet/ede/makefile-edit.el +++ b/lisp/cedet/ede/makefile-edit.el @@ -1,4 +1,4 @@ -;;; makefile-edit.el --- Makefile editing/scanning commands. +;;; makefile-edit.el --- Makefile editing/scanning commands. -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2021 Free Software Foundation, Inc. diff --git a/lisp/cedet/ede/pconf.el b/lisp/cedet/ede/pconf.el index 5bed32ff058..c5b2ea4cb60 100644 --- a/lisp/cedet/ede/pconf.el +++ b/lisp/cedet/ede/pconf.el @@ -1,7 +1,6 @@ -;;; ede/pconf.el --- configure.ac maintenance for EDE +;;; ede/pconf.el --- configure.ac maintenance for EDE -*- lexical-binding: t; -*- -;;; Copyright (C) 1998-2000, 2005, 2008-2021 Free Software Foundation, -;;; Inc. +;; Copyright (C) 1998-2021 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: project @@ -67,7 +66,7 @@ don't do it. A value of nil means to just do it.") ;;(td (file-name-directory (ede-proj-configure-file this))) (targs (oref this targets)) (postcmd "") - (add-missing nil)) + ) ;; (add-missing nil) ;; First, make sure we have a file. (if (not (file-exists-p (ede-proj-configure-file this))) (autoconf-new-program b (oref this name) "Project.ede")) @@ -97,7 +96,7 @@ don't do it. A value of nil means to just do it.") (ede-map-targets sp #'ede-proj-flush-autoconf))) (ede-map-all-subprojects this - (lambda (sp) + (lambda (_sp) (ede-map-targets this #'ede-proj-tweak-autoconf))) ;; Now save (save-buffer) @@ -109,14 +108,15 @@ don't do it. A value of nil means to just do it.") (ede-proj-configure-test-required-file this "README") (ede-proj-configure-test-required-file this "ChangeLog") ;; Let specific targets get missing files. - (mapc 'ede-proj-configure-create-missing targs) + (mapc #'ede-proj-configure-create-missing targs) ;; Verify that we have a make system. (if (or (not (ede-expand-filename (ede-toplevel this) "Makefile")) ;; Now is this one of our old Makefiles? (with-current-buffer (find-file-noselect (ede-expand-filename (ede-toplevel this) - "Makefile" t) t) + "Makefile" t) + t) (goto-char (point-min)) ;; Here is the unique piece for our makefiles. (re-search-forward "For use with: make" nil t))) @@ -166,11 +166,11 @@ don't do it. A value of nil means to just do it.") "Tweak the configure file (current buffer) to accommodate THIS." ;; Check the compilers belonging to THIS, and call the autoconf ;; setup for those compilers. - (mapc 'ede-proj-tweak-autoconf (ede-proj-compilers this)) - (mapc 'ede-proj-tweak-autoconf (ede-proj-linkers this)) + (mapc #'ede-proj-tweak-autoconf (ede-proj-compilers this)) + (mapc #'ede-proj-tweak-autoconf (ede-proj-linkers this)) ) -(cl-defmethod ede-proj-flush-autoconf ((this ede-proj-target)) +(cl-defmethod ede-proj-flush-autoconf ((_this ede-proj-target)) "Flush the configure file (current buffer) to accommodate THIS. By flushing, remove any cruft that may be in the file. Subsequent calls to `ede-proj-tweak-autoconf' can restore items removed by flush." @@ -178,13 +178,13 @@ calls to `ede-proj-tweak-autoconf' can restore items removed by flush." ;; @TODO - No-one calls this ??? -(cl-defmethod ede-proj-configure-add-missing ((this ede-proj-target)) +(cl-defmethod ede-proj-configure-add-missing ((_this ede-proj-target)) "Query if any files needed by THIS provided by automake are missing. Results in --add-missing being passed to automake." nil) ;; @TODO - No-one implements this yet. -(cl-defmethod ede-proj-configure-create-missing ((this ede-proj-target)) +(cl-defmethod ede-proj-configure-create-missing ((_this ede-proj-target)) "Add any missing files for THIS by creating them." nil) diff --git a/lisp/cedet/ede/pmake.el b/lisp/cedet/ede/pmake.el index 4c948df4102..fd6918c4e81 100644 --- a/lisp/cedet/ede/pmake.el +++ b/lisp/cedet/ede/pmake.el @@ -1,4 +1,4 @@ -;;; ede-pmake.el --- EDE Generic Project Makefile code generator. +;;; ede-pmake.el --- EDE Generic Project Makefile code generator -*- lexical-binding: t; -*- ;; Copyright (C) 1998-2005, 2007-2021 Free Software Foundation, Inc. @@ -46,6 +46,7 @@ (require 'ede/proj) (require 'ede/proj-obj) (require 'ede/proj-comp) +(require 'seq) (declare-function ede-srecode-setup "ede/srecode") (declare-function ede-srecode-insert "ede/srecode") @@ -111,13 +112,13 @@ MFILENAME is the makefile to generate." (let* ((targ (if isdist (oref this targets) mt)) (sp (oref this subproj)) - (df (apply 'append + (df (apply #'append (mapcar (lambda (tg) (ede-proj-makefile-dependency-files tg)) targ)))) ;; Distribution variables (ede-compiler-begin-unique - (mapc 'ede-proj-makefile-insert-variables targ)) + (mapc #'ede-proj-makefile-insert-variables targ)) ;; Only add the distribution stuff in when depth != 0 (let ((top (ede-toplevel this)) (tmp this) @@ -153,7 +154,8 @@ MFILENAME is the makefile to generate." (concat ".deps/" (file-name-nondirectory (file-name-sans-extension - f)) ".P")) + f)) + ".P")) df " ")))) ;; ;; Insert ALL Rule @@ -188,11 +190,11 @@ MFILENAME is the makefile to generate." ;; (ede-compiler-begin-unique (ede-proj-makefile-insert-rules this) - (mapc 'ede-proj-makefile-insert-rules targ)) + (mapc #'ede-proj-makefile-insert-rules targ)) ;; ;; phony targets for sub projects ;; - (mapc 'ede-proj-makefile-insert-subproj-rules sp) + (mapc #'ede-proj-makefile-insert-subproj-rules sp) ;; ;; Distribution rules such as CLEAN and DIST ;; @@ -210,11 +212,11 @@ MFILENAME is the makefile to generate." ;; Distribution variables (let ((targ (if isdist (oref this targets) mt))) (ede-compiler-begin-unique - (mapc 'ede-proj-makefile-insert-automake-pre-variables targ)) + (mapc #'ede-proj-makefile-insert-automake-pre-variables targ)) (ede-compiler-begin-unique - (mapc 'ede-proj-makefile-insert-source-variables targ)) + (mapc #'ede-proj-makefile-insert-source-variables targ)) (ede-compiler-begin-unique - (mapc 'ede-proj-makefile-insert-automake-post-variables targ)) + (mapc #'ede-proj-makefile-insert-automake-post-variables targ)) (ede-compiler-begin-unique (ede-proj-makefile-insert-user-rules this)) (insert "\n# End of Makefile.am\n") @@ -241,6 +243,7 @@ MFILENAME is the makefile to generate." (defmacro ede-pmake-insert-variable-shared (varname &rest body) "Add VARNAME into the current Makefile. Execute BODY in a location where a value can be placed." + (declare (debug t) (indent 1)) `(let ((addcr t) (v ,varname)) (if (save-excursion (goto-char (point-max)) @@ -258,20 +261,19 @@ Execute BODY in a location where a value can be placed." ,@body (if addcr (insert "\n")) (goto-char (point-max)))) -(put 'ede-pmake-insert-variable-shared 'lisp-indent-function 1) (defmacro ede-pmake-insert-variable-once (varname &rest body) "Add VARNAME into the current Makefile if it doesn't exist. Execute BODY in a location where a value can be placed." - `(let ((addcr t) (v ,varname)) - (unless - (save-excursion - (re-search-backward (concat "^" v "\\s-*=") nil t)) - (insert v "=") - ,@body - (when addcr (insert "\n")) - (goto-char (point-max))))) -(put 'ede-pmake-insert-variable-once 'lisp-indent-function 1) + (declare (debug t) (indent 1)) + `(let ((v ,varname)) + (unless + (save-excursion + (re-search-backward (concat "^" v "\\s-*=") nil t)) + (insert v "=") + ,@body + (insert "\n") + (goto-char (point-max))))) ;;; SOURCE VARIABLE NAME CONSTRUCTION @@ -289,7 +291,7 @@ Change . to _ in the variable name." ;;; DEPENDENCY FILE GENERATOR LISTS ;; -(cl-defmethod ede-proj-makefile-dependency-files ((this ede-proj-target)) +(cl-defmethod ede-proj-makefile-dependency-files ((_this ede-proj-target)) "Return a list of source files to convert to dependencies. Argument THIS is the target to get sources from." nil) @@ -302,7 +304,7 @@ Argument THIS is the target to get sources from." Use CONFIGURATION as the current configuration to query." (cdr (assoc configuration (oref this configuration-variables)))) -(cl-defmethod ede-proj-makefile-insert-variables-new ((this ede-proj-project)) +(cl-defmethod ede-proj-makefile-insert-variables-new ((_this ede-proj-project)) "Insert variables needed by target THIS. NOTE: Not yet in use! This is part of an SRecode conversion of @@ -420,7 +422,7 @@ Use CONFIGURATION as the current configuration to query." (cdr (assoc configuration (oref this configuration-variables)))) (cl-defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile) - &optional moresource) + &optional _moresource) "Insert variables needed by target THIS. Optional argument MORESOURCE is a list of additional sources to add to the sources variable." @@ -428,11 +430,11 @@ sources variable." (let* ((proj (ede-target-parent this)) (conf-table (ede-proj-makefile-configuration-variables this (oref proj configuration-default))) - (conf-done nil) + ;; (conf-done nil) ) ;; Add in all variables from the configuration not already covered. (mapc (lambda (c) - (if (member (car c) conf-done) + (if nil ;; (member (car c) conf-done) nil (insert (car c) "=" (cdr c) "\n"))) conf-table)) @@ -449,12 +451,12 @@ sources variable." (ede-proj-makefile-insert-variables linker))))) (cl-defmethod ede-proj-makefile-insert-automake-pre-variables - ((this ede-proj-target)) + ((_this ede-proj-target)) "Insert variables needed by target THIS in Makefile.am before SOURCES." nil) (cl-defmethod ede-proj-makefile-insert-automake-post-variables - ((this ede-proj-target)) + ((_this ede-proj-target)) "Insert variables needed by target THIS in Makefile.am after SOURCES." nil) @@ -464,9 +466,9 @@ sources variable." "Return a list of patterns that are considered garbage to THIS. These are removed with make clean." (let ((mc (ede-map-targets - this (lambda (c) (ede-proj-makefile-garbage-patterns c)))) + this #'ede-proj-makefile-garbage-patterns)) (uniq nil)) - (setq mc (sort (apply 'append mc) 'string<)) + (setq mc (sort (apply #'append mc) #'string<)) ;; Filter out duplicates from the targets. (while mc (if (and (car uniq) (string= (car uniq) (car mc))) @@ -502,16 +504,16 @@ These are removed with make clean." (cl-defmethod ede-proj-makefile-insert-rules ((this ede-proj-project)) "Insert rules needed by THIS target." - (mapc 'ede-proj-makefile-insert-rules (oref this inference-rules)) + (mapc #'ede-proj-makefile-insert-rules (oref this inference-rules)) ) (cl-defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-project)) "Insert any symbols that the DIST rule should depend on. Argument THIS is the project that should insert stuff." - (mapc 'ede-proj-makefile-insert-dist-dependencies (oref this targets)) + (mapc #'ede-proj-makefile-insert-dist-dependencies (oref this targets)) ) -(cl-defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-target)) +(cl-defmethod ede-proj-makefile-insert-dist-dependencies ((_this ede-proj-target)) "Insert any symbols that the DIST rule should depend on. Argument THIS is the target that should insert stuff." nil) @@ -530,7 +532,7 @@ Argument THIS is the target that should insert stuff." (insert " " (ede-subproject-relative-path sproj)) )))) -(cl-defmethod ede-proj-makefile-automake-insert-extradist ((this ede-proj-project)) +(cl-defmethod ede-proj-makefile-automake-insert-extradist ((_this ede-proj-project)) "Insert the EXTRADIST variable entries needed for Automake and EDE." (proj-comp-insert-variable-once "EXTRA_DIST" (insert "Project.ede"))) @@ -602,16 +604,16 @@ Argument THIS is the target that should insert stuff." "\t@false\n\n" "\n\n# End of Makefile\n"))) -(cl-defmethod ede-proj-makefile-insert-rules ((this ede-proj-target)) +(cl-defmethod ede-proj-makefile-insert-rules ((_this ede-proj-target)) "Insert rules needed by THIS target." nil) (cl-defmethod ede-proj-makefile-insert-rules ((this ede-proj-target-makefile)) "Insert rules needed by THIS target." - (mapc 'ede-proj-makefile-insert-rules (oref this rules)) + (mapc #'ede-proj-makefile-insert-rules (oref this rules)) (let ((c (ede-proj-compilers this))) (when c - (mapc 'ede-proj-makefile-insert-rules c) + (mapc #'ede-proj-makefile-insert-rules c) (if (oref this phony) (insert ".PHONY: " (ede-proj-makefile-target-name this) "\n")) (insert (ede-proj-makefile-target-name this) ": " @@ -622,9 +624,9 @@ Argument THIS is the target that should insert stuff." (cl-defmethod ede-proj-makefile-insert-commands ((this ede-proj-target-makefile)) "Insert the commands needed by target THIS. For targets, insert the commands needed by the chosen compiler." - (mapc 'ede-proj-makefile-insert-commands (ede-proj-compilers this)) + (mapc #'ede-proj-makefile-insert-commands (ede-proj-compilers this)) (when (object-assoc t :uselinker (ede-proj-compilers this)) - (mapc 'ede-proj-makefile-insert-commands (ede-proj-linkers this)))) + (mapc #'ede-proj-makefile-insert-commands (ede-proj-linkers this)))) (cl-defmethod ede-proj-makefile-insert-user-rules ((this ede-proj-project)) @@ -632,11 +634,11 @@ For targets, insert the commands needed by the chosen compiler." This is different from `ede-proj-makefile-insert-rules' in that this function won't create the building rules which are auto created with automake." - (mapc 'ede-proj-makefile-insert-user-rules (oref this inference-rules))) + (mapc #'ede-proj-makefile-insert-user-rules (oref this inference-rules))) (cl-defmethod ede-proj-makefile-insert-user-rules ((this ede-proj-target)) "Insert user specified rules needed by THIS target." - (mapc 'ede-proj-makefile-insert-rules (oref this rules))) + (mapc #'ede-proj-makefile-insert-rules (oref this rules))) (cl-defmethod ede-proj-makefile-dependencies ((this ede-proj-target-makefile)) "Return a string representing the dependencies for THIS. @@ -644,7 +646,7 @@ Some compilers only use the first element in the dependencies, others have a list of intermediates (object files), and others don't care. This allows customization of how these elements appear." (let* ((c (ede-proj-compilers this)) - (io (eval (cons 'or (mapcar 'ede-compiler-intermediate-objects-p c)))) + (io (seq-some #'ede-compiler-intermediate-objects-p c)) (out nil)) (if io (progn @@ -652,7 +654,8 @@ This allows customization of how these elements appear." (setq out (concat out "$(" (ede-compiler-intermediate-object-variable (car c) - (ede-proj-makefile-target-name this)) ")") + (ede-proj-makefile-target-name this)) + ")") c (cdr c))) out) (let ((sv (ede-proj-makefile-sourcevar this)) diff --git a/lisp/cedet/ede/proj-archive.el b/lisp/cedet/ede/proj-archive.el index 2b1e50dcea3..9da6374d09c 100644 --- a/lisp/cedet/ede/proj-archive.el +++ b/lisp/cedet/ede/proj-archive.el @@ -1,10 +1,12 @@ -;;; ede/proj-archive.el --- EDE Generic Project archive support +;;; ede/proj-archive.el --- EDE Generic Project archive support -*- lexical-binding: t -*- ;; Copyright (C) 1998-2001, 2009-2021 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: project, make +;; 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 @@ -43,7 +45,7 @@ "Linker object for creating an archive.") (cl-defmethod ede-proj-makefile-insert-source-variables :before - ((this ede-proj-target-makefile-archive) &optional moresource) + ((this ede-proj-target-makefile-archive) &optional _moresource) "Insert bin_PROGRAMS variables needed by target THIS. We aren't actually inserting SOURCE details, but this is used by the Makefile.am generator, so use it to add this important bin program." diff --git a/lisp/cedet/ede/proj-aux.el b/lisp/cedet/ede/proj-aux.el index f5bcebdd4cf..73259558a62 100644 --- a/lisp/cedet/ede/proj-aux.el +++ b/lisp/cedet/ede/proj-aux.el @@ -1,4 +1,4 @@ -;;; ede/proj-aux.el --- EDE Generic Project auxiliary file support +;;; ede/proj-aux.el --- EDE Generic Project auxiliary file support -*- lexical-binding: t -*- ;; Copyright (C) 1998-2000, 2007, 2009-2021 Free Software Foundation, ;; Inc. diff --git a/lisp/cedet/ede/proj-comp.el b/lisp/cedet/ede/proj-comp.el index 26aa66873a3..0d797aa5fb9 100644 --- a/lisp/cedet/ede/proj-comp.el +++ b/lisp/cedet/ede/proj-comp.el @@ -1,4 +1,4 @@ -;;; ede/proj-comp.el --- EDE Generic Project compiler/rule driver +;;; ede/proj-comp.el --- EDE Generic Project compiler/rule driver -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2001, 2004-2005, 2007, 2009-2021 Free Software ;; Foundation, Inc. @@ -172,12 +172,12 @@ Adds this rule to a .PHONY list.")) This is used when creating a Makefile to prevent duplicate variables and rules from being created.") -(cl-defmethod initialize-instance :after ((this ede-compiler) &rest fields) +(cl-defmethod initialize-instance :after ((this ede-compiler) &rest _fields) "Make sure that all ede compiler objects are cached in `ede-compiler-list'." (add-to-list 'ede-compiler-list this)) -(cl-defmethod initialize-instance :after ((this ede-linker) &rest fields) +(cl-defmethod initialize-instance :after ((this ede-linker) &rest _fields) "Make sure that all ede compiler objects are cached in `ede-linker-list'." (add-to-list 'ede-linker-list this)) @@ -185,11 +185,13 @@ rules from being created.") (defmacro ede-compiler-begin-unique (&rest body) "Execute BODY, making sure that `ede-current-build-list' is maintained. This will prevent rules from creating duplicate variables or rules." + (declare (indent 0) (debug t)) `(let ((ede-current-build-list nil)) ,@body)) (defmacro ede-compiler-only-once (object &rest body) "Using OBJECT, execute BODY only once per Makefile generation." + (declare (indent 1) (debug t)) `(if (not (member ,object ede-current-build-list)) (progn (add-to-list 'ede-current-build-list ,object) @@ -198,25 +200,18 @@ This will prevent rules from creating duplicate variables or rules." (defmacro ede-linker-begin-unique (&rest body) "Execute BODY, making sure that `ede-current-build-list' is maintained. This will prevent rules from creating duplicate variables or rules." + (declare (indent 0) (debug t)) `(let ((ede-current-build-list nil)) ,@body)) (defmacro ede-linker-only-once (object &rest body) "Using OBJECT, execute BODY only once per Makefile generation." + (declare (indent 1) (debug t)) `(if (not (member ,object ede-current-build-list)) (progn (add-to-list 'ede-current-build-list ,object) ,@body))) -(add-hook 'edebug-setup-hook - (lambda () - (def-edebug-spec ede-compiler-begin-unique def-body) - (def-edebug-spec ede-compiler-only-once (form def-body)) - (def-edebug-spec ede-linker-begin-unique def-body) - (def-edebug-spec ede-linker-only-once (form def-body)) - (def-edebug-spec ede-pmake-insert-variable-shared (form def-body)) - )) - ;;; Queries (defun ede-proj-find-compiler (compilers sourcetype) "Return a compiler from the list COMPILERS that will compile SOURCETYPE." @@ -246,21 +241,20 @@ This will prevent rules from creating duplicate variables or rules." ) (oref this autoconf))) -(cl-defmethod ede-proj-flush-autoconf ((this ede-compilation-program)) +(cl-defmethod ede-proj-flush-autoconf ((_this ede-compilation-program)) "Flush the configure file (current buffer) to accommodate THIS." nil) (defmacro proj-comp-insert-variable-once (varname &rest body) "Add VARNAME into the current Makefile if it doesn't exist. Execute BODY in a location where a value can be placed." - `(let ((addcr t) (v ,varname)) + (declare (indent 1) (debug (sexp body))) + `(let ((v ,varname)) (unless (re-search-backward (concat "^" v "\\s-*=") nil t) (insert v "=") ,@body - (if addcr (insert "\n")) - (goto-char (point-max))) - )) -(put 'proj-comp-insert-variable-once 'lisp-indent-function 1) + (insert "\n") + (goto-char (point-max))))) (cl-defmethod ede-proj-makefile-insert-variables ((this ede-compilation-program)) "Insert variables needed by the compiler THIS." @@ -281,8 +275,8 @@ If this compiler creates code that can be linked together, then the object files created by the compiler are considered intermediate." (oref this uselinker)) -(cl-defmethod ede-compiler-intermediate-object-variable ((this ede-compiler) - targetname) +(cl-defmethod ede-compiler-intermediate-object-variable ((_this ede-compiler) + targetname) "Return a string based on THIS representing a make object variable. TARGETNAME is the name of the target that these objects belong to." (concat targetname "_OBJ")) @@ -314,7 +308,7 @@ Not all compilers do this." (cl-defmethod ede-proj-makefile-insert-rules ((this ede-compilation-program)) "Insert rules needed for THIS compiler object." (ede-compiler-only-once this - (mapc 'ede-proj-makefile-insert-rules (oref this rules)))) + (mapc #'ede-proj-makefile-insert-rules (oref this rules)))) (cl-defmethod ede-proj-makefile-insert-rules ((this ede-makefile-rule)) "Insert rules needed for THIS rule object." @@ -343,16 +337,6 @@ compiler it decides to use after inserting in the rule." commands)) (insert "\n"))) -;;; Some details about our new macro -;; -(add-hook 'edebug-setup-hook - (lambda () - (def-edebug-spec ede-compiler-begin-unique def-body))) -(put 'ede-compiler-begin-unique 'lisp-indent-function 0) -(put 'ede-compiler-only-once 'lisp-indent-function 1) -(put 'ede-linker-begin-unique 'lisp-indent-function 0) -(put 'ede-linker-only-once 'lisp-indent-function 1) - (provide 'ede/proj-comp) ;;; ede/proj-comp.el ends here diff --git a/lisp/cedet/ede/proj-elisp.el b/lisp/cedet/ede/proj-elisp.el index 9ec96945c10..7e0f5a89346 100644 --- a/lisp/cedet/ede/proj-elisp.el +++ b/lisp/cedet/ede/proj-elisp.el @@ -1,4 +1,4 @@ -;;; ede-proj-elisp.el --- EDE Generic Project Emacs Lisp support +;;; ede-proj-elisp.el --- EDE Generic Project Emacs Lisp support -*- lexical-binding: t; -*- ;; Copyright (C) 1998-2005, 2007-2021 Free Software Foundation, Inc. @@ -64,7 +64,7 @@ This inserts the PRELOADS target-local variable." (when preloads (insert (format "%s: PRELOADS=%s\n" (oref this name) - (mapconcat 'identity preloads " "))))) + (mapconcat #'identity preloads " "))))) (insert "\n")) (cl-defmethod ede-proj-makefile-dependencies ((this ede-proj-target-elisp)) @@ -152,7 +152,7 @@ Bonus: Return a cons cell: (COMPILED . UPTODATE)." (utd 0)) (mapc (lambda (src) (let* ((fsrc (expand-file-name src dir)) - (elc (concat (file-name-sans-extension fsrc) ".elc"))) + ) ;; (elc (concat (file-name-sans-extension fsrc) ".elc")) (with-no-warnings (if (eq (byte-recompile-file fsrc nil 0) t) (setq comp (1+ comp)) @@ -169,7 +169,7 @@ is found, such as a `-version' variable, or the standard header." (if (and (slot-boundp this 'versionsource) (oref this versionsource)) (let ((vs (oref this versionsource)) - (match nil)) + ) ;; (match nil) (while vs (with-current-buffer (find-file-noselect (ede-expand-filename this (car vs))) @@ -177,7 +177,7 @@ is found, such as a `-version' variable, or the standard header." (let ((case-fold-search t)) (if (re-search-forward "-version\\s-+\"\\([^\"]+\\)\"" nil t) (progn - (setq match t) + ;; (setq match t) (delete-region (match-beginning 1) (match-end 1)) (goto-char (match-beginning 1)) @@ -331,27 +331,27 @@ Lays claim to all .elc files that match .el files in this target." If the `compiler' slot is empty, get the car of the compilers list." (let ((comp (oref obj compiler))) (if comp - (if (listp comp) - (setq comp (mapcar 'symbol-value comp)) - (setq comp (list (symbol-value comp)))) + (setq comp (if (listp comp) + (mapcar #'symbol-value comp) + (list (symbol-value comp)))) ;; Get the first element from our list of compilers. - (let ((avail (mapcar 'symbol-value (oref obj availablecompilers)))) + (let ((avail (mapcar #'symbol-value (oref obj availablecompilers)))) (setq comp (list (car avail))))) comp)) -(cl-defmethod ede-proj-makefile-insert-source-variables ((this ede-proj-target-elisp-autoloads) - &optional - moresource) +(cl-defmethod ede-proj-makefile-insert-source-variables ((_this ede-proj-target-elisp-autoloads) + &optional + _moresource) "Insert the source variables needed by THIS. Optional argument MORESOURCE is a list of additional sources to add to the sources variable." nil) -(cl-defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-elisp-autoloads)) +(cl-defmethod ede-proj-makefile-sourcevar ((_this ede-proj-target-elisp-autoloads)) "Return the variable name for THIS's sources." nil) ; "LOADDEFS") -(cl-defmethod ede-proj-makefile-dependencies ((this ede-proj-target-elisp-autoloads)) +(cl-defmethod ede-proj-makefile-dependencies ((_this ede-proj-target-elisp-autoloads)) "Return a string representing the dependencies for THIS. Always return an empty string for an autoloads generator." "") @@ -361,21 +361,22 @@ Always return an empty string for an autoloads generator." (ede-pmake-insert-variable-shared "LOADDEFS" (insert (oref this autoload-file))) (ede-pmake-insert-variable-shared "LOADDIRS" - (insert (mapconcat 'identity + (insert (mapconcat #'identity (or (oref this autoload-dirs) '(".")) " "))) ) (cl-defmethod project-compile-target ((obj ede-proj-target-elisp-autoloads)) "Create or update the autoload target." - (require 'cedet-autogen) + (require 'cedet-autogen) ;FIXME: We don't have this file! + (declare-function cedet-update-autoloads "cedet-autogen") (let ((default-directory (ede-expand-filename obj "."))) - (apply 'cedet-update-autoloads + (apply #'cedet-update-autoloads (oref obj autoload-file) (oref obj autoload-dirs)) )) -(cl-defmethod ede-update-version-in-source ((this ede-proj-target-elisp-autoloads) version) +(cl-defmethod ede-update-version-in-source ((_this ede-proj-target-elisp-autoloads) _version) "In a Lisp file, updated a version string for THIS to VERSION. There are standards in Elisp files specifying how the version string is found, such as a `-version' variable, or the standard header." @@ -397,11 +398,11 @@ Argument THIS is the target which needs to insert an info file." (insert " " (oref this autoload-file)) ) -(cl-defmethod ede-proj-tweak-autoconf ((this ede-proj-target-elisp-autoloads)) +(cl-defmethod ede-proj-tweak-autoconf ((_this ede-proj-target-elisp-autoloads)) "Tweak the configure file (current buffer) to accommodate THIS." (error "Autoloads not supported in autoconf yet")) -(cl-defmethod ede-proj-flush-autoconf ((this ede-proj-target-elisp-autoloads)) +(cl-defmethod ede-proj-flush-autoconf ((_this ede-proj-target-elisp-autoloads)) "Flush the configure file (current buffer) to accommodate THIS." nil) diff --git a/lisp/cedet/ede/proj-info.el b/lisp/cedet/ede/proj-info.el index 3d437016e93..dbb86edb217 100644 --- a/lisp/cedet/ede/proj-info.el +++ b/lisp/cedet/ede/proj-info.el @@ -1,7 +1,6 @@ -;;; ede-proj-info.el --- EDE Generic Project texinfo support +;;; ede-proj-info.el --- EDE Generic Project texinfo support -*- lexical-binding: t; -*- -;;; Copyright (C) 1998-2001, 2004, 2007-2021 Free Software Foundation, -;;; Inc. +;; Copyright (C) 1998-2021 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: project, make @@ -70,7 +69,7 @@ All other sources should be included independently.")) ;;; Makefile generation ;; (cl-defmethod ede-proj-configure-add-missing - ((this ede-proj-target-makefile-info)) + ((_this ede-proj-target-makefile-info)) "Query if any files needed by THIS provided by automake are missing. Results in --add-missing being passed to automake." (not (ede-expand-filename (ede-toplevel) "texinfo.tex"))) @@ -97,7 +96,7 @@ when working in Automake mode." (insert menu)) ;; Now insert the rest of the source elsewhere (ede-pmake-insert-variable-shared sv - (insert (mapconcat 'identity src " "))) + (insert (mapconcat #'identity src " "))) (if moresource (error "Texinfo files should not have moresource"))))) diff --git a/lisp/cedet/ede/proj-misc.el b/lisp/cedet/ede/proj-misc.el index 70132aff6c3..068e998d1a1 100644 --- a/lisp/cedet/ede/proj-misc.el +++ b/lisp/cedet/ede/proj-misc.el @@ -1,4 +1,4 @@ -;;; ede-proj-misc.el --- EDE Generic Project Emacs Lisp support +;;; ede-proj-misc.el --- EDE Generic Project Emacs Lisp support -*- lexical-binding: t -*- ;; Copyright (C) 1998-2001, 2008-2021 Free Software Foundation, Inc. diff --git a/lisp/cedet/ede/proj-obj.el b/lisp/cedet/ede/proj-obj.el index 3aa4497f932..1b96376d3eb 100644 --- a/lisp/cedet/ede/proj-obj.el +++ b/lisp/cedet/ede/proj-obj.el @@ -1,7 +1,6 @@ -;;; ede/proj-obj.el --- EDE Generic Project Object code generation support +;;; ede/proj-obj.el --- EDE Generic Project Object code generation support -*- lexical-binding: t; -*- -;;; Copyright (C) 1998-2000, 2005, 2008-2021 Free Software Foundation, -;;; Inc. +;; Copyright (C) 1998-2021 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: project, make @@ -35,8 +34,8 @@ ;;; Code: (defclass ede-proj-target-makefile-objectcode (ede-proj-target-makefile) (;; Give this a new default - (configuration-variables :initform ("debug" . (("CFLAGS" . "-g") - ("LDFLAGS" . "-g")))) + (configuration-variables :initform '("debug" . (("CFLAGS" . "-g") + ("LDFLAGS" . "-g")))) ;; @TODO - add an include path. (availablecompilers :initform '(ede-gcc-compiler ede-g++-compiler @@ -282,15 +281,15 @@ Argument THIS is the target to get sources from." (append (oref this source) (oref this auxsource))) (cl-defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile-objectcode) - &optional moresource) + &optional _moresource) "Insert variables needed by target THIS. Optional argument MORESOURCE is not used." (let ((ede-proj-objectcode-dodependencies (oref (ede-target-parent this) automatic-dependencies))) (cl-call-next-method))) -(cl-defmethod ede-buffer-header-file((this ede-proj-target-makefile-objectcode) - buffer) +(cl-defmethod ede-buffer-header-file ((this ede-proj-target-makefile-objectcode) + _buffer) "There are no default header files." (or (cl-call-next-method) ;; Ok, nothing obvious. Try looking in ourselves. diff --git a/lisp/cedet/ede/proj-prog.el b/lisp/cedet/ede/proj-prog.el index 3817cd7d40e..87b2ff7a551 100644 --- a/lisp/cedet/ede/proj-prog.el +++ b/lisp/cedet/ede/proj-prog.el @@ -1,4 +1,4 @@ -;;; ede-proj-prog.el --- EDE Generic Project program support +;;; ede-proj-prog.el --- EDE Generic Project program support -*- lexical-binding: t; -*- ;; Copyright (C) 1998-2001, 2005, 2008-2021 Free Software Foundation, ;; Inc. @@ -90,11 +90,11 @@ Note: Currently only used for Automake projects." (cl-defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile-program)) "Insert variables needed by the compiler THIS." (cl-call-next-method) - (let ((lf (mapconcat 'identity (oref this ldflags) " "))) + (let ((lf (mapconcat #'identity (oref this ldflags) " "))) (with-slots (ldlibs) this (if ldlibs (setq lf - (concat lf " -l" (mapconcat 'identity ldlibs " -l"))))) + (concat lf " -l" (mapconcat #'identity ldlibs " -l"))))) ;; LDFLAGS as needed. (when (and lf (not (string= "" lf))) (ede-pmake-insert-variable-once "LDDEPS" (insert lf))))) diff --git a/lisp/cedet/ede/proj-scheme.el b/lisp/cedet/ede/proj-scheme.el index 51844af5361..b0e287895f3 100644 --- a/lisp/cedet/ede/proj-scheme.el +++ b/lisp/cedet/ede/proj-scheme.el @@ -1,4 +1,4 @@ -;;; ede/proj-scheme.el --- EDE Generic Project scheme (guile) support +;;; ede/proj-scheme.el --- EDE Generic Project scheme (guile) support -*- lexical-binding: t -*- ;; Copyright (C) 1998-2000, 2009-2021 Free Software Foundation, Inc. @@ -40,7 +40,7 @@ ) "This target consists of scheme files.") -(cl-defmethod ede-proj-tweak-autoconf ((this ede-proj-target-scheme)) +(cl-defmethod ede-proj-tweak-autoconf ((_this ede-proj-target-scheme)) "Tweak the configure file (current buffer) to accommodate THIS." (autoconf-insert-new-macro "AM_INIT_GUILE_MODULE")) diff --git a/lisp/cedet/ede/proj-shared.el b/lisp/cedet/ede/proj-shared.el index 130d7b897aa..01f19bc6572 100644 --- a/lisp/cedet/ede/proj-shared.el +++ b/lisp/cedet/ede/proj-shared.el @@ -1,6 +1,6 @@ -;;; ede-proj-shared.el --- EDE Generic Project shared library support +;;; ede-proj-shared.el --- EDE Generic Project shared library support -*- lexical-binding: t; -*- -;;; Copyright (C) 1998-2000, 2009-2021 Free Software Foundation, Inc. +;; Copyright (C) 1998-2021 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: project, make @@ -170,7 +170,7 @@ Use ldlibs to add addition libraries.") ) (cl-defmethod ede-proj-configure-add-missing - ((this ede-proj-target-makefile-shared-object)) + ((_this ede-proj-target-makefile-shared-object)) "Query if any files needed by THIS provided by automake are missing. Results in --add-missing being passed to automake." (not (and (ede-expand-filename (ede-toplevel) "ltconfig") @@ -185,7 +185,7 @@ Makefile.am generator, so use it to add this important bin program." (insert (concat "lib" (ede-name this) ".la")))) (cl-defmethod ede-proj-makefile-insert-automake-post-variables - ((this ede-proj-target-makefile-shared-object)) + ((_this ede-proj-target-makefile-shared-object)) "Insert bin_PROGRAMS variables needed by target THIS. We need to override -program which has an LDADD element." nil) diff --git a/lisp/cedet/ede/proj.el b/lisp/cedet/ede/proj.el index 4af8b4104f5..c8c34d092f1 100644 --- a/lisp/cedet/ede/proj.el +++ b/lisp/cedet/ede/proj.el @@ -1,4 +1,4 @@ -;;; ede/proj.el --- EDE Generic Project file driver +;;; ede/proj.el --- EDE Generic Project file driver -*- lexical-binding: t; -*- ;; Copyright (C) 1998-2003, 2007-2021 Free Software Foundation, Inc. @@ -220,7 +220,7 @@ This enables the creation of your target type." ((extension :initform ".ede") (file-header-line :initform ";; EDE Project Files are auto generated: Do Not Edit") (makefile-type :initarg :makefile-type - :initform Makefile + :initform 'Makefile :type symbol :custom (choice (const Makefile) ;(const Makefile.in) @@ -240,7 +240,7 @@ in targets.") :documentation "Variables to set in this Makefile.") (configuration-variables :initarg :configuration-variables - :initform ("debug" (("DEBUG" . "1"))) + :initform '("debug" (("DEBUG" . "1"))) :type list :custom (repeat (cons (string :tag "Configuration") (repeat @@ -269,10 +269,10 @@ These files can contain additional rules, variables, and customizations.") :documentation "Non-nil to do implement automatic dependencies in the Makefile.") (menu :initform - ( - [ "Regenerate Makefiles" ede-proj-regenerate t ] - [ "Upload Distribution" ede-upload-distribution t ] - ) + '( + [ "Regenerate Makefiles" ede-proj-regenerate t ] + [ "Upload Distribution" ede-upload-distribution t ] + ) ) (metasubproject :initarg :metasubproject @@ -339,7 +339,7 @@ Argument PROJ is the project to save." (cl-call-next-method) (ede-proj-save proj)) -(cl-defmethod eieio-done-customizing ((target ede-proj-target)) +(cl-defmethod eieio-done-customizing ((_target ede-proj-target)) "Call this when a user finishes customizing this object. Argument TARGET is the project we are completing customization on." (cl-call-next-method) @@ -462,7 +462,7 @@ FILE must be massaged by `ede-convert-path'." (object-remove-from-list target 'auxsource (ede-convert-path target file)) (ede-proj-save)) -(cl-defmethod project-update-version ((this ede-proj-project)) +(cl-defmethod project-update-version ((_this ede-proj-project)) "The :version of project THIS has changed." (ede-proj-save)) @@ -486,7 +486,7 @@ FILE must be massaged by `ede-convert-path'." (concat (oref this name) "-" (oref this version) ".tar.gz") )) -(cl-defmethod project-compile-project ((proj ede-proj-project) &optional command) +(cl-defmethod project-compile-project ((proj ede-proj-project) &optional _command) "Compile the entire current project PROJ. Argument COMMAND is the command to use when compiling." (let ((pm (ede-proj-dist-makefile proj)) @@ -499,13 +499,13 @@ Argument COMMAND is the command to use when compiling." ;;; Target type specific compilations/debug ;; -(cl-defmethod project-compile-target ((obj ede-proj-target) &optional command) +(cl-defmethod project-compile-target ((_obj ede-proj-target) &optional command) "Compile the current target OBJ. Argument COMMAND is the command to use for compiling the target." (project-compile-project (ede-current-project) command)) (cl-defmethod project-compile-target ((obj ede-proj-target-makefile) - &optional command) + &optional _command) "Compile the current target program OBJ. Optional argument COMMAND is the s the alternate command to use." (ede-proj-setup-buildenvironment (ede-current-project)) @@ -545,11 +545,11 @@ Converts all symbols into the objects to be used." (if comp ;; Now that we have a pre-set compilers to use, convert tye symbols ;; into objects for ease of use - (if (listp comp) - (setq comp (mapcar 'symbol-value comp)) - (setq comp (list (symbol-value comp)))) + (setq comp (if (listp comp) + (mapcar #'symbol-value comp) + (list (symbol-value comp)))) (let* ((acomp (oref obj availablecompilers)) - (avail (mapcar 'symbol-value acomp)) + (avail (mapcar #'symbol-value acomp)) (st (oref obj sourcetype)) (sources (oref obj source))) ;; COMP is not specified, so generate a list from the available @@ -585,7 +585,7 @@ Converts all symbols into the objects to be used." (setq link (list (symbol-value link))) (error ":linker is not a symbol. Howd you do that?")) (let* ((alink (oref obj availablelinkers)) - (avail (mapcar 'symbol-value alink)) + (avail (mapcar #'symbol-value alink)) (st (oref obj sourcetype)) (sources (oref obj source))) ;; LINKER is not specified, so generate a list from the available diff --git a/lisp/cedet/ede/project-am.el b/lisp/cedet/ede/project-am.el index 061d1b540b0..258917f01b9 100644 --- a/lisp/cedet/ede/project-am.el +++ b/lisp/cedet/ede/project-am.el @@ -1,4 +1,4 @@ -;;; project-am.el --- A project management scheme based on automake files. +;;; project-am.el --- A project management scheme based on automake files. -*- lexical-binding: t; -*- ;; Copyright (C) 1998-2000, 2003, 2005, 2007-2021 Free Software ;; Foundation, Inc. @@ -54,17 +54,14 @@ (defcustom project-am-compile-project-command nil "Default command used to compile a project." - :group 'project-am :type '(choice (const nil) string)) (defcustom project-am-compile-target-command (concat ede-make-command " -k %s") "Default command used to compile a project." - :group 'project-am :type 'string) (defcustom project-am-debug-target-function 'gdb "Default Emacs command used to debug a target." - :group 'project-am :type 'function) ; make this be a list some day (defconst project-am-type-alist @@ -240,8 +237,8 @@ OT is the object target. DIR is the directory to start in." (if (= (point-min) (point)) (re-search-forward (ede-target-name obj)))) -(cl-defmethod project-new-target ((proj project-am-makefile) - &optional name type) +(cl-defmethod project-new-target ((_proj project-am-makefile) + &optional name type) "Create a new target named NAME. Argument TYPE is the type of target to insert. This is a string matching something in `project-am-type-alist' or type class symbol. @@ -300,7 +297,7 @@ buffer being in order to provide a smart default target type." ;; This should be handled at the EDE level, calling a method of the ;; top most project. ;; -(cl-defmethod project-compile-project ((obj project-am-target) &optional command) +(cl-defmethod project-compile-project ((_obj project-am-target) &optional command) "Compile the entire current project. Argument COMMAND is the command to use when compiling." (require 'compile) @@ -324,7 +321,7 @@ Argument COMMAND is the command to use when compiling." (let* ((default-directory (project-am-find-topmost-level default-directory))) (compile command))) -(cl-defmethod project-compile-project ((obj project-am-makefile) +(cl-defmethod project-compile-project ((_obj project-am-makefile) &optional command) "Compile the entire current project. Argument COMMAND is the command to use when compiling." @@ -349,7 +346,7 @@ Argument COMMAND is the command to use when compiling." (let* ((default-directory (project-am-find-topmost-level default-directory))) (compile command))) -(cl-defmethod project-compile-target ((obj project-am-target) &optional command) +(cl-defmethod project-compile-target ((_obj project-am-target) &optional command) "Compile the current target. Argument COMMAND is the command to use for compiling the target." (require 'compile) @@ -423,7 +420,7 @@ Argument COMMAND is the command to use for compiling the target." ;;; Project loading and saving ;; -(defun project-am-load (directory &optional rootproj) +(defun project-am-load (directory &optional _rootproj) "Read an automakefile DIRECTORY into our data structure. If a given set of projects has already been loaded, then do nothing but return the project for the directory given. @@ -442,34 +439,28 @@ Optional ROOTPROJ is the root EDE project." (file-name-directory (directory-file-name newdir)))) (expand-file-name dir))) +(defvar recentf-exclude) + (defmacro project-am-with-makefile-current (dir &rest forms) "Set the Makefile.am in DIR to be the current buffer. -Run FORMS while the makefile is current. -Kill the makefile if it was not loaded before the load." - `(let* ((fn (expand-file-name "Makefile.am" ,dir)) - (fb nil) - (kb (get-file-buffer fn))) - (if (not (file-exists-p fn)) - nil - (save-excursion - (if kb (setq fb kb) - ;; We need to find-file this thing, but don't use - ;; any semantic features. - (let ((semantic-init-hook nil) - (recentf-exclude '( (lambda (f) t) )) - ) - (setq fb (find-file-noselect fn))) - ) - (set-buffer fb) - (prog1 ,@forms - (if (not kb) (kill-buffer (current-buffer)))))))) -(put 'project-am-with-makefile-current 'lisp-indent-function 1) - -(add-hook 'edebug-setup-hook - (lambda () - (def-edebug-spec project-am-with-makefile-current - (form def-body)))) - +Run FORMS while the makefile is current." + (declare (indent 1) (debug (form def-body))) + `(project-am--with-makefile-current ,dir (lambda () ,@forms))) + +(defun project-am--with-makefile-current (dir fun) + (let* ((fn (expand-file-name "Makefile.am" dir)) + (kb (get-file-buffer fn))) + (if (not (file-exists-p fn)) + nil + (with-current-buffer + (or kb + ;; We need to find-file this thing, but don't use + ;; any semantic features. + (let ((semantic-init-hook nil) + (recentf-exclude `(,(lambda (_f) t)))) + (find-file-noselect fn))) + (unwind-protect (funcall fun) + (if (not kb) (kill-buffer (current-buffer)))))))) (defun project-am-load-makefile (path &optional suggestedname) "Convert PATH into a project Makefile, and return its project object. @@ -480,6 +471,7 @@ This is used when subprojects are made in named subdirectories." (if (and ede-object (project-am-makefile-p ede-object)) ede-object (let* ((pi (project-am-package-info path)) + (fn buffer-file-name) (sfn (when suggestedname (project-am-last-dir suggestedname))) (pn (or sfn (nth 0 pi) (project-am-last-dir fn))) @@ -604,10 +596,8 @@ Strip out duplicates, and recurse on variables." (project-am-expand-subdirlist place (makefile-macro-file-list var)) ;; Else, add SP in if it isn't a dup. - (if (member sp (symbol-value place)) - nil ; don't do it twice. - (set place (cons sp (symbol-value place))) ;; add - )))) + (cl-pushnew sp (gv-deref place) :test #'equal) ;; add + ))) subdirs) ) @@ -653,7 +643,7 @@ Strip out duplicates, and recurse on variables." ;; We still have a list of targets. For all buffers, make sure ;; their object still exists! ;; FIGURE THIS OUT - (project-am-expand-subdirlist 'csubprojexpanded csubproj) + (project-am-expand-subdirlist (gv-ref csubprojexpanded) csubproj) ;; Ok, now let's look at all our sub-projects. (mapc (lambda (sp) (let* ((subdir (file-name-as-directory @@ -734,19 +724,19 @@ Strip out duplicates, and recurse on variables." "Return the default macro to `edit' for this object type." (concat (subst-char-in-string ?- ?_ (oref this name)) "_SOURCES")) -(cl-defmethod project-am-macro ((this project-am-header-noinst)) +(cl-defmethod project-am-macro ((_this project-am-header-noinst)) "Return the default macro to `edit' for this object." "noinst_HEADERS") -(cl-defmethod project-am-macro ((this project-am-header-inst)) +(cl-defmethod project-am-macro ((_this project-am-header-inst)) "Return the default macro to `edit' for this object." "include_HEADERS") -(cl-defmethod project-am-macro ((this project-am-header-pkg)) +(cl-defmethod project-am-macro ((_this project-am-header-pkg)) "Return the default macro to `edit' for this object." "pkginclude_HEADERS") -(cl-defmethod project-am-macro ((this project-am-header-chk)) +(cl-defmethod project-am-macro ((_this project-am-header-chk)) "Return the default macro to `edit' for this object." "check_HEADERS") @@ -758,7 +748,7 @@ Strip out duplicates, and recurse on variables." "Return the default macro to `edit' for this object type." (oref this name)) -(cl-defmethod project-am-macro ((this project-am-lisp)) +(cl-defmethod project-am-macro ((_this project-am-lisp)) "Return the default macro to `edit' for this object." "lisp_LISP") @@ -785,13 +775,11 @@ nil means that this buffer belongs to no-one." "Return t if object THIS lays claim to the file in BUFFER." (let ((efn (expand-file-name (buffer-file-name buffer)))) (or (string= (oref this file) efn) - (string-match "/configure\\.ac$" efn) - (string-match "/configure\\.in$" efn) - (string-match "/configure$" efn) + (string-match "/configure\\(?:\\.ac\\|\\.in\\)?\\'" efn) ;; Search output files. (let ((ans nil)) (dolist (f (oref this configureoutputfiles)) - (when (string-match (concat (regexp-quote f) "$") efn) + (when (string-match (concat (regexp-quote f) "\\'") efn) (setq ans t))) ans) ))) @@ -822,7 +810,7 @@ nil means that this buffer belongs to no-one." "Return the sub project in AMPF specified by SUBDIR." (object-assoc (expand-file-name subdir) 'file (oref ampf subproj))) -(cl-defmethod project-compile-target-command ((this project-am-target)) +(cl-defmethod project-compile-target-command ((_this project-am-target)) "Default target to use when compiling a given target." ;; This is a pretty good default for most. "") @@ -861,7 +849,7 @@ Argument FILE is the file to extract the end directory name from." (t 'project-am-program))) -(cl-defmethod ede-buffer-header-file((this project-am-objectcode) buffer) +(cl-defmethod ede-buffer-header-file((this project-am-objectcode) _buffer) "There are no default header files." (or (cl-call-next-method) (let ((s (oref this source)) @@ -910,22 +898,13 @@ files in the project." "Set the Configure FILE in the top most directory above DIR as current. Run FORMS in the configure file. Kill the Configure buffer if it was not already in a buffer." - `(save-excursion - (let ((fb (generate-new-buffer ,file))) - (set-buffer fb) - (erase-buffer) - (insert-file-contents ,file) - (prog1 ,@forms - (kill-buffer fb))))) - -(put 'project-am-with-config-current 'lisp-indent-function 1) - -(add-hook 'edebug-setup-hook - (lambda () - (def-edebug-spec project-am-with-config-current - (form def-body)))) - -(defmacro project-am-extract-shell-variable (var) + (declare (indent 1) (debug t)) + `(with-temp-buffer + (erase-buffer) + (insert-file-contents ,file) + ,@forms)) + +(defun project-am-extract-shell-variable (var) "Extract the value of the shell variable VAR from a shell script." (save-excursion (goto-char (point-min)) @@ -997,12 +976,12 @@ Calculates the info with `project-am-extract-package-info'." (project-am-extract-package-info dir))) ;; for simple per project include path extension -(cl-defmethod ede-system-include-path ((this project-am-makefile)) +(cl-defmethod ede-system-include-path ((_this project-am-makefile)) "Return `project-am-localvars-include-path', usually local variable per file or in .dir-locals.el or similar." (bound-and-true-p project-am-localvars-include-path)) -(cl-defmethod ede-system-include-path ((this project-am-target)) +(cl-defmethod ede-system-include-path ((_this project-am-target)) "Return `project-am-localvars-include-path', usually local variable per file or in .dir-locals.el or similar." (bound-and-true-p project-am-localvars-include-path)) diff --git a/lisp/cedet/ede/shell.el b/lisp/cedet/ede/shell.el index ba36fccd0ba..371b04f9d29 100644 --- a/lisp/cedet/ede/shell.el +++ b/lisp/cedet/ede/shell.el @@ -1,4 +1,4 @@ -;;; ede/shell.el --- A shell controlled by EDE. +;;; ede/shell.el --- A shell controlled by EDE. -*- lexical-binding: t; -*- ;; ;; Copyright (C) 2009-2021 Free Software Foundation, Inc. ;; diff --git a/lisp/cedet/ede/simple.el b/lisp/cedet/ede/simple.el index ea6162ef94f..aaeb3f713c9 100644 --- a/lisp/cedet/ede/simple.el +++ b/lisp/cedet/ede/simple.el @@ -1,4 +1,4 @@ -;;; ede/simple.el --- Overlay an EDE structure on an existing project +;;; ede/simple.el --- Overlay an EDE structure on an existing project -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. @@ -78,7 +78,7 @@ The directory has three parts: ede-simple-save-file-name) )) -(defun ede-simple-load (dir &optional rootproj) +(defun ede-simple-load (dir &optional _rootproj) "Load a project of type `Simple' for the directory DIR. Return nil if there isn't one. ROOTPROJ is nil, since we will only create a single EDE project here." @@ -112,7 +112,7 @@ Each directory needs a project file to control it.") (eieio-persistent-save proj)) (cl-defmethod ede-find-subproject-for-directory ((proj ede-simple-project) - dir) + _dir) "Return PROJ, for handling all subdirs below DIR." proj) diff --git a/lisp/cedet/ede/source.el b/lisp/cedet/ede/source.el index abdb07f2d73..5dbad4fcc00 100644 --- a/lisp/cedet/ede/source.el +++ b/lisp/cedet/ede/source.el @@ -1,4 +1,4 @@ -;; ede/source.el --- EDE source code object +;; ede/source.el --- EDE source code object -*- lexical-binding: t; -*- ;; Copyright (C) 2000, 2008-2021 Free Software Foundation, Inc. @@ -72,7 +72,7 @@ that they are willing to use.") ;;; Methods ;; -(cl-defmethod initialize-instance :after ((this ede-sourcecode) &rest fields) +(cl-defmethod initialize-instance :after ((this ede-sourcecode) &rest _fields) "Make sure that all ede compiler objects are cached in `ede-compiler-list'." (let ((lst ede-sourcecode-list)) diff --git a/lisp/cedet/ede/speedbar.el b/lisp/cedet/ede/speedbar.el index 48c4a89c440..b321cb637bc 100644 --- a/lisp/cedet/ede/speedbar.el +++ b/lisp/cedet/ede/speedbar.el @@ -1,4 +1,4 @@ -;;; ede/speedbar.el --- Speedbar viewing of EDE projects +;;; ede/speedbar.el --- Speedbar viewing of EDE projects -*- lexical-binding: t; -*- ;; Copyright (C) 1998-2001, 2003, 2005, 2007-2021 Free Software ;; Foundation, Inc. @@ -42,21 +42,21 @@ (setq ede-speedbar-key-map (speedbar-make-specialized-keymap)) ;; General viewing things - (define-key ede-speedbar-key-map "\C-m" 'speedbar-edit-line) - (define-key ede-speedbar-key-map "+" 'speedbar-expand-line) - (define-key ede-speedbar-key-map "=" 'speedbar-expand-line) - (define-key ede-speedbar-key-map "-" 'speedbar-contract-line) - (define-key ede-speedbar-key-map " " 'speedbar-toggle-line-expansion) + (define-key ede-speedbar-key-map "\C-m" #'speedbar-edit-line) + (define-key ede-speedbar-key-map "+" #'speedbar-expand-line) + (define-key ede-speedbar-key-map "=" #'speedbar-expand-line) + (define-key ede-speedbar-key-map "-" #'speedbar-contract-line) + (define-key ede-speedbar-key-map " " #'speedbar-toggle-line-expansion) ;; Some object based things - (define-key ede-speedbar-key-map "C" 'eieio-speedbar-customize-line) + (define-key ede-speedbar-key-map "C" #'eieio-speedbar-customize-line) ;; Some project based things - (define-key ede-speedbar-key-map "R" 'ede-speedbar-remove-file-from-target) - (define-key ede-speedbar-key-map "b" 'ede-speedbar-compile-line) - (define-key ede-speedbar-key-map "B" 'ede-speedbar-compile-project) - (define-key ede-speedbar-key-map "D" 'ede-speedbar-make-distribution) - (define-key ede-speedbar-key-map "E" 'ede-speedbar-edit-projectfile) + (define-key ede-speedbar-key-map "R" #'ede-speedbar-remove-file-from-target) + (define-key ede-speedbar-key-map "b" #'ede-speedbar-compile-line) + (define-key ede-speedbar-key-map "B" #'ede-speedbar-compile-project) + (define-key ede-speedbar-key-map "D" #'ede-speedbar-make-distribution) + (define-key ede-speedbar-key-map "E" #'ede-speedbar-edit-projectfile) ) (defvar ede-speedbar-menu @@ -98,7 +98,7 @@ (speedbar-get-focus) ) -(defun ede-speedbar-toplevel-buttons (dir) +(defun ede-speedbar-toplevel-buttons (_dir) "Return a list of objects to display in speedbar. Argument DIR is the directory from which to derive the list of objects." ede-projects @@ -180,13 +180,13 @@ Argument DIR is the directory from which to derive the list of objects." (setq depth (1- depth))) (speedbar-line-token)))) -(cl-defmethod eieio-speedbar-derive-line-path ((obj ede-project) &optional depth) +(cl-defmethod eieio-speedbar-derive-line-path ((obj ede-project) &optional _depth) "Return the path to OBJ. Optional DEPTH is the depth we start at." (file-name-directory (oref obj file)) ) -(cl-defmethod eieio-speedbar-derive-line-path ((obj ede-target) &optional depth) +(cl-defmethod eieio-speedbar-derive-line-path ((obj ede-target) &optional _depth) "Return the path to OBJ. Optional DEPTH is the depth we start at." (let ((proj (ede-target-parent obj))) @@ -208,7 +208,7 @@ Optional DEPTH is the depth we start at." "Provide a speedbar description for OBJ." (ede-description obj)) -(cl-defmethod eieio-speedbar-child-description ((obj ede-target)) +(cl-defmethod eieio-speedbar-child-description ((_obj ede-target)) "Provide a speedbar description for a plain-child of OBJ. A plain child is a child element which is not an EIEIO object." (or (speedbar-item-info-file-helper) @@ -251,7 +251,7 @@ It has depth DEPTH." ;;; Generic file management for TARGETS ;; -(defun ede-file-find (text token indent) +(defun ede-file-find (_text token indent) "Find the file TEXT at path TOKEN. INDENT is the current indentation level." (speedbar-find-file-in-frame @@ -276,7 +276,7 @@ INDENT is the current indentation level." Etags does not support this feature. TEXT will be the button string. TOKEN will be the list, and INDENT is the current indentation level." - (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 @@ -284,13 +284,13 @@ level." (speedbar-insert-generic-list indent token 'ede-tag-expand 'ede-tag-find)))) - ((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 ede-tag-find (text token indent) +(defun ede-tag-find (_text token _indent) "For the tag TEXT in a file TOKEN, goto that position. INDENT is the current indentation level." (let ((file (ede-find-nearest-file-line))) @@ -314,21 +314,21 @@ INDENT is the current indentation level." (defvar ede-speedbar-file-menu-additions '("----" ["Create EDE Target" ede-new-target (ede-current-project) ] - ["Add to project" ede-speedbar-file-add-to-project (ede-current-project) ] + ;; ["Add to project" ede-speedbar-file-add-to-project (ede-current-project) ] ["Compile project" ede-speedbar-compile-project (ede-current-project) ] - ["Compile file target" ede-speedbar-compile-file-target (ede-current-project) ] + ;; ["Compile file target" ede-speedbar-compile-file-target (ede-current-project) ] ["Make distribution" ede-make-dist (ede-current-project) ] ) "Set of menu items to splice into the speedbar menu.") (defvar ede-speedbar-file-keymap (let ((km (make-sparse-keymap))) - (define-key km "a" 'ede-speedbar-file-add-to-project) - (define-key km "t" 'ede-new-target) - (define-key km "s" 'ede-speedbar) - (define-key km "C" 'ede-speedbar-compile-project) - (define-key km "c" 'ede-speedbar-compile-file-target) - (define-key km "d" 'ede-make-dist) + ;; (define-key km "a" #'ede-speedbar-file-add-to-project) + (define-key km "t" #'ede-new-target) + (define-key km "s" #'ede-speedbar) + (define-key km "C" #'ede-speedbar-compile-project) + ;; (define-key km "c" #'ede-speedbar-compile-file-target) + (define-key km "d" #'ede-make-dist) km) "Keymap spliced into the speedbar keymap.") diff --git a/lisp/cedet/ede/srecode.el b/lisp/cedet/ede/srecode.el index 5dd0a7ec614..dd009bfb31a 100644 --- a/lisp/cedet/ede/srecode.el +++ b/lisp/cedet/ede/srecode.el @@ -1,4 +1,4 @@ -;;; ede/srecode.el --- EDE utilities on top of SRecoder +;;; ede/srecode.el --- EDE utilities on top of SRecoder -*- lexical-binding: t -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -86,7 +86,6 @@ Note: Just like `srecode-insert', but templates found in `ede' app." (car (cdr dictionary-entries))) (setq dictionary-entries (cdr (cdr dictionary-entries)))) - )) (provide 'ede/srecode) diff --git a/lisp/cedet/ede/system.el b/lisp/cedet/ede/system.el index d83d6d1cc69..8ef38f0d33e 100644 --- a/lisp/cedet/ede/system.el +++ b/lisp/cedet/ede/system.el @@ -1,4 +1,4 @@ -;;; ede-system.el --- EDE working with the system (VC, FTP, ETC) +;;; ede-system.el --- EDE working with the system (VC, FTP, ETC) -*- lexical-binding: t -*- ;; Copyright (C) 2001-2003, 2009-2021 Free Software Foundation, Inc. diff --git a/lisp/cedet/ede/util.el b/lisp/cedet/ede/util.el index 80cbc211fc2..2b2402c6425 100644 --- a/lisp/cedet/ede/util.el +++ b/lisp/cedet/ede/util.el @@ -1,4 +1,4 @@ -;;; ede/util.el --- EDE utilities +;;; ede/util.el --- EDE utilities -*- lexical-binding: t; -*- ;; Copyright (C) 2000, 2005, 2009-2021 Free Software Foundation, Inc. diff --git a/lisp/cedet/inversion.el b/lisp/cedet/inversion.el deleted file mode 100644 index 2ef7e0df961..00000000000 --- a/lisp/cedet/inversion.el +++ /dev/null @@ -1,554 +0,0 @@ -;;; inversion.el --- When you need something in version XX.XX - -;;; Copyright (C) 2002-2003, 2005-2021 Free Software Foundation, Inc. - -;; Author: Eric M. Ludlam <zappo@gnu.org> -;; Version: 1.3 -;; Keywords: OO, lisp - -;; 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: -;; -;; Keeping track of rapidly developing software is a tough thing to -;; do, especially if you want to have co-dependent packages which all -;; move at different rates. -;; -;; This library provides a framework for specifying version numbers -;; and (as side effect) have a flexible way of getting a desired feature set. -;; -;; If you would like to use this package to satisfy dependency replace this: -;; -;; (require 'spiffy) -;; -;; with this: -;; -;; (require 'inversion) -;; (inversion-require 'spiffy "1.0") -;; -;; If you feel the need to not throw errors, you can do this instead: -;; -;; (let ((err (inversion-test 'spiffy "1.0"))) -;; (if err (your-stuff-here))) -;; -;; If you new package (2.0) needs to make sure a load file from your -;; package is compatible, use this test: -;; -;; (if (not (inversion-reverse-test 'spiffy version-from-file)) -;; ;; Everything ok -;; (do stuff) -;; ;; Out of date -;; (import-old-code)) -;; -;; If you would like to make inversion optional, do this: -;; -;; (or (require 'inversion nil t) -;; (defun inversion-test (p v) -;; (string= v (symbol-value -;; (intern-soft (concat (symbol-string p) "-version")))))) -;; -;; Or modify to specify `inversion-require' instead. -;; -;; TODO: -;; Offer to download newer versions of a package. - -;;; History: -;; -;; Sept 3, 2002: First general publication. - -;;; Code: - -(defvar inversion-version "1.3" - "Current version of InVersion.") - -(defvar inversion-incompatible-version "0.1alpha1" - "An earlier release which is incompatible with this release.") - -(defconst inversion-decoders - '( - (alpha "^\\([0-9]+\\)\\.\\([0-9]+\\)\\.?\\([0-9]*\\)\\s-*\\.?alpha\\([0-9]+\\)?$" 4) - (beta "^\\([0-9]+\\)\\.\\([0-9]+\\)\\.?\\([0-9]*\\)\\s-*\\.?beta\\([0-9]+\\)?$" 4) - (beta "^\\([0-9]+\\)\\.\\([0-9]+\\)\\.?\\([0-9]*\\)\\s-*\\.?(beta\\([0-9]+\\)?)$" 4) - (beta "^[^/]+/\\w+--\\w+--\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)--patch-\\([0-9]+\\)" 4) - (beta "^\\w+: v\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)-\\([0-9]+\\)-\\(.*\\)" 5) - (prerelease "^\\([0-9]+\\)\\.\\([0-9]+\\)\\s-*\\.?pre\\([0-9]+\\)?$" 3) - (full "^\\([0-9]+\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?$" 3) - (fullsingle "^\\([0-9]+\\)$" 1) - (patch "^\\([0-9]+\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?\\s-*(patch \\([0-9]+\\))" 4) - (point "^\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)$" 3) - (point "^\\w+: v\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)-\\(0\\)-\\(.*\\)" 5) - (build "^\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\).\\([0-9]+\\)$" 4) - (full "^[^/]+/\\w+--\\w+--\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)--version-\\([0-9]+\\)" 4) - (full "^\\w+: v\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)" 5) - ) - "List of decoders for version strings. -Each decoder is of the form: - - ( RELEASE-TYPE REGEXP MAX ) - -RELEASE-TYPE is a symbol specifying something like `beta' or `alpha'. -REGEXP is the regular expression to match a version string. -MAX is the maximum number of match-numbers in the release number. -Decoders must be ordered to decode least stable versions before the -more stable ones.") - -;;; Version Checking -;; -(defun inversion-decode-version (version-string) - "Decode VERSION-STRING into an encoded list. -Return value is of the form: - (RELEASE MAJOR MINOR ...) -where RELEASE is a symbol such as `full', or `beta'." - (let ((decoders inversion-decoders) - (result nil)) - (while (and decoders (not result)) - (if (string-match (nth 1 (car decoders)) version-string) - (let ((ver nil) - (num-left (nth 2 (car decoders))) - (count 1)) - (while (<= count num-left) - (setq ver (cons - (if (match-beginning count) - (string-to-number - (substring version-string - (match-beginning count) - (match-end count))) - 1) - ver) - count (1+ count))) - (setq result (cons (caar decoders) (nreverse ver)))) - (setq decoders (cdr decoders)))) - result)) - -(defun inversion-package-version (package) - "Return the decoded version for PACKAGE." - (let ((ver (symbol-value - (intern-soft - (concat (symbol-name package) - "-version")))) - (code nil)) - (unless ver - (error "Package %S does not define %S-version" package package)) - ;; Decode the code - (setq code (inversion-decode-version ver)) - (unless code - (error "%S-version value (%s) cannot be decoded" package ver)) - code)) - -(defun inversion-package-incompatibility-version (package) - "Return the decoded incompatibility version for PACKAGE. -The incompatibility version is specified by the programmer of -a package when a package is not backward compatible. It is -not an indication of new features or bug fixes." - (let ((ver (symbol-value - (intern-soft - (concat (symbol-name package) - "-incompatible-version"))))) - (if (not ver) - nil - ;; Decode the code - (inversion-decode-version ver)))) - -(defun inversion-recode (code) - "Convert CODE into a string." - (let ((r (nth 0 code)) ; release-type - (n (nth 1 code)) ; main number - (i (nth 2 code)) ; first increment - (p (nth 3 code))) ; second increment - (cond - ((eq r 'full) - (setq r "" p "")) - ((eq r 'point) - (setq r "."))) - (format "%s.%s%s%s" n i r p))) - -(defun inversion-release-to-number (release-symbol) - "Convert RELEASE-SYMBOL into a number." - (let* ((ra (assoc release-symbol inversion-decoders)) - (rn (- (length inversion-decoders) - (length (member ra inversion-decoders))))) - rn)) - -(defun inversion-= (ver1 ver2) - "Return non-nil if VER1 is equal to VER2." - (equal ver1 ver2)) - -(defun inversion-< (ver1 ver2) - "Return non-nil if VER1 is less than VER2." - (let ((v1-0 (inversion-release-to-number (nth 0 ver1))) - (v1-1 (nth 1 ver1)) - (v1-2 (nth 2 ver1)) - (v1-3 (nth 3 ver1)) - (v1-4 (nth 4 ver1)) - ;; v2 - (v2-0 (inversion-release-to-number (nth 0 ver2))) - (v2-1 (nth 1 ver2)) - (v2-2 (nth 2 ver2)) - (v2-3 (nth 3 ver2)) - (v2-4 (nth 4 ver2)) - ) - - (cond ((and (equal (list v1-1 v1-2 v1-3 v1-4) - (list v2-1 v2-2 v2-3 v2-4)) - v1-0 v2-0) - (< v1-0 v2-0)) - ((and (equal v1-1 v2-1) - (equal v1-2 v2-2) - (equal v1-3 v2-3) - v1-4 v2-4) ; all or nothing if elt - is = - (< v1-4 v2-4)) - ((and (equal v1-1 v2-1) - (equal v1-2 v2-2) - v1-3 v2-3) ; all or nothing if elt - is = - (< v1-3 v2-3)) - ((and (equal v1-1 v2-1) - v1-2 v2-2) - (< v1-2 v2-2)) - ((and v1-1 v2-1) - (< v1-1 v2-1)) - ))) - -(defun inversion-check-version (version incompatible-version - minimum &rest reserved) - "Check that a given version meets the minimum requirement. -VERSION, INCOMPATIBLE-VERSION and MINIMUM are of similar format to -return entries of `inversion-decode-version', or a classic version -string. INCOMPATIBLE-VERSION can be nil. -RESERVED arguments are kept for a later use. -Return: -- nil if everything is ok. -- `outdated' if VERSION is less than MINIMUM. -- `incompatible' if VERSION is not backward compatible with MINIMUM. -- t if the check failed." - (let ((code (if (stringp version) - (inversion-decode-version version) - version)) - (req (if (stringp minimum) - (inversion-decode-version minimum) - minimum)) - ) - ;; Perform a test. - (cond - ((inversion-= code req) - ;; Same version.. Yay! - nil) - ((inversion-< code req) - ;; Version is too old! - 'outdated) - ((inversion-< req code) - ;; Newer is installed. What to do? - (let ((incompatible - (if (stringp incompatible-version) - (inversion-decode-version incompatible-version) - incompatible-version))) - (cond - ((not incompatible) nil) - ((or (inversion-= req incompatible) - (inversion-< req incompatible)) - ;; The requested version is = or < than what the package - ;; maintainer says is incompatible. - 'incompatible) - ;; Things are ok. - (t nil)))) - ;; Check failed - (t t)))) - -(defun inversion-test (package minimum &rest reserved) - "Test that PACKAGE meets the MINIMUM version requirement. -PACKAGE is a symbol, similar to what is passed to `require'. -MINIMUM is of similar format to return entries of -`inversion-decode-version', or a classic version string. -RESERVED arguments are kept for a later user. -This depends on the symbols `PACKAGE-version' and optionally -`PACKAGE-incompatible-version' being defined in PACKAGE. -Return nil if everything is ok. Return an error string otherwise." - (let ((check (inversion-check-version - (inversion-package-version package) - (inversion-package-incompatibility-version package) - minimum reserved))) - (cond - ((null check) - ;; Same version.. Yay! - nil) - ((eq check 'outdated) - ;; Version is too old! - (format "You need to upgrade package %s to %s" package minimum)) - ((eq check 'incompatible) - ;; Newer is installed but the requested version is = or < than - ;; what the package maintainer says is incompatible, then throw - ;; that error. - (format "Package %s version is not backward compatible with %s" - package minimum)) - ;; Check failed - (t "Inversion version check failed.")))) - -(defun inversion-reverse-test (package oldversion &rest reserved) - "Test that PACKAGE at OLDVERSION is still compatible. -If something like a save file is loaded at OLDVERSION, this -test will identify if OLDVERSION is compatible with the current version -of PACKAGE. -PACKAGE is a symbol, similar to what is passed to `require'. -OLDVERSION is of similar format to return entries of -`inversion-decode-version', or a classic version string. -RESERVED arguments are kept for a later user. -This depends on the symbols `PACKAGE-version' and optionally -`PACKAGE-incompatible-version' being defined in PACKAGE. -Return nil if everything is ok. Return an error string otherwise." - (let ((check (inversion-check-version - (inversion-package-version package) - (inversion-package-incompatibility-version package) - oldversion reserved))) - (cond - ((null check) - ;; Same version.. Yay! - nil) - ((eq check 'outdated) - ;; Version is too old! - (format "Package %s version %s is not compatible with current version" - package oldversion)) - ((eq check 'incompatible) - ;; Newer is installed but the requested version is = or < than - ;; what the package maintainer says is incompatible, then throw - ;; that error. - (format "Package %s version is not backward compatible with %s" - package oldversion)) - ;; Check failed - (t "Inversion version check failed.")))) - -(defun inversion-require (package version &optional file directory - &rest reserved) - "Declare that you need PACKAGE with at least VERSION. -PACKAGE might be found in FILE. (See `require'.) -Throws an error if VERSION is incompatible with what is installed. -Optional argument DIRECTORY is a location where new versions of -this tool can be located. If there is a versioning problem and -DIRECTORY is provided, inversion will offer to download the file. -Optional argument RESERVED is saved for later use." - (require package file) - (let ((err (inversion-test package version))) - (when err - (if directory - (inversion-download-package-ask err package directory version) - (error err))) - ;; Return the package symbol that was required. - package)) - -;;;###autoload -(defun inversion-require-emacs (emacs-ver xemacs-ver sxemacs-ver) - "Declare that you need either EMACS-VER, XEMACS-VER or SXEMACS-ver. -Only checks one based on which kind of Emacs is being run. - -This function is obsolete; do this instead: - (when (version<= \"28.1\" emacs-version) ...)" - (declare (obsolete nil "28.1")) - (let ((err (inversion-test 'emacs - (cond ((featurep 'sxemacs) - sxemacs-ver) - ((featurep 'xemacs) - xemacs-ver) - (t - emacs-ver))))) - (if err (error err) - ;; Something nice... - t))) - -(defconst inversion-find-data - '("(def\\(var\\|const\\)\\s-+%s-%s\\s-+\"\\([^\"]+\\)" 2) - "Regexp template and match data index of a version string.") - -(defun inversion-find-version (package) - "Search for the version and incompatible version of PACKAGE. -Does not load PACKAGE nor requires that it has been previously loaded. -Search in the directories in `load-path' for a PACKAGE.el library. -Visit the file found and search for the declarations of variables or -constants `PACKAGE-version' and `PACKAGE-incompatible-version'. The -value of these variables must be a version string. - -Return a pair (VERSION-STRING . INCOMPATIBLE-VERSION-STRING) where -INCOMPATIBLE-VERSION-STRING can be nil. -Return nil when VERSION-STRING was not found." - (let* ((file (locate-library (format "%s.el" package) t)) - (tag (car inversion-find-data)) - (idx (nth 1 inversion-find-data)) - version) - (when file - (with-temp-buffer - ;; The 3000 is a bit arbitrary, but should cut down on - ;; fileio as version info usually is at the very top - ;; of a file. After a long commentary could be bad. - (insert-file-contents-literally file nil 0 3000) - (goto-char (point-min)) - (when (re-search-forward (format tag package 'version) nil t) - (setq version (list (match-string idx))) - (goto-char (point-min)) - (when (re-search-forward - (format tag package 'incompatible-version) nil t) - (setcdr version (match-string idx)))))) - version)) - -(defun inversion-add-to-load-path (package minimum - &optional installdir - &rest subdirs) - "Add the PACKAGE path to `load-path' if necessary. -MINIMUM is the minimum version requirement of PACKAGE. -Optional argument INSTALLDIR is the base directory where PACKAGE is -installed. It defaults to `default-directory'/PACKAGE. -SUBDIRS are sub-directories to add to `load-path', following the main -INSTALLDIR path." - (let ((ver (inversion-find-version package))) - ;; If PACKAGE not found or a bad version already in `load-path', - ;; prepend the new PACKAGE path, so it will be loaded first. - (when (or (not ver) - (and - (inversion-check-version (car ver) (cdr ver) minimum) - (message "Outdated %s %s shadowed to meet minimum version %s" - package (car ver) minimum) - t)) - (let* ((default-directory - (or installdir - (expand-file-name (format "./%s" package)))) - subdir) - (when (file-directory-p default-directory) - ;; Add SUBDIRS - (while subdirs - (setq subdir (expand-file-name (car subdirs)) - subdirs (cdr subdirs)) - (when (file-directory-p subdir) - ;;(message "%S added to `load-path'" subdir) - (add-to-list 'load-path subdir))) - ;; Add the main path - ;;(message "%S added to `load-path'" default-directory) - (add-to-list 'load-path default-directory)) - ;; We get to this point iff we do not accept or there is no - ;; system file. Let's check the version of what we just - ;; installed... just to be safe. - (let ((newver (inversion-find-version package))) - (if (not newver) - (error "Failed to find version for newly installed %s" - package)) - (if (inversion-check-version (car newver) (cdr newver) minimum) - (error "Outdated %s %s just installed" package (car newver))) - ))))) - -;;; URL and downloading code -;; -(defun inversion-locate-package-files (package directory &optional version) - "Get a list of distributions of PACKAGE from DIRECTORY. -DIRECTORY can be an ange-ftp compatible filename, such as: - \"/ftp@ftp1.sourceforge.net/pub/sourceforge/PACKAGE\" -If it is a URL, wget will be used for download. -Optional argument VERSION will restrict the list of available versions -to the file matching VERSION exactly, or nil." -;;DIRECTORY should also allow a URL: -;; \"http://ftp1.sourceforge.net/PACKAGE\" -;; but then I can get file listings easily. - (if (symbolp package) (setq package (symbol-name package))) - (directory-files directory t - (if version - (concat "^" package "-" version "\\>") - package))) - -(defvar inversion-package-common-tails '( ".tar.gz" - ".tar" - ".zip" - ".gz" - ) - "Common distribution mechanisms for Emacs Lisp packages.") - -(defun inversion-locate-package-files-and-split (package directory &optional version) - "Use `inversion-locate-package-files' to get a list of PACKAGE files. -DIRECTORY is the location where distributions of PACKAGE are. -VERSION is an optional argument specifying a version to restrict to. -The return list is an alist with the version string in the CAR, -and the full path name in the CDR." - (if (symbolp package) (setq package (symbol-name package))) - (let ((f (inversion-locate-package-files package directory version)) - (out nil)) - (while f - (let* ((file (car f)) - (dist (file-name-nondirectory file)) - (tails inversion-package-common-tails) - (verstring nil)) - (while (and tails (not verstring)) - (when (string-match (concat (car tails) "$") dist) - (setq verstring - (substring dist (1+ (length package)) (match-beginning 0)))) - (setq tails (cdr tails))) - (if (not verstring) - (error "Cannot decode version for %s" dist)) - (setq out - (cons - (cons verstring file) - out)) - (setq f (cdr f)))) - out)) - -(defun inversion-download-package-ask (err package directory version) - "Due to ERR, offer to download PACKAGE from DIRECTORY. -The package should have VERSION available for download." - (if (symbolp package) (setq package (symbol-name package))) - (let ((files (inversion-locate-package-files-and-split - package directory version))) - (if (not files) - (error err) - (if (not (y-or-n-p (concat err ": Download update? "))) - (error err) - (let ((dest (read-directory-name (format "Download %s to: " - package) - t))) - (if (> (length files) 1) - (setq files - (list - "foo" ;; ignored - (read-file-name "Version to download: " - directory - files - t - (concat - (file-name-as-directory directory) - package) - nil)))) - - (copy-file (cdr (car files)) dest)))))) - -;;; How we upgrade packages in Emacs has yet to be ironed out. - -;; (defun inversion-upgrade-package (package &optional directory) -;; "Try to upgrade PACKAGE in DIRECTORY is available." -;; (interactive "sPackage to upgrade: ") -;; (if (stringp package) (setq package (intern package))) -;; (if (not directory) -;; ;; Hope that the package maintainer specified. -;; (setq directory (symbol-value (or (intern-soft -;; (concat (symbol-name package) -;; "-url")) -;; (intern-soft -;; (concat (symbol-name package) -;; "-directory")))))) -;; (let ((files (inversion-locate-package-files-and-split -;; package directory)) -;; (cver (inversion-package-version package)) -;; (newer nil)) -;; (mapc (lambda (f) -;; (if (inversion-< cver (inversion-decode-version (car f))) -;; (setq newer (cons f newer)))) -;; files) -;; newer -;; )) - -(provide 'inversion) - -;;; inversion.el ends here diff --git a/lisp/cedet/mode-local.el b/lisp/cedet/mode-local.el index 63e0cef61a3..247f78ecff7 100644 --- a/lisp/cedet/mode-local.el +++ b/lisp/cedet/mode-local.el @@ -91,13 +91,13 @@ MODES can be a symbol or a list of symbols. FUNCTION does not have arguments." (or (listp modes) (setq modes (list modes))) (mode-local-map-file-buffers - function #'(lambda () - (let ((mm (mode-local-equivalent-mode-p major-mode)) - (ans nil)) - (while (and (not ans) mm) - (setq ans (memq (car mm) modes) - mm (cdr mm)) ) - ans)))) + function (lambda () + (let ((mm (mode-local-equivalent-mode-p major-mode)) + (ans nil)) + (while (and (not ans) mm) + (setq ans (memq (car mm) modes) + mm (cdr mm)) ) + ans)))) ;;; Hook machinery ;; @@ -323,14 +323,14 @@ Elements are (SYMBOL . PREVIOUS-VALUE), describing one variable." (dolist (mode modes) (when (setq table (get mode 'mode-local-symbol-table)) (mapatoms - #'(lambda (var) - (when (get var 'mode-variable-flag) - (let ((v (intern (symbol-name var)))) - ;; Save the current buffer-local value of the - ;; mode-local variable. - (and (local-variable-p v (current-buffer)) - (push (cons v (symbol-value v)) old-locals)) - (set (make-local-variable v) (symbol-value var))))) + (lambda (var) + (when (get var 'mode-variable-flag) + (let ((v (intern (symbol-name var)))) + ;; Save the current buffer-local value of the + ;; mode-local variable. + (and (local-variable-p v (current-buffer)) + (push (cons v (symbol-value v)) old-locals)) + (set (make-local-variable v) (symbol-value var))))) table))) old-locals))) @@ -348,9 +348,9 @@ If MODE is not specified it defaults to current `major-mode'." (while mode (when (setq table (get mode 'mode-local-symbol-table)) (mapatoms - #'(lambda (var) - (when (get var 'mode-variable-flag) - (kill-local-variable (intern (symbol-name var))))) + (lambda (var) + (when (get var 'mode-variable-flag) + (kill-local-variable (intern (symbol-name var))))) table)) (setq mode (get-mode-local-parent mode))))) @@ -428,7 +428,7 @@ Return the value of the last VAL." ;; Save mode bindings (mode-local-bind (list ,@bl) '(mode-variable-flag t) ',mode) ;; Assign to local variables in all existing buffers in MODE - (mode-local-map-mode-buffers #'(lambda () ,@sl) ',mode) + (mode-local-map-mode-buffers (lambda () ,@sl) ',mode) ;; Return the last value ,tmp) ))) @@ -576,7 +576,7 @@ OVERARGS is a list of arguments passed to the override and (put :override-with-args 'lisp-indent-function 1) (define-obsolete-function-alias 'define-overload - 'define-overloadable-function "27.1") + #'define-overloadable-function "27.1") (define-obsolete-function-alias 'function-overload-p #'mode-local--function-overload-p "27.1") @@ -893,7 +893,7 @@ invoked interactively." (interactive (list (completing-read "Mode: " obarray - #'(lambda (s) (get s 'mode-local-symbol-table)) + (lambda (s) (get s 'mode-local-symbol-table)) t (symbol-name major-mode)))) (when (setq mode (intern-soft mode)) (mode-local-describe-bindings-1 mode (called-interactively-p 'any)))) diff --git a/lisp/cedet/pulse.el b/lisp/cedet/pulse.el index aef4fc89057..7928fa1bf42 100644 --- a/lisp/cedet/pulse.el +++ b/lisp/cedet/pulse.el @@ -1,6 +1,6 @@ -;;; pulse.el --- Pulsing Overlays +;;; pulse.el --- Pulsing Overlays -*- 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> ;; Version: 1.0 @@ -30,10 +30,9 @@ ;; ;; The following are useful entry points: ;; -;; `pulse' - Cause `pulse-highlight-face' to shift toward background color. +;; `pulse-tick' - Cause `pulse-highlight-face' to shift toward background color. ;; Assumes you are using a version of Emacs that supports pulsing. ;; -;; ;; `pulse-momentary-highlight-one-line' - Pulse a single line at POINT. ;; `pulse-momentary-highlight-region' - Pulse a region. ;; `pulse-momentary-highlight-overlay' - Pulse an overlay. @@ -50,7 +49,9 @@ ;; ;; Pulse is a part of CEDET. http://cedet.sf.net -(defun pulse-available-p () +(require 'color) + +(defun pulse-available-p () "Return non-nil if pulsing is available on the current frame." (condition-case nil (let ((v (color-values (face-background 'default)))) @@ -90,69 +91,27 @@ Face used for temporary highlighting of tags for effect." :group 'pulse) ;;; Code: -;; -(defun pulse-int-to-hex (int &optional nb-digits) - "Convert integer argument INT to a #XXXXXXXXXXXX format hex string. -Each X in the output string is a hexadecimal digit. -NB-DIGITS is the number of hex digits. If INT is too large to be -represented with NB-DIGITS, then the result is truncated from the -left. So, for example, INT=256 and NB-DIGITS=2 returns \"00\", since -the hex equivalent of 256 decimal is 100, which is more than 2 digits. - -This function was blindly copied from hexrgb.el by Drew Adams. -https://www.emacswiki.org/emacs/hexrgb.el" - (setq nb-digits (or nb-digits 4)) - (substring (format (concat "%0" (int-to-string nb-digits) "X") int) (- nb-digits))) - -(defun pulse-color-values-to-hex (values) - "Convert list of rgb color VALUES to a hex string, #XXXXXXXXXXXX. -Each X in the string is a hexadecimal digit. -Input VALUES is as for the output of `x-color-values'. - -This function was blindly copied from hexrgb.el by Drew Adams. -https://www.emacswiki.org/emacs/hexrgb.el" - (concat "#" - (pulse-int-to-hex (nth 0 values) 4) ; red - (pulse-int-to-hex (nth 1 values) 4) ; green - (pulse-int-to-hex (nth 2 values) 4))) ; blue (defcustom pulse-iterations 10 "Number of iterations in a pulse operation." :group 'pulse :type 'number) + (defcustom pulse-delay .03 "Delay between face lightening iterations." :group 'pulse :type 'number) -(defun pulse-lighten-highlight () - "Lighten the face by 1/`pulse-iterations' toward the background color. -Return t if there is more drift to do, nil if completed." - (if (>= (get 'pulse-highlight-face :iteration) pulse-iterations) - nil - (let* ((frame (color-values (face-background 'default))) - (pulse-background (face-background - (get 'pulse-highlight-face - :startface) - nil t)));; can be nil - (when pulse-background - (let* ((start (color-values pulse-background)) - (frac (list (/ (- (nth 0 frame) (nth 0 start)) pulse-iterations) - (/ (- (nth 1 frame) (nth 1 start)) pulse-iterations) - (/ (- (nth 2 frame) (nth 2 start)) pulse-iterations))) - (it (get 'pulse-highlight-face :iteration)) - ) - (set-face-background 'pulse-highlight-face - (pulse-color-values-to-hex - (list - (+ (nth 0 start) (* (nth 0 frac) it)) - (+ (nth 1 start) (* (nth 1 frac) it)) - (+ (nth 2 start) (* (nth 2 frac) it))))) - (put 'pulse-highlight-face :iteration (1+ it)) - (if (>= (1+ it) pulse-iterations) - nil - t))) - ))) +;;; Convenience Functions +;; +(defvar pulse-momentary-overlay nil + "The current pulsing overlay.") + +(defvar pulse-momentary-timer nil + "The current pulsing timer.") + +(defvar pulse-momentary-iteration 0 + "The current pulsing iteration.") (defun pulse-reset-face (&optional face) "Reset the pulse highlighting FACE." @@ -161,20 +120,12 @@ Return t if there is more drift to do, nil if completed." (face-background face nil t) (face-background 'pulse-highlight-start-face) )) - (and face - (set-face-extend 'pulse-highlight-face - (face-extend-p face nil t))) + (set-face-extend 'pulse-highlight-face + (face-extend-p (or face 'pulse-highlight-start-face) + nil t)) (put 'pulse-highlight-face :startface (or face 'pulse-highlight-start-face)) - (put 'pulse-highlight-face :iteration 0)) - -;;; Convenience Functions -;; -(defvar pulse-momentary-overlay nil - "The current pulsing overlay.") - -(defvar pulse-momentary-timer nil - "The current pulsing timer.") + (setq pulse-momentary-iteration 0)) (defun pulse-momentary-highlight-overlay (o &optional face) "Pulse the overlay O, unhighlighting before next command. @@ -194,21 +145,29 @@ Optional argument FACE specifies the face to do the highlighting." (progn (overlay-put o 'face (or face 'pulse-highlight-start-face)) (add-hook 'pre-command-hook - 'pulse-momentary-unhighlight)) + #'pulse-momentary-unhighlight)) ;; Pulse it. (overlay-put o 'face 'pulse-highlight-face) ;; The pulse function puts FACE onto 'pulse-highlight-face. ;; Thus above we put our face on the overlay, but pulse ;; with a reference face needed for the color. (pulse-reset-face face) - (setq pulse-momentary-timer - (run-with-timer 0 pulse-delay #'pulse-tick - (time-add nil - (* pulse-delay pulse-iterations))))))) - -(defun pulse-tick (stop-time) + (let* ((start (color-name-to-rgb + (face-background 'pulse-highlight-face nil 'default))) + (stop (color-name-to-rgb (face-background 'default))) + (colors (mapcar (apply-partially 'apply 'color-rgb-to-hex) + (color-gradient start stop pulse-iterations)))) + (setq pulse-momentary-timer + (run-with-timer 0 pulse-delay #'pulse-tick + colors + (time-add nil + (* pulse-delay pulse-iterations)))))))) + +(defun pulse-tick (colors stop-time) (if (time-less-p nil stop-time) - (pulse-lighten-highlight) + (when-let (color (elt colors pulse-momentary-iteration)) + (set-face-background 'pulse-highlight-face color) + (setq pulse-momentary-iteration (1+ pulse-momentary-iteration))) (pulse-momentary-unhighlight))) (defun pulse-momentary-unhighlight () @@ -233,7 +192,7 @@ Optional argument FACE specifies the face to do the highlighting." (cancel-timer pulse-momentary-timer)) ;; Remove this hook. - (remove-hook 'pre-command-hook 'pulse-momentary-unhighlight)) + (remove-hook 'pre-command-hook #'pulse-momentary-unhighlight)) ;;;###autoload (defun pulse-momentary-highlight-one-line (point &optional face) diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el index 44bd4b0cd82..fb443fa4a32 100644 --- a/lisp/cedet/semantic.el +++ b/lisp/cedet/semantic.el @@ -1,4 +1,4 @@ -;;; semantic.el --- Semantic buffer evaluator. +;;; semantic.el --- Semantic buffer evaluator. -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2021 Free Software Foundation, Inc. @@ -57,6 +57,7 @@ excluded if a released version is required. It is assumed that if the current version is newer than that specified, everything passes. Exceptions occur when known incompatibilities are introduced." + (declare (obsolete emacs-version "28.1")) (require 'inversion) (inversion-test 'semantic (concat major "." minor @@ -296,7 +297,7 @@ to use Semantic, and `semantic-init-hook' is run." 'semantic-inhibit-functions))) ;; Make sure that if this buffer is cloned, our tags and overlays ;; don't go along for the ride. - (add-hook 'clone-indirect-buffer-hook 'semantic-clear-toplevel-cache + (add-hook 'clone-indirect-buffer-hook #'semantic-clear-toplevel-cache nil t) ;; Specify that this function has done its work. At this point ;; we can consider that semantic is active in this buffer. @@ -465,12 +466,12 @@ is requested." ;; Nuke all semantic overlays. This is faster than deleting based ;; on our data structure. (let ((l (overlay-lists))) - (mapc 'semantic-delete-overlay-maybe (car l)) - (mapc 'semantic-delete-overlay-maybe (cdr l)) + (mapc #'semantic-delete-overlay-maybe (car l)) + (mapc #'semantic-delete-overlay-maybe (cdr l)) ) (semantic-parse-tree-set-needs-rebuild) ;; Remove this hook which tracks if a buffer is up to date or not. - (remove-hook 'after-change-functions 'semantic-change-function t) + (remove-hook 'after-change-functions #'semantic-change-function t) (run-hook-with-args 'semantic-after-toplevel-cache-change-hook semantic--buffer-cache) @@ -486,7 +487,7 @@ is requested." ;; This is specific to the bovine parser. (setq-local semantic-bovinate-nonterminal-check-obarray nil) (semantic-parse-tree-set-up-to-date) - (add-hook 'after-change-functions 'semantic-change-function nil t) + (add-hook 'after-change-functions #'semantic-change-function nil t) (run-hook-with-args 'semantic-after-toplevel-cache-change-hook semantic--buffer-cache) (setq semantic--completion-cache nil) @@ -677,15 +678,15 @@ This function returns semantic tags without overlays." (if tag (if (car tag) (setq tag (mapcar - #'(lambda (tag) - ;; Set the 'reparse-symbol property to - ;; NONTERM unless it was already setup - ;; by a tag expander - (or (semantic--tag-get-property - tag 'reparse-symbol) - (semantic--tag-put-property - tag 'reparse-symbol nonterm)) - tag) + (lambda (tag) + ;; Set the 'reparse-symbol property to + ;; NONTERM unless it was already setup + ;; by a tag expander + (or (semantic--tag-get-property + tag 'reparse-symbol) + (semantic--tag-put-property + tag 'reparse-symbol nonterm)) + tag) (semantic--tag-expand tag)) result (append result tag)) ;; No error in this case, a purposeful nil means don't @@ -778,25 +779,25 @@ Throw away all the old tags, and recreate the tag database." (defvar semantic-mode-map (let ((map (make-sparse-keymap))) ;; Key bindings: - ;; (define-key km "f" 'senator-search-set-tag-class-filter) - ;; (define-key km "i" 'senator-isearch-toggle-semantic-mode) - (define-key map "\C-c,j" 'semantic-complete-jump-local) - (define-key map "\C-c,J" 'semantic-complete-jump) - (define-key map "\C-c,m" 'semantic-complete-jump-local-members) - (define-key map "\C-c,g" 'semantic-symref-symbol) - (define-key map "\C-c,G" 'semantic-symref) - (define-key map "\C-c,p" 'senator-previous-tag) - (define-key map "\C-c,n" 'senator-next-tag) - (define-key map "\C-c,u" 'senator-go-to-up-reference) - (define-key map "\C-c, " 'semantic-complete-analyze-inline) - (define-key map "\C-c,\C-w" 'senator-kill-tag) - (define-key map "\C-c,\M-w" 'senator-copy-tag) - (define-key map "\C-c,\C-y" 'senator-yank-tag) - (define-key map "\C-c,r" 'senator-copy-tag-to-register) - (define-key map "\C-c,," 'semantic-force-refresh) - (define-key map [?\C-c ?, up] 'senator-transpose-tags-up) - (define-key map [?\C-c ?, down] 'senator-transpose-tags-down) - (define-key map "\C-c,l" 'semantic-analyze-possible-completions) + ;; (define-key km "f" #'senator-search-set-tag-class-filter) + ;; (define-key km "i" #'senator-isearch-toggle-semantic-mode) + (define-key map "\C-c,j" #'semantic-complete-jump-local) + (define-key map "\C-c,J" #'semantic-complete-jump) + (define-key map "\C-c,m" #'semantic-complete-jump-local-members) + (define-key map "\C-c,g" #'semantic-symref-symbol) + (define-key map "\C-c,G" #'semantic-symref) + (define-key map "\C-c,p" #'senator-previous-tag) + (define-key map "\C-c,n" #'senator-next-tag) + (define-key map "\C-c,u" #'senator-go-to-up-reference) + (define-key map "\C-c, " #'semantic-complete-analyze-inline) + (define-key map "\C-c,\C-w" #'senator-kill-tag) + (define-key map "\C-c,\M-w" #'senator-copy-tag) + (define-key map "\C-c,\C-y" #'senator-yank-tag) + (define-key map "\C-c,r" #'senator-copy-tag-to-register) + (define-key map "\C-c,," #'semantic-force-refresh) + (define-key map [?\C-c ?, up] #'senator-transpose-tags-up) + (define-key map [?\C-c ?, down] #'senator-transpose-tags-down) + (define-key map "\C-c,l" #'semantic-analyze-possible-completions) ;; This hack avoids showing the CEDET menu twice if ede-minor-mode ;; and Semantic are both enabled. Is there a better way? (define-key map [menu-bar cedet-menu] @@ -1028,7 +1029,7 @@ Semantic mode. (file-exists-p semanticdb-default-system-save-directory)) (require 'semantic/db-ebrowse) (semanticdb-load-ebrowse-caches))) - (add-hook 'mode-local-init-hook 'semantic-new-buffer-fcn) + (add-hook 'mode-local-init-hook #'semantic-new-buffer-fcn) ;; Add semantic-ia-complete-symbol to ;; completion-at-point-functions, so that it is run from ;; M-TAB. @@ -1036,11 +1037,11 @@ Semantic mode. ;; Note: The first entry added is the last entry run, so the ;; most specific entry should be last. (add-hook 'completion-at-point-functions - 'semantic-analyze-nolongprefix-completion-at-point-function) + #'semantic-analyze-nolongprefix-completion-at-point-function) (add-hook 'completion-at-point-functions - 'semantic-analyze-notc-completion-at-point-function) + #'semantic-analyze-notc-completion-at-point-function) (add-hook 'completion-at-point-functions - 'semantic-analyze-completion-at-point-function) + #'semantic-analyze-completion-at-point-function) (if (bound-and-true-p global-ede-mode) (define-key cedet-menu-map [cedet-menu-separator] '("--"))) @@ -1051,21 +1052,21 @@ Semantic mode. ;; introduced in the buffer is pretty much futile, but we have to ;; clean the hooks and delete Semantic-related overlays, so that ;; Semantic can be re-activated cleanly. - (remove-hook 'mode-local-init-hook 'semantic-new-buffer-fcn) + (remove-hook 'mode-local-init-hook #'semantic-new-buffer-fcn) (remove-hook 'completion-at-point-functions - 'semantic-analyze-completion-at-point-function) + #'semantic-analyze-completion-at-point-function) (remove-hook 'completion-at-point-functions - 'semantic-analyze-notc-completion-at-point-function) + #'semantic-analyze-notc-completion-at-point-function) (remove-hook 'completion-at-point-functions - 'semantic-analyze-nolongprefix-completion-at-point-function) + #'semantic-analyze-nolongprefix-completion-at-point-function) (remove-hook 'after-change-functions - 'semantic-change-function) + #'semantic-change-function) (define-key cedet-menu-map [cedet-menu-separator] nil) (define-key cedet-menu-map [semantic-options-separator] nil) ;; FIXME: handle semanticdb-load-ebrowse-caches (dolist (mode semantic-submode-list) - (if (and (boundp mode) (eval mode)) + (if (and (boundp mode) (symbol-value mode)) (funcall mode -1))) ;; Unlink buffer and clear cache (semantic--tag-unlink-cache-from-buffer) 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)) diff --git a/lisp/cedet/srecode.el b/lisp/cedet/srecode.el index aa4aa812e02..83e9754a608 100644 --- a/lisp/cedet/srecode.el +++ b/lisp/cedet/srecode.el @@ -1,6 +1,6 @@ ;;; srecode.el --- Semantic buffer evaluator. -*- lexical-binding: t -*- -;;; Copyright (C) 2005, 2007-2021 Free Software Foundation, Inc. +;; Copyright (C) 2005-2021 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: codegeneration diff --git a/lisp/cedet/srecode/args.el b/lisp/cedet/srecode/args.el index 24c5f22f2e7..79d2700c5d9 100644 --- a/lisp/cedet/srecode/args.el +++ b/lisp/cedet/srecode/args.el @@ -1,4 +1,4 @@ -;;; srecode/args.el --- Provide some simple template arguments +;;; srecode/args.el --- Provide some simple template arguments -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. diff --git a/lisp/cedet/srecode/compile.el b/lisp/cedet/srecode/compile.el index 7146b643836..15107ef1e43 100644 --- a/lisp/cedet/srecode/compile.el +++ b/lisp/cedet/srecode/compile.el @@ -1,4 +1,4 @@ -;;; srecode/compile --- Compilation of srecode template files. +;;; srecode/compile --- Compilation of srecode template files. -*- lexical-binding: t; -*- ;; Copyright (C) 2005, 2007-2021 Free Software Foundation, Inc. @@ -110,7 +110,12 @@ stack is broken." :type (or null string) :documentation "If there is a colon in the inserter's name, it represents -additional static argument data.")) +additional static argument data.") + (key :initform nil :allocation :class + :documentation + "The character code used to identify inserters of this style. +All children of this class should specify `key' slot with appropriate +:initform value.")) "This represents an item to be inserted via a template macro. Plain text strings are not handled via this baseclass." :abstract t) @@ -499,7 +504,7 @@ PROPS are additional properties that might need to be passed to the inserter constructor." ;;(message "Compile: %s %S" name props) (if (not key) - (apply 'srecode-template-inserter-variable name props) + (apply #'make-instance 'srecode-template-inserter-variable name props) (let ((classes (eieio-class-children 'srecode-template-inserter)) (new nil)) ;; Loop over the various subclasses and @@ -510,7 +515,7 @@ to the inserter constructor." (when (and (not (class-abstract-p (car classes))) (equal (oref-default (car classes) key) key)) ;; Create the new class, and apply state. - (setq new (apply (car classes) name props)) + (setq new (apply #'make-instance (car classes) name props)) (srecode-inserter-apply-state new STATE) ) (setq classes (cdr classes))) diff --git a/lisp/cedet/srecode/cpp.el b/lisp/cedet/srecode/cpp.el index 1b9610f3f1b..dc5e8da5cdb 100644 --- a/lisp/cedet/srecode/cpp.el +++ b/lisp/cedet/srecode/cpp.el @@ -1,4 +1,4 @@ -;;; srecode/cpp.el --- C++ specific handlers for Semantic Recoder +;;; srecode/cpp.el --- C++ specific handlers for Semantic Recoder -*- lexical-binding: t; -*- ;; Copyright (C) 2007, 2009-2021 Free Software Foundation, Inc. @@ -44,7 +44,6 @@ A dictionary entry of the named PREFIX_NAMESPACE with the value NAMESPACE:: is created for each namespace unless the current buffer contains a using NAMESPACE; statement." - :group 'srecode-cpp :type '(repeat string)) ;;; :c ARGUMENT HANDLING @@ -165,7 +164,7 @@ specified in a C file." ;; when they make sense. My best bet would be ;; (semantic-tag-function-parent tag), but it is not there, when ;; the function is defined in the scope of a class. - (let ((member t) + (let (;; (member t) (templates (semantic-tag-get-attribute tag :template)) (modifiers (semantic-tag-modifiers tag))) @@ -186,7 +185,7 @@ specified in a C file." ;; When the function is a member function, it can have ;; additional modifiers. - (when member + (when t ;; member ;; For member functions, constness is called ;; 'methodconst-flag'. diff --git a/lisp/cedet/srecode/ctxt.el b/lisp/cedet/srecode/ctxt.el index 20334f95838..c49237b94cf 100644 --- a/lisp/cedet/srecode/ctxt.el +++ b/lisp/cedet/srecode/ctxt.el @@ -1,4 +1,4 @@ -;;; srecode/ctxt.el --- Derive a context from the source buffer. +;;; srecode/ctxt.el --- Derive a context from the source buffer. -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. diff --git a/lisp/cedet/srecode/dictionary.el b/lisp/cedet/srecode/dictionary.el index c1fe4b2c34e..5da045e17f1 100644 --- a/lisp/cedet/srecode/dictionary.el +++ b/lisp/cedet/srecode/dictionary.el @@ -1,4 +1,4 @@ -;;; srecode/dictionary.el --- Dictionary code for the semantic recoder. +;;; srecode/dictionary.el --- Dictionary code for the semantic recoder. -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. @@ -443,8 +443,8 @@ The root dictionary is usually for a current or active insertion." ;; for use in converting the compound value into something insertable. (cl-defmethod srecode-compound-toString ((cp srecode-dictionary-compound-value) - function - dictionary) + _function + _dictionary) "Convert the compound dictionary value CP to a string. If FUNCTION is non-nil, then FUNCTION is somehow applied to an aspect of the compound value. The FUNCTION could be a fraction @@ -457,14 +457,15 @@ standard out is a buffer, and using `insert'." (eieio-object-name cp)) (cl-defmethod srecode-dump ((cp srecode-dictionary-compound-value) - &optional indent) + &optional _indent) "Display information about this compound value." (princ (eieio-object-name cp)) ) -(cl-defmethod srecode-compound-toString ((cp srecode-dictionary-compound-variable) - function - dictionary) +(cl-defmethod srecode-compound-toString + ((cp srecode-dictionary-compound-variable) + _function + dictionary) "Convert the compound dictionary variable value CP into a string. FUNCTION and DICTIONARY are as for the baseclass." (require 'srecode/insert) @@ -606,9 +607,9 @@ STATE is the current compiler state." (require 'srecode/find) (let* ((modesym major-mode) (start (current-time)) - (junk (or (progn (srecode-load-tables-for-mode modesym) - (srecode-get-mode-table modesym)) - (error "No table found for mode %S" modesym))) + (_ (or (progn (srecode-load-tables-for-mode modesym) + (srecode-get-mode-table modesym)) + (error "No table found for mode %S" modesym))) (dict (srecode-create-dictionary (current-buffer))) ) (message "Creating a dictionary took %.2f seconds." diff --git a/lisp/cedet/srecode/document.el b/lisp/cedet/srecode/document.el index 0d1a4c01d3c..270b80d9013 100644 --- a/lisp/cedet/srecode/document.el +++ b/lisp/cedet/srecode/document.el @@ -1,4 +1,4 @@ -;;; srecode/document.el --- Documentation (comment) generation +;;; srecode/document.el --- Documentation (comment) generation -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -88,7 +88,6 @@ versions of names. This is an alist with each element of the form: (MATCH . RESULT) MATCH is a regexp to match in the type field. RESULT is a string." - :group 'document :type '(repeat (cons (regexp :tag "Regexp") (string :tag "Doc Text")))) @@ -144,7 +143,6 @@ A string may end in a space, in which case, last-alist is searched to see how best to describe what can be returned. Doesn't always work correctly, but that is just because English doesn't always work correctly." - :group 'document :type '(repeat (cons (regexp :tag "Regexp") (string :tag "Doc Text")))) @@ -175,7 +173,6 @@ versions of names. This is an alist with each element of the form: (MATCH . RESULT) MATCH is a regexp to match in the type field. RESULT is a string." - :group 'document :type '(repeat (cons (regexp :tag "Regexp") (string :tag "Doc Text")))) @@ -192,7 +189,6 @@ This is an alist with each element of the form: (MATCH . RESULT) MATCH is a regexp to match in the type field. RESULT is a string." - :group 'document :type '(repeat (cons (regexp :tag "Regexp") (string :tag "Doc Text")))) @@ -213,7 +209,6 @@ This is an alist with each element of the form: MATCH is a regexp to match in the type field. RESULT is a string, which can contain %s, which is replaced with `match-string' 1." - :group 'document :type '(repeat (cons (regexp :tag "Regexp") (string :tag "Doc Text")))) @@ -233,7 +228,6 @@ MATCH is a regexp to match in the type field. RESULT is a string of text to use to describe MATCH. When one is encountered, document-insert-parameters will automatically place this comment after the parameter name." - :group 'document :type '(repeat (cons (regexp :tag "Regexp") (string :tag "Doc Text")))) @@ -258,7 +252,6 @@ This is an alist with each element of the form: (MATCH . RESULT) MATCH is a regexp to match in the type field. RESULT is a string." - :group 'document :type '(repeat (cons (regexp :tag "Regexp") (string :tag "Doc Text")))) @@ -716,7 +709,7 @@ allocating something based on its type." (setq al (cdr al))))) news)) -(defun srecode-document-parameter-comment (param &optional commentlist) +(defun srecode-document-parameter-comment (param &optional _commentlist) "Convert tag or string PARAM into a name,comment pair. Optional COMMENTLIST is list of previously existing comments to use instead in alist form. If the name doesn't appear in the list of diff --git a/lisp/cedet/srecode/el.el b/lisp/cedet/srecode/el.el index 7e9dd10fd42..974a4fac727 100644 --- a/lisp/cedet/srecode/el.el +++ b/lisp/cedet/srecode/el.el @@ -1,4 +1,4 @@ -;;; srecode/el.el --- Emacs Lisp specific arguments +;;; srecode/el.el --- Emacs Lisp specific arguments -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. diff --git a/lisp/cedet/srecode/expandproto.el b/lisp/cedet/srecode/expandproto.el index cdb29d16b71..a40d5aec24d 100644 --- a/lisp/cedet/srecode/expandproto.el +++ b/lisp/cedet/srecode/expandproto.el @@ -1,4 +1,4 @@ -;;; srecode/expandproto.el --- Expanding prototypes. +;;; srecode/expandproto.el --- Expanding prototypes. -*- lexical-binding: t; -*- ;; Copyright (C) 2007, 2009-2021 Free Software Foundation, Inc. diff --git a/lisp/cedet/srecode/extract.el b/lisp/cedet/srecode/extract.el index 625b854b776..9e6a98fd769 100644 --- a/lisp/cedet/srecode/extract.el +++ b/lisp/cedet/srecode/extract.el @@ -1,4 +1,4 @@ -;;; srecode/extract.el --- Extract content from previously inserted macro. +;;; srecode/extract.el --- Extract content from previously inserted macro. -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -139,24 +139,24 @@ Uses STATE to maintain the current extraction state." ;;; Inserter Base Extractors ;; -(cl-defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter)) +(cl-defmethod srecode-inserter-do-extract-p ((_ins srecode-template-inserter)) "Return non-nil if this inserter can extract values." nil) -(cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter) - start end dict state) +(cl-defmethod srecode-inserter-extract ((_ins srecode-template-inserter) + _start _end _dict _state) "Extract text from START/END and store in DICT. Return nil as this inserter will extract nothing." nil) ;;; Variable extractor is simple and can extract later. ;; -(cl-defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-variable)) +(cl-defmethod srecode-inserter-do-extract-p ((_ins srecode-template-inserter-variable)) "Return non-nil if this inserter can extract values." 'later) (cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter-variable) - start end vdict state) + start end vdict _state) "Extract text from START/END and store in VDICT. Return t if something was extracted. Return nil if this inserter doesn't need to extract anything." @@ -168,12 +168,12 @@ Return nil if this inserter doesn't need to extract anything." ;;; Section Inserter ;; -(cl-defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-section-start)) +(cl-defmethod srecode-inserter-do-extract-p ((_ins srecode-template-inserter-section-start)) "Return non-nil if this inserter can extract values." 'now) (cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter-section-start) - start end indict state) + _start _end indict state) "Extract text from START/END and store in INDICT. Return the starting location of the first plain-text match. Return nil if nothing was extracted." @@ -201,12 +201,12 @@ Return nil if nothing was extracted." ;;; Include Extractor must extract now. ;; -(cl-defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-include)) +(cl-defmethod srecode-inserter-do-extract-p ((_ins srecode-template-inserter-include)) "Return non-nil if this inserter can extract values." 'now) (cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter-include) - start end dict state) + start _end dict state) "Extract text from START/END and store in DICT. Return the starting location of the first plain-text match. Return nil if nothing was extracted." diff --git a/lisp/cedet/srecode/fields.el b/lisp/cedet/srecode/fields.el index 71613bcc2a3..e65e3194320 100644 --- a/lisp/cedet/srecode/fields.el +++ b/lisp/cedet/srecode/fields.el @@ -1,4 +1,4 @@ -;;; srecode/fields.el --- Handling type-in fields in a buffer. +;;; srecode/fields.el --- Handling type-in fields in a buffer. -*- lexical-binding: t; -*- ;; ;; Copyright (C) 2009-2021 Free Software Foundation, Inc. ;; @@ -193,7 +193,7 @@ If SET-TO is a string, then replace the text of OLAID with SET-TO." "Manage a buffer region in which fields exist.") (cl-defmethod initialize-instance ((ir srecode-template-inserted-region) - &rest args) + &rest _args) "Initialize IR, capturing the active fields, and creating the overlay." ;; Fill in the fields (oset ir fields srecode-field-archive) @@ -221,7 +221,7 @@ If SET-TO is a string, then replace the text of OLAID with SET-TO." (oset ir active-region ir) ;; Setup the post command hook. - (add-hook 'post-command-hook 'srecode-field-post-command t t) + (add-hook 'post-command-hook #'srecode-field-post-command t t) ) (cl-defmethod srecode-delete ((ir srecode-template-inserted-region)) @@ -229,12 +229,11 @@ If SET-TO is a string, then replace the text of OLAID with SET-TO." ;; Clear us out of the baseclass. (oset ir active-region nil) ;; Clear our fields. - (mapc 'srecode-delete (oref ir fields)) + (mapc #'srecode-delete (oref ir fields)) ;; Call to our base (cl-call-next-method) ;; Clear our hook. - (remove-hook 'post-command-hook 'srecode-field-post-command t) - ) + (remove-hook 'post-command-hook #'srecode-field-post-command t)) (defsubst srecode-active-template-region () "Return the active region for template fields." @@ -246,7 +245,7 @@ If SET-TO is a string, then replace the text of OLAID with SET-TO." ) (if (not ar) ;; Find a bug and fix it. - (remove-hook 'post-command-hook 'srecode-field-post-command t) + (remove-hook 'post-command-hook #'srecode-field-post-command t) (if (srecode-point-in-region-p ar) nil ;; Keep going ;; We moved out of the template. Cancel the edits. @@ -277,16 +276,16 @@ Try to use this to provide useful completion when available.") (defvar srecode-field-keymap (let ((km (make-sparse-keymap))) - (define-key km "\C-i" 'srecode-field-next) - (define-key km "\M-\C-i" 'srecode-field-prev) - (define-key km "\C-e" 'srecode-field-end) - (define-key km "\C-a" 'srecode-field-start) - (define-key km "\M-m" 'srecode-field-start) - (define-key km "\C-c\C-c" 'srecode-field-exit-ask) + (define-key km "\C-i" #'srecode-field-next) + (define-key km "\M-\C-i" #'srecode-field-prev) + (define-key km "\C-e" #'srecode-field-end) + (define-key km "\C-a" #'srecode-field-start) + (define-key km "\M-m" #'srecode-field-start) + (define-key km "\C-c\C-c" #'srecode-field-exit-ask) km) "Keymap applied to field overlays.") -(cl-defmethod initialize-instance ((field srecode-field) &optional args) +(cl-defmethod initialize-instance ((field srecode-field) &optional _args) "Initialize FIELD, being sure it archived." (add-to-list 'srecode-field-archive field t) (cl-call-next-method) @@ -327,7 +326,7 @@ Try to use this to provide useful completion when available.") (defvar srecode-field-replication-max-size 100 "Maximum size of a field before canceling replication.") -(defun srecode-field-mod-hook (ol after start end &optional pre-len) +(defun srecode-field-mod-hook (ol after _start _end &optional _pre-len) "Modification hook for the field overlay. OL is the overlay. AFTER is non-nil if it is called after the change. @@ -374,7 +373,7 @@ AFTER is non-nil if it is called after the change. START and END are the bounds of the change. PRE-LEN is used in the after mode for the length of the changed text." (when after - (let* ((field (overlay-get ol 'srecode)) + (let* (;; (field (overlay-get ol 'srecode)) ) (move-overlay ol (overlay-start ol) end) (srecode-field-mod-hook ol after start end pre-len)) diff --git a/lisp/cedet/srecode/filters.el b/lisp/cedet/srecode/filters.el index 4a996cf6f12..b76ce2c94bf 100644 --- a/lisp/cedet/srecode/filters.el +++ b/lisp/cedet/srecode/filters.el @@ -1,4 +1,4 @@ -;;; srecode/filters.el --- Filters for use in template variables. +;;; srecode/filters.el --- Filters for use in template variables. -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. diff --git a/lisp/cedet/srecode/find.el b/lisp/cedet/srecode/find.el index aec73dce5a5..1c208d0f328 100644 --- a/lisp/cedet/srecode/find.el +++ b/lisp/cedet/srecode/find.el @@ -1,4 +1,4 @@ -;;;; srecode/find.el --- Tools for finding templates in the database. +;;;; srecode/find.el --- Tools for finding templates in the database. -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. @@ -58,17 +58,14 @@ See `srecode-get-maps' for more. APPNAME is the name of an application. In this case, all template files for that application will be loaded." (let ((files - (if appname - (apply 'append - (mapcar + (apply #'append + (mapcar + (if appname (lambda (map) (srecode-map-entries-for-app-and-mode map appname mmode)) - (srecode-get-maps))) - (apply 'append - (mapcar (lambda (map) - (srecode-map-entries-for-mode map mmode)) - (srecode-get-maps))))) + (srecode-map-entries-for-mode map mmode))) + (srecode-get-maps)))) ) ;; Don't recurse if we are already the 'default state. (when (not (eq mmode 'default)) @@ -112,8 +109,8 @@ If TAB is nil, then always return t." ;; Find a given template based on name, and features of the current ;; buffer. (cl-defmethod srecode-template-get-table ((tab srecode-template-table) - template-name &optional - context application) + template-name &optional + context _application) "Find in the template in table TAB, the template with TEMPLATE-NAME. Optional argument CONTEXT specifies that the template should part of a particular context. @@ -218,7 +215,7 @@ tables that do not belong to an application will be searched." (defvar srecode-read-template-name-history nil "History for completing reads for template names.") -(defun srecode-user-template-p (template) +(defun srecode-user-template-p (_template) "Non-nil if TEMPLATE is intended for user insertion. Templates not matching this predicate are used for code generation or other internal purposes." @@ -264,7 +261,7 @@ with `srecode-calculate-context'." ;; the prefix for the completing read (concat (nth 0 ctxt) ":")))) -(defun srecode-read-template-name (prompt &optional initial hist default) +(defun srecode-read-template-name (prompt &optional initial hist _default) "Completing read for Semantic Recoder template names. PROMPT is used to query for the name of the template desired. INITIAL is the initial string to use. diff --git a/lisp/cedet/srecode/getset.el b/lisp/cedet/srecode/getset.el index 1e4888655f9..ce4c818c709 100644 --- a/lisp/cedet/srecode/getset.el +++ b/lisp/cedet/srecode/getset.el @@ -1,4 +1,4 @@ -;;; srecode/getset.el --- Package for inserting new get/set methods. +;;; srecode/getset.el --- Package for inserting new get/set methods. -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. @@ -33,6 +33,8 @@ (defvar srecode-insert-getset-fully-automatic-flag nil "Non-nil means accept choices srecode comes up with without asking.") +(defvar srecode-semantic-selected-tag) + ;;;###autoload (defun srecode-insert-getset (&optional class-in field-in) "Insert get/set methods for the current class. diff --git a/lisp/cedet/srecode/insert.el b/lisp/cedet/srecode/insert.el index ab0503c8d36..f20842b1d8a 100644 --- a/lisp/cedet/srecode/insert.el +++ b/lisp/cedet/srecode/insert.el @@ -89,6 +89,8 @@ DICT-ENTRIES are additional dictionary values to add." ;; for this insertion step. )) +(eieio-declare-slots (point :allocation :class)) + (defun srecode-insert-fcn (template dictionary &optional stream skipresolver) "Insert TEMPLATE using DICTIONARY into STREAM. Optional SKIPRESOLVER means to avoid refreshing the tag list, @@ -134,13 +136,13 @@ has set everything up already." ) (srecode-insert-method template dictionary)) ;; Handle specialization of the POINT inserter. - (when (and (bufferp standard-output) - (slot-boundp 'srecode-template-inserter-point 'point) - ) - (set-buffer standard-output) - (setq end-mark (point-marker)) - (goto-char (oref-default 'srecode-template-inserter-point point))) - (oset-default 'srecode-template-inserter-point point eieio-unbound) + (when (bufferp standard-output) + (let ((point (oref-default 'srecode-template-inserter-point point))) + (when point + (set-buffer standard-output) + (setq end-mark (point-marker)) + (goto-char point)))) + (oset-default 'srecode-template-inserter-point point nil) ;; Return the end-mark. (or end-mark (point))) @@ -733,6 +735,7 @@ DEPTH.") "The character code used to identify inserters of this style.") (point :type (or null marker) :allocation :class + :initform nil :documentation "Record the value of (point) in this class slot. It is the responsibility of the inserter algorithm to clear this diff --git a/lisp/cedet/srecode/java.el b/lisp/cedet/srecode/java.el index 768d48a7c5b..0f0a80ee299 100644 --- a/lisp/cedet/srecode/java.el +++ b/lisp/cedet/srecode/java.el @@ -1,4 +1,4 @@ -;;; srecode/java.el --- Srecode Java support +;;; srecode/java.el --- Srecode Java support -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2021 Free Software Foundation, Inc. diff --git a/lisp/cedet/srecode/map.el b/lisp/cedet/srecode/map.el index a94db0bb8d9..254b15e6e04 100644 --- a/lisp/cedet/srecode/map.el +++ b/lisp/cedet/srecode/map.el @@ -1,4 +1,4 @@ -;;; srecode/map.el --- Manage a template file map +;;; srecode/map.el --- Manage a template file map -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -245,7 +245,7 @@ Optional argument RESET forces a reset of the current map." (princ "\n") )) -(defun srecode-map-file-still-valid-p (filename map) +(defun srecode-map-file-still-valid-p (filename _map) "Return t if FILENAME should be in MAP still." (let ((valid nil)) (and (file-exists-p filename) @@ -407,7 +407,7 @@ Return non-nil if the map changed." "Global load path for SRecode template files." :group 'srecode :type '(repeat file) - :set 'srecode-map-load-path-set) + :set #'srecode-map-load-path-set) (provide 'srecode/map) diff --git a/lisp/cedet/srecode/mode.el b/lisp/cedet/srecode/mode.el index 159dc7a999b..9b1c8491a12 100644 --- a/lisp/cedet/srecode/mode.el +++ b/lisp/cedet/srecode/mode.el @@ -1,4 +1,4 @@ -;;; srecode/mode.el --- Minor mode for managing and using SRecode templates +;;; srecode/mode.el --- Minor mode for managing and using SRecode templates -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -54,14 +54,14 @@ (defvar srecode-prefix-map (let ((km (make-sparse-keymap))) ;; Basic template codes - (define-key km "/" 'srecode-insert) - (define-key km [insert] 'srecode-insert) - (define-key km "." 'srecode-insert-again) - (define-key km "E" 'srecode-edit) + (define-key km "/" #'srecode-insert) + (define-key km [insert] #'srecode-insert) + (define-key km "." #'srecode-insert-again) + (define-key km "E" #'srecode-edit) ;; Template indirect binding (let ((k ?a)) (while (<= k ?z) - (define-key km (format "%c" k) 'srecode-bind-insert) + (define-key km (format "%c" k) #'srecode-bind-insert) (setq k (1+ k)))) km) "Keymap used behind the srecode prefix key in srecode minor mode.") @@ -141,16 +141,17 @@ non-nil if the minor mode is enabled. ;; this mode first. (if srecode-minor-mode (if (not (apply - 'append + #'append (mapcar (lambda (map) (srecode-map-entries-for-mode map major-mode)) (srecode-get-maps)))) (setq srecode-minor-mode nil) ;; Else, we have success, do stuff - (add-hook 'cedet-m3-menu-do-hooks 'srecode-m3-items nil t) - ) - (remove-hook 'cedet-m3-menu-do-hooks 'srecode-m3-items t) - ) + ;; FIXME: Where are `cedet-m3-menu-do-hooks' nor `srecode-m3-items'? + (when (fboundp 'srecode-m3-items) + (add-hook 'cedet-m3-menu-do-hooks #'srecode-m3-items nil t))) + (when (fboundp 'srecode-m3-items) + (remove-hook 'cedet-m3-menu-do-hooks #'srecode-m3-items t))) ;; Run hooks if we are turning this on. (when srecode-minor-mode (run-hooks 'srecode-minor-mode-hook)) @@ -170,7 +171,7 @@ non-nil if the minor mode is enabled. ;;; Menu Filters ;; -(defun srecode-minor-mode-templates-menu (menu-def) +(defun srecode-minor-mode-templates-menu (_menu-def) "Create a menu item of cascading filters active for this mode. MENU-DEF is the menu to bind this into." ;; Doing this SEGVs Emacs on windows. @@ -223,13 +224,11 @@ MENU-DEF is the menu to bind this into." (if bind (concat name " (" bind ")") name) - `(lambda () (interactive) - (srecode-insert (concat ,ctxt ":" ,name))) + (lambda () (interactive) + (srecode-insert (concat ctxt ":" name))) t))) - (setcdr ctxtcons (cons - new - (cdr ctxtcons))))) + (push new (cdr ctxtcons)))) (setq ltab (cdr ltab)))) (setq subtab (cdr subtab))) @@ -246,7 +245,7 @@ MENU-DEF is the menu to bind this into." (defvar srecode-minor-mode-generators nil "List of code generators to be displayed in the srecoder menu.") -(defun srecode-minor-mode-generate-menu (menu-def) +(defun srecode-minor-mode-generate-menu (_menu-def) "Create a menu item of cascading filters active for this mode. MENU-DEF is the menu to bind this into." ;; Doing this SEGVs Emacs on windows. diff --git a/lisp/cedet/srecode/srt-mode.el b/lisp/cedet/srecode/srt-mode.el index bbe1e5e469c..71579158494 100644 --- a/lisp/cedet/srecode/srt-mode.el +++ b/lisp/cedet/srecode/srt-mode.el @@ -1,4 +1,4 @@ -;;; srecode/srt-mode.el --- Major mode for writing screcode macros +;;; srecode/srt-mode.el --- Major mode for writing screcode macros -*- lexical-binding: t; -*- ;; Copyright (C) 2005, 2007-2021 Free Software Foundation, Inc. @@ -181,9 +181,9 @@ we can tell font lock about them.") (defvar srecode-template-mode-map (let ((km (make-sparse-keymap))) - (define-key km "\C-c\C-c" 'srecode-compile-templates) - (define-key km "\C-c\C-m" 'srecode-macro-help) - (define-key km "/" 'srecode-self-insert-complete-end-macro) + (define-key km "\C-c\C-c" #'srecode-compile-templates) + (define-key km "\C-c\C-m" #'srecode-macro-help) + (define-key km "/" #'srecode-self-insert-complete-end-macro) km) "Keymap used in srecode mode.") @@ -205,7 +205,7 @@ we can tell font lock about them.") ((?_ . "w") (?- . "w"))))) ;;;###autoload -(defalias 'srt-mode 'srecode-template-mode) +(defalias 'srt-mode #'srecode-template-mode) ;;; Template Commands ;; @@ -436,7 +436,7 @@ Moves to the end of one named section." (when point (goto-char (point))) (let* ((tag (semantic-current-tag)) (args (semantic-tag-function-arguments tag)) - (argsym (mapcar 'intern args)) + (argsym (mapcar #'intern args)) (argvars nil) ;; Create a temporary dictionary in which the ;; arguments can be resolved so we can extract @@ -475,7 +475,7 @@ section or ? for an ask variable." (ee (regexp-quote (srecode-template-get-escape-end))) (start (point)) (macrostart nil) - (raw nil) + ;; (raw nil) ) (when (and tag (semantic-tag-of-class-p tag 'function) (srecode-in-macro-p point) @@ -627,7 +627,7 @@ section or ? for an ask variable." context-return))) (define-mode-local-override semantic-analyze-possible-completions - srecode-template-mode (context &rest flags) + srecode-template-mode (context &rest _flags) "Return a list of possible completions based on NONTEXT." (with-current-buffer (oref context buffer) (let* ((prefix (car (last (oref context prefix)))) diff --git a/lisp/cedet/srecode/srt.el b/lisp/cedet/srecode/srt.el index e222997708b..161b5105b51 100644 --- a/lisp/cedet/srecode/srt.el +++ b/lisp/cedet/srecode/srt.el @@ -1,4 +1,4 @@ -;;; srecode/srt.el --- argument handlers for SRT files +;;; srecode/srt.el --- argument handlers for SRT files -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -43,7 +43,7 @@ DEFAULT is the default if RET is hit." (currfcn (semantic-current-tag)) ) (srecode-resolve-argument-list - (mapcar 'read + (mapcar #'read (semantic-tag-get-attribute currfcn :arguments)) newdict) @@ -56,7 +56,7 @@ DEFAULT is the default if RET is hit." (defvar srecode-read-major-mode-history nil "History for `srecode-read-variable-name'.") -(defun srecode-read-major-mode-name (prompt &optional initial hist default) +(defun srecode-read-major-mode-name (prompt &optional initial hist _default) "Read in the name of a desired `major-mode'. PROMPT is the prompt to use. INITIAL is the initial string. @@ -64,7 +64,7 @@ HIST is the history value, otherwise `srecode-read-variable-name-history' is used. DEFAULT is the default if RET is hit." (completing-read prompt obarray - (lambda (s) (string-match "-mode$" (symbol-name s))) + (lambda (s) (string-match "-mode\\'" (symbol-name s))) nil initial (or hist 'srecode-read-major-mode-history)) ) diff --git a/lisp/cedet/srecode/table.el b/lisp/cedet/srecode/table.el index 60a466f89d9..7ce5cc73b61 100644 --- a/lisp/cedet/srecode/table.el +++ b/lisp/cedet/srecode/table.el @@ -1,4 +1,4 @@ -;;; srecode/table.el --- Tables of Semantic Recoders +;;; srecode/table.el --- Tables of Semantic Recoders -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. @@ -169,7 +169,7 @@ calculate all inherited templates from parent modes." :modetables nil :tables nil))) ;; Save this new mode table in that mode's variable. - (eval `(setq-mode-local ,mode srecode-table ,new)) + (eval `(setq-mode-local ,mode srecode-table ,new) t) new)))) @@ -184,7 +184,7 @@ INIT are the initialization parameters for the new template table." (let* ((mt (srecode-make-mode-table mode)) (old (srecode-mode-table-find mt file)) (attr (file-attributes file)) - (new (apply 'srecode-template-table + (new (apply #'srecode-template-table (file-name-nondirectory file) :file file :filesize (file-attribute-size attr) diff --git a/lisp/cedet/srecode/template.el b/lisp/cedet/srecode/template.el index e9e5115128f..1f6f0d345da 100644 --- a/lisp/cedet/srecode/template.el +++ b/lisp/cedet/srecode/template.el @@ -1,4 +1,4 @@ -;;; srecode/template.el --- SRecoder template language parser support. +;;; srecode/template.el --- SRecoder template language parser support. -*- lexical-binding: t; -*- ;; Copyright (C) 2005, 2007-2021 Free Software Foundation, Inc. @@ -49,11 +49,11 @@ (setq ;; Lexical Analysis - semantic-lex-analyzer 'wisent-srecode-template-lexer + semantic-lex-analyzer #'wisent-srecode-template-lexer ;; Parsing ;; 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 "\n" semantic-lex-comment-regex ";;" ;; Speedbar diff --git a/lisp/cedet/srecode/texi.el b/lisp/cedet/srecode/texi.el index 892ae4e2e31..1312a55a898 100644 --- a/lisp/cedet/srecode/texi.el +++ b/lisp/cedet/srecode/texi.el @@ -1,4 +1,4 @@ -;;; srecode/texi.el --- Srecode texinfo support. +;;; srecode/texi.el --- Srecode texinfo support. -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -224,7 +224,7 @@ Takes a few very generic guesses as to what the formatting is." ;; Return our modified doc string. docstring)) -(defun srecode-texi-massage-to-texinfo (tag buffer string) +(defun srecode-texi-massage-to-texinfo (_tag buffer string) "Massage TAG's documentation from BUFFER as STRING. This is to take advantage of TeXinfo's markup symbols." (save-excursion |