aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2019-11-14 18:55:18 -0500
committerStefan Monnier2019-11-14 18:55:18 -0500
commit6ea1e35f6f8b89b979e660bf04bda1757c0cdff0 (patch)
tree11fd978be81fba06a3f17851b9a359a8e15fb476
parentc2cd8e6265b78a5f0be3335ea6d8868e80814db0 (diff)
downloademacs-6ea1e35f6f8b89b979e660bf04bda1757c0cdff0.tar.gz
emacs-6ea1e35f6f8b89b979e660bf04bda1757c0cdff0.zip
* lisp/cedet/semantic/db.el: Use lexical-binding
Also prefer setf over oset. (semanticdb-abstract-table-list): Always define. (semanticdb--inhibit-make-directory): Fix name of declaration to match name of variable actually used. (semanticdb-with-match-any-mode): Use `declare`. Add Edebug spec. (semanticdb-project-roots): Remove redundant :group.
-rw-r--r--lisp/cedet/semantic/db.el99
1 files changed, 50 insertions, 49 deletions
diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el
index 8847fcc7558..3b33f096b4e 100644
--- a/lisp/cedet/semantic/db.el
+++ b/lisp/cedet/semantic/db.el
@@ -1,4 +1,4 @@
1;;; semantic/db.el --- Semantic tag database manager 1;;; semantic/db.el --- Semantic tag database manager -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 2000-2019 Free Software Foundation, Inc. 3;; Copyright (C) 2000-2019 Free Software Foundation, Inc.
4 4
@@ -115,11 +115,11 @@ This table is the root of tables, and contains the minimum needed
115for a new table not associated with a buffer." 115for a new table not associated with a buffer."
116 :abstract t) 116 :abstract t)
117 117
118(cl-defmethod semanticdb-in-buffer-p ((obj semanticdb-abstract-table)) 118(cl-defmethod semanticdb-in-buffer-p ((_obj semanticdb-abstract-table))
119 "Return a nil, meaning abstract table OBJ is not in a buffer." 119 "Return a nil, meaning abstract table OBJ is not in a buffer."
120 nil) 120 nil)
121 121
122(cl-defmethod semanticdb-get-buffer ((obj semanticdb-abstract-table)) 122(cl-defmethod semanticdb-get-buffer ((_obj semanticdb-abstract-table))
123 "Return a buffer associated with OBJ. 123 "Return a buffer associated with OBJ.
124If the buffer is not in memory, load it with `find-file-noselect'." 124If the buffer is not in memory, load it with `find-file-noselect'."
125 nil) 125 nil)
@@ -136,23 +136,23 @@ This uses semanticdb to get a better file name."
136 ((and (stringp buffer-or-string) (file-exists-p buffer-or-string)) 136 ((and (stringp buffer-or-string) (file-exists-p buffer-or-string))
137 (expand-file-name buffer-or-string)))) 137 (expand-file-name buffer-or-string))))
138 138
139(cl-defmethod semanticdb-full-filename ((obj semanticdb-abstract-table)) 139(cl-defmethod semanticdb-full-filename ((_obj semanticdb-abstract-table))
140 "Fetch the full filename that OBJ refers to. 140 "Fetch the full filename that OBJ refers to.
141Abstract tables do not have file names associated with them." 141Abstract tables do not have file names associated with them."
142 nil) 142 nil)
143 143
144(cl-defmethod semanticdb-dirty-p ((obj semanticdb-abstract-table)) 144(cl-defmethod semanticdb-dirty-p ((_obj semanticdb-abstract-table))
145 "Return non-nil if OBJ is dirty." 145 "Return non-nil if OBJ is dirty."
146 nil) 146 nil)
147 147
148(cl-defmethod semanticdb-set-dirty ((obj semanticdb-abstract-table)) 148(cl-defmethod semanticdb-set-dirty ((_obj semanticdb-abstract-table))
149 "Mark the abstract table OBJ dirty. 149 "Mark the abstract table OBJ dirty.
150Abstract tables can not be marked dirty, as there is nothing 150Abstract tables can not be marked dirty, as there is nothing
151for them to synchronize against." 151for them to synchronize against."
152 ;; The abstract table can not be dirty. 152 ;; The abstract table can not be dirty.
153 nil) 153 nil)
154 154
155(cl-defmethod semanticdb-normalize-tags ((obj semanticdb-abstract-table) tags) 155(cl-defmethod semanticdb-normalize-tags ((_obj semanticdb-abstract-table) tags)
156 "For the table OBJ, convert a list of TAGS, into standardized form. 156 "For the table OBJ, convert a list of TAGS, into standardized form.
157The default is to return TAGS. 157The default is to return TAGS.
158Some databases may default to searching and providing simplified tags 158Some databases may default to searching and providing simplified tags
@@ -194,17 +194,18 @@ If one doesn't exist, create it."
194 ;; Fill in the defaults 194 ;; Fill in the defaults
195 :table obj 195 :table obj
196 )) 196 ))
197 (oset obj index idx) 197 (setf (slot-value obj 'index) idx)
198 idx))) 198 idx)))
199 199
200(cl-defmethod semanticdb-synchronize ((idx semanticdb-abstract-search-index) 200(cl-defmethod semanticdb-synchronize ((_idx semanticdb-abstract-search-index)
201 new-tags) 201 _new-tags)
202 "Synchronize the search index IDX with some NEW-TAGS." 202 "Synchronize the search index IDX with some NEW-TAGS."
203 ;; The abstract class will do... NOTHING! 203 ;; The abstract class will do... NOTHING!
204 ) 204 )
205 205
206(cl-defmethod semanticdb-partial-synchronize ((idx semanticdb-abstract-search-index) 206(cl-defmethod semanticdb-partial-synchronize
207 new-tags) 207 ((_idx semanticdb-abstract-search-index)
208 _new-tags)
208 "Synchronize the search index IDX with some changed NEW-TAGS." 209 "Synchronize the search index IDX with some changed NEW-TAGS."
209 ;; The abstract class will do... NOTHING! 210 ;; The abstract class will do... NOTHING!
210 ) 211 )
@@ -221,7 +222,8 @@ If one doesn't exist, create it."
221Examples include search results from external sources such as from 222Examples include search results from external sources such as from
222Emacs's own symbol table, or from external libraries.") 223Emacs's own symbol table, or from external libraries.")
223 224
224(cl-defmethod semanticdb-refresh-table ((obj semanticdb-search-results-table) &optional force) 225(cl-defmethod semanticdb-refresh-table ((_obj semanticdb-search-results-table)
226 &optional _force)
225 "If the tag list associated with OBJ is loaded, refresh it. 227 "If the tag list associated with OBJ is loaded, refresh it.
226This will call `semantic-fetch-tags' if that file is in memory." 228This will call `semantic-fetch-tags' if that file is in memory."
227 nil) 229 nil)
@@ -279,7 +281,7 @@ If the buffer is in memory, return that buffer."
279 (let ((buff (oref obj buffer))) 281 (let ((buff (oref obj buffer)))
280 (if (buffer-live-p buff) 282 (if (buffer-live-p buff)
281 buff 283 buff
282 (oset obj buffer nil)))) 284 (setf (slot-value obj 'buffer) nil))))
283 285
284(cl-defmethod semanticdb-get-buffer ((obj semanticdb-table)) 286(cl-defmethod semanticdb-get-buffer ((obj semanticdb-table))
285 "Return a buffer associated with OBJ. 287 "Return a buffer associated with OBJ.
@@ -301,7 +303,7 @@ If OBJ's file is not loaded, read it in first."
301 303
302(cl-defmethod semanticdb-set-dirty ((obj semanticdb-table)) 304(cl-defmethod semanticdb-set-dirty ((obj semanticdb-table))
303 "Mark the abstract table OBJ dirty." 305 "Mark the abstract table OBJ dirty."
304 (oset obj dirty t) 306 (setf (slot-value obj 'dirty) t)
305 ) 307 )
306 308
307(cl-defmethod semanticdb-debug-info ((obj semanticdb-table)) 309(cl-defmethod semanticdb-debug-info ((obj semanticdb-table))
@@ -319,9 +321,8 @@ Adds the number of tags in this file to the object print name."
319 321
320;;; DATABASE BASE CLASS 322;;; DATABASE BASE CLASS
321;; 323;;
322(unless (fboundp 'semanticdb-abstract-table-list-p) 324(cl-deftype semanticdb-abstract-table-list ()
323 (cl-deftype semanticdb-abstract-table-list () 325 '(list-of semanticdb-abstract-table))
324 '(list-of semanticdb-abstract-table)))
325 326
326(defclass semanticdb-project-database (eieio-instance-tracker) 327(defclass semanticdb-project-database (eieio-instance-tracker)
327 ((tracking-symbol :initform semanticdb-database-list) 328 ((tracking-symbol :initform semanticdb-database-list)
@@ -357,7 +358,7 @@ Note: This index will not be saved in a persistent file.")
357 (expand-file-name (oref obj file) 358 (expand-file-name (oref obj file)
358 (oref (oref obj parent-db) reference-directory))) 359 (oref (oref obj parent-db) reference-directory)))
359 360
360(cl-defmethod semanticdb-full-filename ((obj semanticdb-project-database)) 361(cl-defmethod semanticdb-full-filename ((_obj semanticdb-project-database))
361 "Fetch the full filename that OBJ refers to. 362 "Fetch the full filename that OBJ refers to.
362Abstract tables do not have file names associated with them." 363Abstract tables do not have file names associated with them."
363 nil) 364 nil)
@@ -385,7 +386,7 @@ Adds the number of tables in this file to the object print name."
385 (princ (eieio-object-name obj (semanticdb-debug-info obj)) 386 (princ (eieio-object-name obj (semanticdb-debug-info obj))
386 stream)) 387 stream))
387 388
388(cl-defmethod semanticdb-create-database ((dbc (subclass semanticdb-project-database)) directory) 389(cl-defmethod semanticdb-create-database ((_dbc (subclass semanticdb-project-database)) directory)
389 "Create a new semantic database of class DBC for DIRECTORY and return it. 390 "Create a new semantic database of class DBC for DIRECTORY and return it.
390If a database for DIRECTORY has already been created, return it. 391If a database for DIRECTORY has already been created, return it.
391If DIRECTORY doesn't exist, create a new one." 392If DIRECTORY doesn't exist, create a new one."
@@ -396,12 +397,12 @@ If DIRECTORY doesn't exist, create a new one."
396 :tables nil)) 397 :tables nil))
397 ;; Set this up here. We can't put it in the constructor because it 398 ;; Set this up here. We can't put it in the constructor because it
398 ;; would be saved, and we want DB files to be portable. 399 ;; would be saved, and we want DB files to be portable.
399 (oset db reference-directory (file-truename directory))) 400 (setf (slot-value db 'reference-directory) (file-truename directory)))
400 db)) 401 db))
401 402
402(cl-defmethod semanticdb-flush-database-tables ((db semanticdb-project-database)) 403(cl-defmethod semanticdb-flush-database-tables ((db semanticdb-project-database))
403 "Reset the tables in DB to be empty." 404 "Reset the tables in DB to be empty."
404 (oset db tables nil)) 405 (setf (slot-value db 'tables) nil))
405 406
406(cl-defmethod semanticdb-create-table ((db semanticdb-project-database) file) 407(cl-defmethod semanticdb-create-table ((db semanticdb-project-database) file)
407 "Create a new table in DB for FILE and return it. 408 "Create a new table in DB for FILE and return it.
@@ -416,7 +417,7 @@ If the table for FILE does not exist, create one."
416 (file-name-nondirectory file) 417 (file-name-nondirectory file)
417 :file (file-name-nondirectory file) 418 :file (file-name-nondirectory file)
418 )) 419 ))
419 (oset newtab parent-db db) 420 (setf (slot-value newtab 'parent-db) db)
420 (object-add-to-list db 'tables newtab t)) 421 (object-add-to-list db 'tables newtab t))
421 newtab)) 422 newtab))
422 423
@@ -495,14 +496,14 @@ other than :table."
495 "Remove from TABLE the cache object CACHE." 496 "Remove from TABLE the cache object CACHE."
496 (object-remove-from-list table 'cache cache)) 497 (object-remove-from-list table 'cache cache))
497 498
498(cl-defmethod semanticdb-synchronize ((cache semanticdb-abstract-cache) 499(cl-defmethod semanticdb-synchronize ((_cache semanticdb-abstract-cache)
499 new-tags) 500 _new-tags)
500 "Synchronize a CACHE with some NEW-TAGS." 501 "Synchronize a CACHE with some NEW-TAGS."
501 ;; The abstract class will do... NOTHING! 502 ;; The abstract class will do... NOTHING!
502 ) 503 )
503 504
504(cl-defmethod semanticdb-partial-synchronize ((cache semanticdb-abstract-cache) 505(cl-defmethod semanticdb-partial-synchronize ((_cache semanticdb-abstract-cache)
505 new-tags) 506 _new-tags)
506 "Synchronize a CACHE with some changed NEW-TAGS." 507 "Synchronize a CACHE with some changed NEW-TAGS."
507 ;; The abstract class will do... NOTHING! 508 ;; The abstract class will do... NOTHING!
508 ) 509 )
@@ -547,14 +548,14 @@ other than :table."
547 (object-remove-from-list db 'cache cache)) 548 (object-remove-from-list db 'cache cache))
548 549
549 550
550(cl-defmethod semanticdb-synchronize ((cache semanticdb-abstract-db-cache) 551(cl-defmethod semanticdb-synchronize ((_cache semanticdb-abstract-db-cache)
551 new-tags) 552 _new-tags)
552 "Synchronize a CACHE with some NEW-TAGS." 553 "Synchronize a CACHE with some NEW-TAGS."
553 ;; The abstract class will do... NOTHING! 554 ;; The abstract class will do... NOTHING!
554 ) 555 )
555 556
556(cl-defmethod semanticdb-partial-synchronize ((cache semanticdb-abstract-db-cache) 557(cl-defmethod semanticdb-partial-synchronize ((_cache semanticdb-abstract-db-cache)
557 new-tags) 558 _new-tags)
558 "Synchronize a CACHE with some changed NEW-TAGS." 559 "Synchronize a CACHE with some changed NEW-TAGS."
559 ;; The abstract class will do... NOTHING! 560 ;; The abstract class will do... NOTHING!
560 ) 561 )
@@ -622,17 +623,18 @@ The file associated with OBJ does not need to be in a buffer."
622(cl-defmethod semanticdb-synchronize ((table semanticdb-abstract-table) 623(cl-defmethod semanticdb-synchronize ((table semanticdb-abstract-table)
623 new-tags) 624 new-tags)
624 "Synchronize the table TABLE with some NEW-TAGS." 625 "Synchronize the table TABLE with some NEW-TAGS."
625 (oset table tags new-tags) 626 (setf (slot-value table 'tags) new-tags)
626 (oset table pointmax (point-max)) 627 (setf (slot-value table 'pointmax) (point-max))
627 (let ((fattr (file-attributes (semanticdb-full-filename table)))) 628 (let ((fattr (file-attributes (semanticdb-full-filename table))))
628 (oset table fsize (file-attribute-size fattr)) 629 (setf (slot-value table 'fsize) (file-attribute-size fattr))
629 (oset table lastmodtime (file-attribute-modification-time fattr)) 630 (setf (slot-value table 'lastmodtime)
630 ) 631 (file-attribute-modification-time fattr)))
632
631 ;; Assume it is now up to date. 633 ;; Assume it is now up to date.
632 (oset table unmatched-syntax semantic-unmatched-syntax-cache) 634 (setf (slot-value table 'unmatched-syntax) semantic-unmatched-syntax-cache)
633 ;; The lexical table should be good too. 635 ;; The lexical table should be good too.
634 (when (featurep 'semantic/lex-spp) 636 (when (featurep 'semantic/lex-spp)
635 (oset table lexical-table (semantic-lex-spp-save-table))) 637 (setf (slot-value table 'lexical-table) (semantic-lex-spp-save-table)))
636 ;; this implies dirtiness 638 ;; this implies dirtiness
637 (semanticdb-set-dirty table) 639 (semanticdb-set-dirty table)
638 640
@@ -655,16 +657,16 @@ The file associated with OBJ does not need to be in a buffer."
655 "Synchronize the table TABLE where some NEW-TAGS changed." 657 "Synchronize the table TABLE where some NEW-TAGS changed."
656 ;; You might think we need to reset the tags, but since the partial 658 ;; You might think we need to reset the tags, but since the partial
657 ;; parser splices the lists, we don't need to do anything 659 ;; parser splices the lists, we don't need to do anything
658 ;;(oset table tags new-tags) 660 ;;(setf (slot-value table 'tags) new-tags)
659 ;; We do need to mark ourselves dirty. 661 ;; We do need to mark ourselves dirty.
660 (semanticdb-set-dirty table) 662 (semanticdb-set-dirty table)
661 663
662 ;; The lexical table may be modified. 664 ;; The lexical table may be modified.
663 (when (featurep 'semantic/lex-spp) 665 (when (featurep 'semantic/lex-spp)
664 (oset table lexical-table (semantic-lex-spp-save-table))) 666 (setf (slot-value table 'lexical-table) (semantic-lex-spp-save-table)))
665 667
666 ;; Incremental parser doesn't monkey around with this. 668 ;; Incremental parser doesn't monkey around with this.
667 (oset table unmatched-syntax semantic-unmatched-syntax-cache) 669 (setf (slot-value table 'unmatched-syntax) semantic-unmatched-syntax-cache)
668 670
669 ;; Synchronize the index 671 ;; Synchronize the index
670 (when (slot-boundp table 'index) 672 (when (slot-boundp table 'index)
@@ -683,8 +685,8 @@ The file associated with OBJ does not need to be in a buffer."
683 685
684;;; SAVE/LOAD 686;;; SAVE/LOAD
685;; 687;;
686(cl-defmethod semanticdb-save-db ((DB semanticdb-project-database) 688(cl-defmethod semanticdb-save-db ((_DB semanticdb-project-database)
687 &optional suppress-questions) 689 &optional _suppress-questions)
688 "Cause a database to save itself. 690 "Cause a database to save itself.
689The database base class does not save itself persistently. 691The database base class does not save itself persistently.
690Subclasses could save themselves to a file, or to a database, or other 692Subclasses could save themselves to a file, or to a database, or other
@@ -702,7 +704,7 @@ form."
702 704
703;; This prevents Semanticdb from querying multiple times if the users 705;; This prevents Semanticdb from querying multiple times if the users
704;; answers "no" to creating the Semanticdb directory. 706;; answers "no" to creating the Semanticdb directory.
705(defvar semanticdb--inhibit-create-file-directory) 707(defvar semanticdb--inhibit-make-directory)
706 708
707(defun semanticdb-save-all-db () 709(defun semanticdb-save-all-db ()
708 "Save all semantic tag databases." 710 "Save all semantic tag databases."
@@ -710,7 +712,7 @@ form."
710 (unless noninteractive 712 (unless noninteractive
711 (message "Saving tag summaries...")) 713 (message "Saving tag summaries..."))
712 (let ((semanticdb--inhibit-make-directory noninteractive)) 714 (let ((semanticdb--inhibit-make-directory noninteractive))
713 (mapc 'semanticdb-save-db semanticdb-database-list)) 715 (mapc #'semanticdb-save-db semanticdb-database-list))
714 (unless noninteractive 716 (unless noninteractive
715 (message "Saving tag summaries...done"))) 717 (message "Saving tag summaries...done")))
716 718
@@ -737,7 +739,7 @@ Project Management software (such as EDE and JDE) should add their own
737predicates with `add-hook' to this variable, and semanticdb will save tag 739predicates with `add-hook' to this variable, and semanticdb will save tag
738caches in directories controlled by them.") 740caches in directories controlled by them.")
739 741
740(cl-defmethod semanticdb-write-directory-p ((obj semanticdb-project-database)) 742(cl-defmethod semanticdb-write-directory-p ((_obj semanticdb-project-database))
741 "Return non-nil if OBJ should be written to disk. 743 "Return non-nil if OBJ should be written to disk.
742Uses `semanticdb-persistent-path' to determine the return value." 744Uses `semanticdb-persistent-path' to determine the return value."
743 nil) 745 nil)
@@ -764,9 +766,9 @@ Do not set the value of this variable permanently.")
764(defmacro semanticdb-with-match-any-mode (&rest body) 766(defmacro semanticdb-with-match-any-mode (&rest body)
765 "A Semanticdb search occurring withing BODY will search tags in all modes. 767 "A Semanticdb search occurring withing BODY will search tags in all modes.
766This temporarily sets `semanticdb-match-any-mode' while executing BODY." 768This temporarily sets `semanticdb-match-any-mode' while executing BODY."
769 (declare (indent 0) (debug t))
767 `(let ((semanticdb-match-any-mode t)) 770 `(let ((semanticdb-match-any-mode t))
768 ,@body)) 771 ,@body))
769(put 'semanticdb-with-match-any-mode 'lisp-indent-function 0)
770 772
771(cl-defmethod semanticdb-equivalent-mode-for-search (table &optional buffer) 773(cl-defmethod semanticdb-equivalent-mode-for-search (table &optional buffer)
772 "Return non-nil if TABLE's mode is equivalent to BUFFER. 774 "Return non-nil if TABLE's mode is equivalent to BUFFER.
@@ -779,7 +781,7 @@ all files of any type."
779 (semanticdb-equivalent-mode table buffer)) 781 (semanticdb-equivalent-mode table buffer))
780 ) 782 )
781 783
782(cl-defmethod semanticdb-equivalent-mode ((table semanticdb-abstract-table) &optional buffer) 784(cl-defmethod semanticdb-equivalent-mode ((_table semanticdb-abstract-table) &optional _buffer)
783 "Return non-nil if TABLE's mode is equivalent to BUFFER. 785 "Return non-nil if TABLE's mode is equivalent to BUFFER.
784Equivalent modes are specified by the `semantic-equivalent-major-modes' 786Equivalent modes are specified by the `semantic-equivalent-major-modes'
785local variable." 787local variable."
@@ -813,7 +815,6 @@ local variable."
813All subdirectories of a root project are considered a part of one project. 815All subdirectories of a root project are considered a part of one project.
814Values in this string can be overridden by project management programs 816Values in this string can be overridden by project management programs
815via the `semanticdb-project-root-functions' variable." 817via the `semanticdb-project-root-functions' variable."
816 :group 'semanticdb
817 :type '(repeat string)) 818 :type '(repeat string))
818 819
819(defvar semanticdb-project-root-functions nil 820(defvar semanticdb-project-root-functions nil