diff options
| author | Stefan Monnier | 2023-11-06 19:05:40 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2023-11-09 00:33:52 -0500 |
| commit | 8323394bc801e01dedd95e0ff8d573dd1f5e34ba (patch) | |
| tree | a895207eafd180e6c9b7ff056e04b74ff1ab495d | |
| parent | 5afa55a946a0271c624359e9de5d62bcaf39729b (diff) | |
| download | emacs-8323394bc801e01dedd95e0ff8d573dd1f5e34ba.tar.gz emacs-8323394bc801e01dedd95e0ff8d573dd1f5e34ba.zip | |
Use `derived-mode-add-parents` in remaining uses of `derived-mode-parent`
Until now multiple inheritance wasn't really used, but some ad-hoc
code went a bit beyond the normal uses of the mode hierarchy.
Use the new multiple inheritance code to replace that ad-hoc code,
thereby eliminating basically all remaining direct uses of the
`derived-mode-parent` property.
CEDET had its own notion of mode hierrchy using `derived-mode-parent`
as well as its own `mode-local-parent` property set via
`define-child-mode`.
`derived-mode-add-parents` lets us reimplement `define-child-mode`
such that CEDET can now use the normal API functions.
* lisp/locate.el (locate-mode): Use `derived-mode-add-parents`.
* lisp/cedet/mode-local.el (get-mode-local-parent): Declare obsolete.
(mode-local-equivalent-mode-p, mode-local-use-bindings-p): Make them
obsolete aliases.
(mode-local--set-parent): Rewrite to use `derived-mode-add-parents`.
Declare as obsolete.
(mode-local-map-mode-buffers): Use `derived-mode-p`.
(mode-local-symbol, mode-local--activate-bindings)
(mode-local--deactivate-bindings, mode-local-describe-bindings-2):
Use `derived-mode-all-parents`.
* lisp/cedet/srecode/table.el (srecode-get-mode-table):
* lisp/cedet/srecode/find.el (srecode-table, srecode-load-tables-for-mode)
(srecode-all-template-hash): Use `derived-mode-all-parents`.
* lisp/cedet/srecode/map.el (srecode-map-entries-for-mode):
* lisp/cedet/semantic/db.el (semanticdb-equivalent-mode):
Use `provided-mode-derived-p` now that it obeys `define-child-mode`.
| -rw-r--r-- | lisp/cedet/mode-local.el | 65 | ||||
| -rw-r--r-- | lisp/cedet/semantic/db.el | 2 | ||||
| -rw-r--r-- | lisp/cedet/semantic/grammar.el | 2 | ||||
| -rw-r--r-- | lisp/cedet/semantic/lex-spp.el | 6 | ||||
| -rw-r--r-- | lisp/cedet/srecode/find.el | 64 | ||||
| -rw-r--r-- | lisp/cedet/srecode/map.el | 2 | ||||
| -rw-r--r-- | lisp/cedet/srecode/table.el | 51 | ||||
| -rw-r--r-- | lisp/locate.el | 52 |
8 files changed, 96 insertions, 148 deletions
diff --git a/lisp/cedet/mode-local.el b/lisp/cedet/mode-local.el index c1a48bc50c8..4fb4460d4c6 100644 --- a/lisp/cedet/mode-local.el +++ b/lisp/cedet/mode-local.el | |||
| @@ -68,22 +68,15 @@ walk through. It defaults to `buffer-list'." | |||
| 68 | (when (or (not predicate) (funcall predicate)) | 68 | (when (or (not predicate) (funcall predicate)) |
| 69 | (funcall function)))))) | 69 | (funcall function)))))) |
| 70 | 70 | ||
| 71 | (defsubst get-mode-local-parent (mode) | 71 | (defun get-mode-local-parent (mode) |
| 72 | "Return the mode parent of the major mode MODE. | 72 | "Return the mode parent of the major mode MODE. |
| 73 | Return nil if MODE has no parent." | 73 | Return nil if MODE has no parent." |
| 74 | (declare (obsolete derived-mode-all-parents "30.1")) | ||
| 74 | (or (get mode 'mode-local-parent) | 75 | (or (get mode 'mode-local-parent) |
| 75 | (get mode 'derived-mode-parent))) | 76 | (get mode 'derived-mode-parent))) |
| 76 | 77 | ||
| 77 | ;; FIXME doc (and function name) seems wrong. | 78 | (define-obsolete-function-alias 'mode-local-equivalent-mode-p |
| 78 | ;; Return a list of MODE and all its parent modes, if any. | 79 | #'derived-mode-all-parents "30.1") |
| 79 | ;; Lists parent modes first. | ||
| 80 | (defun mode-local-equivalent-mode-p (mode) | ||
| 81 | "Is the major-mode in the current buffer equivalent to a mode in MODES." | ||
| 82 | (let ((modes nil)) | ||
| 83 | (while mode | ||
| 84 | (setq modes (cons mode modes) | ||
| 85 | mode (get-mode-local-parent mode))) | ||
| 86 | modes)) | ||
| 87 | 80 | ||
| 88 | (defun mode-local-map-mode-buffers (function modes) | 81 | (defun mode-local-map-mode-buffers (function modes) |
| 89 | "Run FUNCTION on every file buffer with major mode in MODES. | 82 | "Run FUNCTION on every file buffer with major mode in MODES. |
| @@ -91,13 +84,7 @@ MODES can be a symbol or a list of symbols. | |||
| 91 | FUNCTION does not have arguments." | 84 | FUNCTION does not have arguments." |
| 92 | (setq modes (ensure-list modes)) | 85 | (setq modes (ensure-list modes)) |
| 93 | (mode-local-map-file-buffers | 86 | (mode-local-map-file-buffers |
| 94 | function (lambda () | 87 | function (lambda () (apply #'derived-mode-p modes)))) |
| 95 | (let ((mm (mode-local-equivalent-mode-p major-mode)) | ||
| 96 | (ans nil)) | ||
| 97 | (while (and (not ans) mm) | ||
| 98 | (setq ans (memq (car mm) modes) | ||
| 99 | mm (cdr mm)) ) | ||
| 100 | ans)))) | ||
| 101 | 88 | ||
| 102 | ;;; Hook machinery | 89 | ;;; Hook machinery |
| 103 | ;; | 90 | ;; |
| @@ -145,7 +132,8 @@ after changing the major mode." | |||
| 145 | "Set parent of major mode MODE to PARENT mode. | 132 | "Set parent of major mode MODE to PARENT mode. |
| 146 | To work properly, this function should be called after PARENT mode | 133 | To work properly, this function should be called after PARENT mode |
| 147 | local variables have been defined." | 134 | local variables have been defined." |
| 148 | (put mode 'mode-local-parent parent) | 135 | (declare (obsolete derived-mode-add-parents "30.1")) |
| 136 | (derived-mode-add-parents mode (list parent)) | ||
| 149 | ;; Refresh mode bindings to get mode local variables inherited from | 137 | ;; Refresh mode bindings to get mode local variables inherited from |
| 150 | ;; PARENT. To work properly, the following should be called after | 138 | ;; PARENT. To work properly, the following should be called after |
| 151 | ;; PARENT mode local variables have been defined. | 139 | ;; PARENT mode local variables have been defined. |
| @@ -159,13 +147,8 @@ definition." | |||
| 159 | (declare (obsolete define-derived-mode "27.1") (indent 2)) | 147 | (declare (obsolete define-derived-mode "27.1") (indent 2)) |
| 160 | `(mode-local--set-parent ',mode ',parent)) | 148 | `(mode-local--set-parent ',mode ',parent)) |
| 161 | 149 | ||
| 162 | (defun mode-local-use-bindings-p (this-mode desired-mode) | 150 | (define-obsolete-function-alias 'mode-local-use-bindings-p |
| 163 | "Return non-nil if THIS-MODE can use bindings of DESIRED-MODE." | 151 | #'provided-mode-derived-p "30.1") |
| 164 | (let ((ans nil)) | ||
| 165 | (while (and (not ans) this-mode) | ||
| 166 | (setq ans (eq this-mode desired-mode)) | ||
| 167 | (setq this-mode (get-mode-local-parent this-mode))) | ||
| 168 | ans)) | ||
| 169 | 152 | ||
| 170 | 153 | ||
| 171 | ;;; Core bindings API | 154 | ;;; Core bindings API |
| @@ -270,11 +253,13 @@ its parents." | |||
| 270 | (setq mode major-mode | 253 | (setq mode major-mode |
| 271 | bind (and mode-local-symbol-table | 254 | bind (and mode-local-symbol-table |
| 272 | (intern-soft name mode-local-symbol-table)))) | 255 | (intern-soft name mode-local-symbol-table)))) |
| 273 | (while (and mode (not bind)) | 256 | (let ((parents (derived-mode-all-parents mode))) |
| 274 | (or (and (get mode 'mode-local-symbol-table) | 257 | (while (and parents (not bind)) |
| 275 | (setq bind (intern-soft | 258 | (or (and (get (car parents) 'mode-local-symbol-table) |
| 276 | name (get mode 'mode-local-symbol-table)))) | 259 | (setq bind (intern-soft |
| 277 | (setq mode (get-mode-local-parent mode)))) | 260 | name (get (car parents) |
| 261 | 'mode-local-symbol-table)))) | ||
| 262 | (setq parents (cdr parents))))) | ||
| 278 | bind)) | 263 | bind)) |
| 279 | 264 | ||
| 280 | (defsubst mode-local-symbol-value (symbol &optional mode property) | 265 | (defsubst mode-local-symbol-value (symbol &optional mode property) |
| @@ -311,16 +296,12 @@ Elements are (SYMBOL . PREVIOUS-VALUE), describing one variable." | |||
| 311 | (mode-local-on-major-mode-change) | 296 | (mode-local-on-major-mode-change) |
| 312 | 297 | ||
| 313 | ;; Do the normal thing. | 298 | ;; Do the normal thing. |
| 314 | (let (modes table old-locals) | 299 | (let (table old-locals) |
| 315 | (unless mode | 300 | (unless mode |
| 316 | (setq-local mode-local--init-mode major-mode) | 301 | (setq-local mode-local--init-mode major-mode) |
| 317 | (setq mode major-mode)) | 302 | (setq mode major-mode)) |
| 318 | ;; Get MODE's parents & MODE in the right order. | ||
| 319 | (while mode | ||
| 320 | (setq modes (cons mode modes) | ||
| 321 | mode (get-mode-local-parent mode))) | ||
| 322 | ;; Activate mode bindings following parent modes order. | 303 | ;; Activate mode bindings following parent modes order. |
| 323 | (dolist (mode modes) | 304 | (dolist (mode (derived-mode-all-parents mode)) |
| 324 | (when (setq table (get mode 'mode-local-symbol-table)) | 305 | (when (setq table (get mode 'mode-local-symbol-table)) |
| 325 | (mapatoms | 306 | (mapatoms |
| 326 | (lambda (var) | 307 | (lambda (var) |
| @@ -345,14 +326,13 @@ If MODE is not specified it defaults to current `major-mode'." | |||
| 345 | (kill-local-variable 'mode-local--init-mode) | 326 | (kill-local-variable 'mode-local--init-mode) |
| 346 | (setq mode major-mode)) | 327 | (setq mode major-mode)) |
| 347 | (let (table) | 328 | (let (table) |
| 348 | (while mode | 329 | (dolist (mode (derived-mode-all-parents mode)) |
| 349 | (when (setq table (get mode 'mode-local-symbol-table)) | 330 | (when (setq table (get mode 'mode-local-symbol-table)) |
| 350 | (mapatoms | 331 | (mapatoms |
| 351 | (lambda (var) | 332 | (lambda (var) |
| 352 | (when (get var 'mode-variable-flag) | 333 | (when (get var 'mode-variable-flag) |
| 353 | (kill-local-variable (intern (symbol-name var))))) | 334 | (kill-local-variable (intern (symbol-name var))))) |
| 354 | table)) | 335 | table))))) |
| 355 | (setq mode (get-mode-local-parent mode))))) | ||
| 356 | 336 | ||
| 357 | (defmacro with-mode-local-symbol (mode &rest body) | 337 | (defmacro with-mode-local-symbol (mode &rest body) |
| 358 | "With the local bindings of MODE symbol, evaluate BODY. | 338 | "With the local bindings of MODE symbol, evaluate BODY. |
| @@ -866,12 +846,11 @@ META-NAME is a cons (OVERLOADABLE-SYMBOL . MAJOR-MODE)." | |||
| 866 | (when table | 846 | (when table |
| 867 | (princ "\n- Buffer local\n") | 847 | (princ "\n- Buffer local\n") |
| 868 | (mode-local-print-bindings table)) | 848 | (mode-local-print-bindings table)) |
| 869 | (while mode | 849 | (dolist (mode (derived-mode-all-parents mode)) |
| 870 | (setq table (get mode 'mode-local-symbol-table)) | 850 | (setq table (get mode 'mode-local-symbol-table)) |
| 871 | (when table | 851 | (when table |
| 872 | (princ (format-message "\n- From `%s'\n" mode)) | 852 | (princ (format-message "\n- From `%s'\n" mode)) |
| 873 | (mode-local-print-bindings table)) | 853 | (mode-local-print-bindings table))))) |
| 874 | (setq mode (get-mode-local-parent mode))))) | ||
| 875 | 854 | ||
| 876 | (defun mode-local-describe-bindings-1 (buffer-or-mode &optional interactive-p) | 855 | (defun mode-local-describe-bindings-1 (buffer-or-mode &optional interactive-p) |
| 877 | "Display mode local bindings active in BUFFER-OR-MODE. | 856 | "Display mode local bindings active in BUFFER-OR-MODE. |
diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el index 7c7ee749249..0c78493542f 100644 --- a/lisp/cedet/semantic/db.el +++ b/lisp/cedet/semantic/db.el | |||
| @@ -799,7 +799,7 @@ local variable." | |||
| 799 | (null (oref table major-mode)) | 799 | (null (oref table major-mode)) |
| 800 | ;; nil means the same as major-mode | 800 | ;; nil means the same as major-mode |
| 801 | (and (not semantic-equivalent-major-modes) | 801 | (and (not semantic-equivalent-major-modes) |
| 802 | (mode-local-use-bindings-p major-mode (oref table major-mode))) | 802 | (provided-mode-derived-p major-mode (oref table major-mode))) |
| 803 | (and semantic-equivalent-major-modes | 803 | (and semantic-equivalent-major-modes |
| 804 | (member (oref table major-mode) semantic-equivalent-major-modes)) | 804 | (member (oref table major-mode) semantic-equivalent-major-modes)) |
| 805 | ) | 805 | ) |
diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index 60c57210b8f..15ad18ad886 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el | |||
| @@ -644,7 +644,7 @@ The symbols in the list are local variables in | |||
| 644 | (cond | 644 | (cond |
| 645 | (x (cdr x)) | 645 | (x (cdr x)) |
| 646 | ((symbolp S) (symbol-value S)))))) | 646 | ((symbolp S) (symbol-value S)))))) |
| 647 | template "")) | 647 | template)) |
| 648 | 648 | ||
| 649 | (defun semantic-grammar-header () | 649 | (defun semantic-grammar-header () |
| 650 | "Return text of a generated standard header." | 650 | "Return text of a generated standard header." |
diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el index 6a16845ecf2..35f09e7a784 100644 --- a/lisp/cedet/semantic/lex-spp.el +++ b/lisp/cedet/semantic/lex-spp.el | |||
| @@ -434,8 +434,7 @@ continue processing recursively." | |||
| 434 | (symbolp (car (car val)))) | 434 | (symbolp (car (car val)))) |
| 435 | (mapconcat (lambda (subtok) | 435 | (mapconcat (lambda (subtok) |
| 436 | (semantic-lex-spp-one-token-to-txt subtok)) | 436 | (semantic-lex-spp-one-token-to-txt subtok)) |
| 437 | val | 437 | val)) |
| 438 | "")) | ||
| 439 | ;; If val is nil, that's probably wrong. | 438 | ;; If val is nil, that's probably wrong. |
| 440 | ;; Found a system header case where this was true. | 439 | ;; Found a system header case where this was true. |
| 441 | ((null val) "") | 440 | ((null val) "") |
| @@ -699,8 +698,7 @@ be merged recursively." | |||
| 699 | (message "Invalid merge macro encountered; \ | 698 | (message "Invalid merge macro encountered; \ |
| 700 | will return empty string instead.") | 699 | will return empty string instead.") |
| 701 | ""))) | 700 | ""))) |
| 702 | txt | 701 | txt)) |
| 703 | "")) | ||
| 704 | 702 | ||
| 705 | (defun semantic-lex-spp-find-closing-macro () | 703 | (defun semantic-lex-spp-find-closing-macro () |
| 706 | "Find next macro which closes a scope through a close-paren. | 704 | "Find next macro which closes a scope through a close-paren. |
diff --git a/lisp/cedet/srecode/find.el b/lisp/cedet/srecode/find.el index cfd64edfc98..6d64a26e46c 100644 --- a/lisp/cedet/srecode/find.el +++ b/lisp/cedet/srecode/find.el | |||
| @@ -34,12 +34,12 @@ | |||
| 34 | (defun srecode-table (&optional mode) | 34 | (defun srecode-table (&optional mode) |
| 35 | "Return the currently active Semantic Recoder table for this buffer. | 35 | "Return the currently active Semantic Recoder table for this buffer. |
| 36 | Optional argument MODE specifies the mode table to use." | 36 | Optional argument MODE specifies the mode table to use." |
| 37 | (let* ((modeq (or mode major-mode)) | 37 | (let ((modes (derived-mode-all-parents (or mode major-mode))) |
| 38 | (table (srecode-get-mode-table modeq))) | 38 | (table nil)) |
| 39 | 39 | ||
| 40 | ;; If there isn't one, keep searching backwards for a table. | 40 | ;; If there isn't one, keep searching backwards for a table. |
| 41 | (while (and (not table) (setq modeq (get-mode-local-parent modeq))) | 41 | (while (and modes (not (setq table (srecode-get-mode-table (car modes))))) |
| 42 | (setq table (srecode-get-mode-table modeq))) | 42 | (setq modes (cdr modes))) |
| 43 | 43 | ||
| 44 | ;; Last ditch effort. | 44 | ;; Last ditch effort. |
| 45 | (when (not table) | 45 | (when (not table) |
| @@ -57,35 +57,23 @@ Templates are found in the SRecode Template Map. | |||
| 57 | See `srecode-get-maps' for more. | 57 | See `srecode-get-maps' for more. |
| 58 | APPNAME is the name of an application. In this case, | 58 | APPNAME is the name of an application. In this case, |
| 59 | all template files for that application will be loaded." | 59 | all template files for that application will be loaded." |
| 60 | (let ((files | 60 | (dolist (mmode (cons 'default (reverse (derived-mode-all-parents mmode)))) |
| 61 | (apply #'append | 61 | (let ((files |
| 62 | (mapcar | 62 | (apply #'append |
| 63 | (if appname | 63 | (mapcar |
| 64 | (if appname | ||
| 65 | (lambda (map) | ||
| 66 | (srecode-map-entries-for-app-and-mode map appname mmode)) | ||
| 64 | (lambda (map) | 67 | (lambda (map) |
| 65 | (srecode-map-entries-for-app-and-mode map appname mmode)) | 68 | (srecode-map-entries-for-mode map mmode))) |
| 66 | (lambda (map) | 69 | (srecode-get-maps))))) |
| 67 | (srecode-map-entries-for-mode map mmode))) | ||
| 68 | (srecode-get-maps)))) | ||
| 69 | ) | ||
| 70 | ;; Don't recurse if we are already the 'default state. | ||
| 71 | (when (not (eq mmode 'default)) | ||
| 72 | ;; Are we a derived mode? If so, get the parent mode's | ||
| 73 | ;; templates loaded too. | ||
| 74 | (if (get-mode-local-parent mmode) | ||
| 75 | (srecode-load-tables-for-mode (get-mode-local-parent mmode) | ||
| 76 | appname) | ||
| 77 | ;; No parent mode, all templates depend on the defaults being | ||
| 78 | ;; loaded in, so get that in instead. | ||
| 79 | (srecode-load-tables-for-mode 'default appname))) | ||
| 80 | 70 | ||
| 81 | ;; Load in templates for our major mode. | 71 | ;; Load in templates for our major mode. |
| 82 | (dolist (f files) | 72 | (when files |
| 83 | (let ((mt (srecode-get-mode-table mmode)) | 73 | (let ((mt (srecode-get-mode-table mmode))) |
| 84 | ) | 74 | (dolist (f files) |
| 85 | (when (or (not mt) (not (srecode-mode-table-find mt (car f)))) | 75 | (when (not (and mt (srecode-mode-table-find mt (car f)))) |
| 86 | (srecode-compile-file (car f))) | 76 | (srecode-compile-file (car f))))))))) |
| 87 | )) | ||
| 88 | )) | ||
| 89 | 77 | ||
| 90 | ;;; PROJECT | 78 | ;;; PROJECT |
| 91 | ;; | 79 | ;; |
| @@ -227,12 +215,12 @@ Optional argument MODE is the major mode to look for. | |||
| 227 | Optional argument HASH is the hash table to fill in. | 215 | Optional argument HASH is the hash table to fill in. |
| 228 | Optional argument PREDICATE can be used to filter the returned | 216 | Optional argument PREDICATE can be used to filter the returned |
| 229 | templates." | 217 | templates." |
| 230 | (let* ((mhash (or hash (make-hash-table :test 'equal))) | 218 | (let* ((mhash (or hash (make-hash-table :test 'equal)))) |
| 231 | (mmode (or mode major-mode)) | 219 | (dolist (mmode (cons 'default |
| 232 | (parent-mode (get-mode-local-parent mmode))) | 220 | ;; Get the parent hash table filled into our |
| 233 | ;; Get the parent hash table filled into our current hash. | 221 | ;; current hash. |
| 234 | (unless (eq mode 'default) | 222 | (reverse (derived-mode-all-parents |
| 235 | (srecode-all-template-hash (or parent-mode 'default) mhash)) | 223 | (or mode major-mode))))) |
| 236 | 224 | ||
| 237 | ;; Load up the hash table for our current mode. | 225 | ;; Load up the hash table for our current mode. |
| 238 | (let* ((mt (srecode-get-mode-table mmode)) | 226 | (let* ((mt (srecode-get-mode-table mmode)) |
| @@ -246,7 +234,7 @@ templates." | |||
| 246 | (funcall predicate temp)) | 234 | (funcall predicate temp)) |
| 247 | (puthash key temp mhash))) | 235 | (puthash key temp mhash))) |
| 248 | (oref tab namehash)))) | 236 | (oref tab namehash)))) |
| 249 | mhash))) | 237 | mhash)))) |
| 250 | 238 | ||
| 251 | (defun srecode-calculate-default-template-string (hash) | 239 | (defun srecode-calculate-default-template-string (hash) |
| 252 | "Calculate the name of the template to use as a DEFAULT. | 240 | "Calculate the name of the template to use as a DEFAULT. |
diff --git a/lisp/cedet/srecode/map.el b/lisp/cedet/srecode/map.el index 004bb7adddb..44e465c69b1 100644 --- a/lisp/cedet/srecode/map.el +++ b/lisp/cedet/srecode/map.el | |||
| @@ -76,7 +76,7 @@ Each app keys to an alist of files and modes (as above.)") | |||
| 76 | "Return the entries in MAP for major MODE." | 76 | "Return the entries in MAP for major MODE." |
| 77 | (let ((ans nil)) | 77 | (let ((ans nil)) |
| 78 | (dolist (f (oref map files)) | 78 | (dolist (f (oref map files)) |
| 79 | (when (mode-local-use-bindings-p mode (cdr f)) | 79 | (when (provided-mode-derived-p mode (cdr f)) |
| 80 | (setq ans (cons f ans)))) | 80 | (setq ans (cons f ans)))) |
| 81 | ans)) | 81 | ans)) |
| 82 | 82 | ||
diff --git a/lisp/cedet/srecode/table.el b/lisp/cedet/srecode/table.el index de151049f7f..e5ab53dd253 100644 --- a/lisp/cedet/srecode/table.el +++ b/lisp/cedet/srecode/table.el | |||
| @@ -137,41 +137,36 @@ Tracks all the template-tables for a specific major mode.") | |||
| 137 | "Get the SRecoder mode table for the major mode MODE. | 137 | "Get the SRecoder mode table for the major mode MODE. |
| 138 | This will find the mode table specific to MODE, and then | 138 | This will find the mode table specific to MODE, and then |
| 139 | calculate all inherited templates from parent modes." | 139 | calculate all inherited templates from parent modes." |
| 140 | (let ((table nil) | 140 | (let ((table nil)) |
| 141 | (tmptable nil)) | 141 | (dolist (mode (derived-mode-all-parents mode)) |
| 142 | (while mode | 142 | (let ((tmptable (eieio-instance-tracker-find |
| 143 | (setq tmptable (eieio-instance-tracker-find | 143 | mode 'major-mode 'srecode-mode-table-list))) |
| 144 | mode 'major-mode 'srecode-mode-table-list) | 144 | (when tmptable |
| 145 | mode (get-mode-local-parent mode)) | 145 | (if (not table) |
| 146 | (when tmptable | 146 | (progn |
| 147 | (if (not table) | 147 | ;; If this is the first, update tables to have |
| 148 | (progn | 148 | ;; all the mode specific tables in it. |
| 149 | ;; If this is the first, update tables to have | 149 | (setq table tmptable) |
| 150 | ;; all the mode specific tables in it. | 150 | (oset table tables (oref table modetables))) |
| 151 | (setq table tmptable) | 151 | ;; If there already is a table, then reset the tables |
| 152 | (oset table tables (oref table modetables))) | 152 | ;; slot to include all the tables belonging to this new child node. |
| 153 | ;; If there already is a table, then reset the tables | 153 | (oset table tables (append (oref table modetables) |
| 154 | ;; slot to include all the tables belonging to this new child node. | 154 | (oref tmptable modetables))))) |
| 155 | (oset table tables (append (oref table modetables) | 155 | )) |
| 156 | (oref tmptable modetables))))) | ||
| 157 | ) | ||
| 158 | table)) | 156 | table)) |
| 159 | 157 | ||
| 160 | (defun srecode-make-mode-table (mode) | 158 | (defun srecode-make-mode-table (mode) |
| 161 | "Get the SRecoder mode table for the major mode MODE." | 159 | "Get the SRecoder mode table for the major mode MODE." |
| 162 | (let ((old (eieio-instance-tracker-find | 160 | (let ((old (eieio-instance-tracker-find |
| 163 | mode 'major-mode 'srecode-mode-table-list))) | 161 | mode 'major-mode 'srecode-mode-table-list))) |
| 164 | (if old | 162 | (or old |
| 165 | old | 163 | (let* ((new (srecode-mode-table :major-mode mode |
| 166 | (let* ((ms (if (stringp mode) mode (symbol-name mode))) | 164 | :modetables nil |
| 167 | (new (srecode-mode-table ms | 165 | :tables nil))) |
| 168 | :major-mode mode | 166 | ;; Save this new mode table in that mode's variable. |
| 169 | :modetables nil | 167 | (eval `(setq-mode-local ,mode srecode-table ,new) t) |
| 170 | :tables nil))) | ||
| 171 | ;; Save this new mode table in that mode's variable. | ||
| 172 | (eval `(setq-mode-local ,mode srecode-table ,new) t) | ||
| 173 | 168 | ||
| 174 | new)))) | 169 | new)))) |
| 175 | 170 | ||
| 176 | (cl-defmethod srecode-mode-table-find ((mt srecode-mode-table) file) | 171 | (cl-defmethod srecode-mode-table-find ((mt srecode-mode-table) file) |
| 177 | "Look in the mode table MT for a template table from FILE. | 172 | "Look in the mode table MT for a template table from FILE. |
diff --git a/lisp/locate.el b/lisp/locate.el index 63386e18ebb..caccf644c02 100644 --- a/lisp/locate.el +++ b/lisp/locate.el | |||
| @@ -141,13 +141,11 @@ system, or of all files that you have access to. Consult the | |||
| 141 | documentation of that program for the details about how it determines | 141 | documentation of that program for the details about how it determines |
| 142 | which file names match SEARCH-STRING. (Those details vary highly with | 142 | which file names match SEARCH-STRING. (Those details vary highly with |
| 143 | the version.)" | 143 | the version.)" |
| 144 | :type 'string | 144 | :type 'string) |
| 145 | :group 'locate) | ||
| 146 | 145 | ||
| 147 | (defcustom locate-post-command-hook nil | 146 | (defcustom locate-post-command-hook nil |
| 148 | "List of hook functions run after `locate' (see `run-hooks')." | 147 | "List of hook functions run after `locate' (see `run-hooks')." |
| 149 | :type 'hook | 148 | :type 'hook) |
| 150 | :group 'locate) | ||
| 151 | 149 | ||
| 152 | (defvar locate-history-list nil | 150 | (defvar locate-history-list nil |
| 153 | "The history list used by the \\[locate] command.") | 151 | "The history list used by the \\[locate] command.") |
| @@ -162,13 +160,11 @@ This function should take one argument, a string (the name to find) | |||
| 162 | and return a list of strings. The first element of the list should be | 160 | and return a list of strings. The first element of the list should be |
| 163 | the name of a command to be executed by a shell, the remaining elements | 161 | the name of a command to be executed by a shell, the remaining elements |
| 164 | should be the arguments to that command (including the name to find)." | 162 | should be the arguments to that command (including the name to find)." |
| 165 | :type 'function | 163 | :type 'function) |
| 166 | :group 'locate) | ||
| 167 | 164 | ||
| 168 | (defcustom locate-buffer-name "*Locate*" | 165 | (defcustom locate-buffer-name "*Locate*" |
| 169 | "Name of the buffer to show results from the \\[locate] command." | 166 | "Name of the buffer to show results from the \\[locate] command." |
| 170 | :type 'string | 167 | :type 'string) |
| 171 | :group 'locate) | ||
| 172 | 168 | ||
| 173 | (defcustom locate-fcodes-file nil | 169 | (defcustom locate-fcodes-file nil |
| 174 | "File name for the database of file names used by `locate'. | 170 | "File name for the database of file names used by `locate'. |
| @@ -179,20 +175,17 @@ Just setting this variable does not actually change the database | |||
| 179 | that `locate' searches. The executive program that the Emacs | 175 | that `locate' searches. The executive program that the Emacs |
| 180 | function `locate' uses, as given by the variables `locate-command' | 176 | function `locate' uses, as given by the variables `locate-command' |
| 181 | or `locate-make-command-line', determines the database." | 177 | or `locate-make-command-line', determines the database." |
| 182 | :type '(choice (const :tag "None" nil) file) | 178 | :type '(choice (const :tag "None" nil) file)) |
| 183 | :group 'locate) | ||
| 184 | 179 | ||
| 185 | (defcustom locate-header-face nil | 180 | (defcustom locate-header-face nil |
| 186 | "Face used to highlight the locate header." | 181 | "Face used to highlight the locate header." |
| 187 | :type '(choice (const :tag "None" nil) face) | 182 | :type '(choice (const :tag "None" nil) face)) |
| 188 | :group 'locate) | ||
| 189 | 183 | ||
| 190 | ;;;###autoload | 184 | ;;;###autoload |
| 191 | (defcustom locate-ls-subdir-switches (purecopy "-al") | 185 | (defcustom locate-ls-subdir-switches (purecopy "-al") |
| 192 | "`ls' switches for inserting subdirectories in `*Locate*' buffers. | 186 | "`ls' switches for inserting subdirectories in `*Locate*' buffers. |
| 193 | This should contain the \"-l\" switch, but not the \"-F\" or \"-b\" switches." | 187 | This should contain the \"-l\" switch, but not the \"-F\" or \"-b\" switches." |
| 194 | :type 'string | 188 | :type 'string |
| 195 | :group 'locate | ||
| 196 | :version "22.1") | 189 | :version "22.1") |
| 197 | 190 | ||
| 198 | (defcustom locate-update-when-revert nil | 191 | (defcustom locate-update-when-revert nil |
| @@ -202,13 +195,11 @@ If non-nil, offer to update the locate database when reverting that buffer. | |||
| 202 | option `locate-update-path'.) | 195 | option `locate-update-path'.) |
| 203 | If nil, reverting does not update the locate database." | 196 | If nil, reverting does not update the locate database." |
| 204 | :type 'boolean | 197 | :type 'boolean |
| 205 | :group 'locate | ||
| 206 | :version "22.1") | 198 | :version "22.1") |
| 207 | 199 | ||
| 208 | (defcustom locate-update-command "updatedb" | 200 | (defcustom locate-update-command "updatedb" |
| 209 | "The executable program used to update the locate database." | 201 | "The executable program used to update the locate database." |
| 210 | :type 'string | 202 | :type 'string) |
| 211 | :group 'locate) | ||
| 212 | 203 | ||
| 213 | (defcustom locate-update-path "/" | 204 | (defcustom locate-update-path "/" |
| 214 | "The default directory from where `locate-update-command' is called. | 205 | "The default directory from where `locate-update-command' is called. |
| @@ -218,7 +209,6 @@ can be achieved by setting this option to \"/su::\" or \"/sudo::\" | |||
| 218 | permissions are sufficient to run the command, you can set this | 209 | permissions are sufficient to run the command, you can set this |
| 219 | option to \"/\"." | 210 | option to \"/\"." |
| 220 | :type 'string | 211 | :type 'string |
| 221 | :group 'locate | ||
| 222 | :version "22.1") | 212 | :version "22.1") |
| 223 | 213 | ||
| 224 | (defcustom locate-prompt-for-command nil | 214 | (defcustom locate-prompt-for-command nil |
| @@ -227,13 +217,11 @@ Otherwise, that behavior is invoked via a prefix argument. | |||
| 227 | 217 | ||
| 228 | Setting this option non-nil actually inverts the meaning of a prefix arg; | 218 | Setting this option non-nil actually inverts the meaning of a prefix arg; |
| 229 | that is, with a prefix arg, you get the default behavior." | 219 | that is, with a prefix arg, you get the default behavior." |
| 230 | :group 'locate | ||
| 231 | :type 'boolean) | 220 | :type 'boolean) |
| 232 | 221 | ||
| 233 | (defcustom locate-mode-hook nil | 222 | (defcustom locate-mode-hook nil |
| 234 | "List of hook functions run by `locate-mode' (see `run-mode-hooks')." | 223 | "List of hook functions run by `locate-mode' (see `run-mode-hooks')." |
| 235 | :type 'hook | 224 | :type 'hook) |
| 236 | :group 'locate) | ||
| 237 | 225 | ||
| 238 | ;; Functions | 226 | ;; Functions |
| 239 | 227 | ||
| @@ -371,17 +359,17 @@ except that FILTER is not optional." | |||
| 371 | (defvar locate-mode-map | 359 | (defvar locate-mode-map |
| 372 | (let ((map (copy-keymap dired-mode-map))) | 360 | (let ((map (copy-keymap dired-mode-map))) |
| 373 | ;; Undefine Useless Dired Menu bars | 361 | ;; Undefine Useless Dired Menu bars |
| 374 | (define-key map [menu-bar Dired] 'undefined) | 362 | (define-key map [menu-bar Dired] #'undefined) |
| 375 | (define-key map [menu-bar subdir] 'undefined) | 363 | (define-key map [menu-bar subdir] #'undefined) |
| 376 | (define-key map [menu-bar mark executables] 'undefined) | 364 | (define-key map [menu-bar mark executables] #'undefined) |
| 377 | (define-key map [menu-bar mark directory] 'undefined) | 365 | (define-key map [menu-bar mark directory] #'undefined) |
| 378 | (define-key map [menu-bar mark directories] 'undefined) | 366 | (define-key map [menu-bar mark directories] #'undefined) |
| 379 | (define-key map [menu-bar mark symlinks] 'undefined) | 367 | (define-key map [menu-bar mark symlinks] #'undefined) |
| 380 | (define-key map [M-mouse-2] 'locate-mouse-view-file) | 368 | (define-key map [M-mouse-2] #'locate-mouse-view-file) |
| 381 | (define-key map "\C-c\C-t" 'locate-tags) | 369 | (define-key map "\C-c\C-t" #'locate-tags) |
| 382 | (define-key map "l" 'locate-do-redisplay) | 370 | (define-key map "l" #'locate-do-redisplay) |
| 383 | (define-key map "U" 'dired-unmark-all-files) | 371 | (define-key map "U" #'dired-unmark-all-files) |
| 384 | (define-key map "V" 'locate-find-directory) | 372 | (define-key map "V" #'locate-find-directory) |
| 385 | map) | 373 | map) |
| 386 | "Local keymap for Locate mode buffers.") | 374 | "Local keymap for Locate mode buffers.") |
| 387 | 375 | ||
| @@ -486,7 +474,7 @@ do not work in subdirectories. | |||
| 486 | 474 | ||
| 487 | (setq-local revert-buffer-function #'locate-update) | 475 | (setq-local revert-buffer-function #'locate-update) |
| 488 | (setq-local page-delimiter "\n\n")) | 476 | (setq-local page-delimiter "\n\n")) |
| 489 | (put 'locate-mode 'derived-mode-parent 'dired-mode) | 477 | (derived-mode-add-parents 'locate-mode '(dired-mode special-mode)) |
| 490 | 478 | ||
| 491 | (defun locate-do-setup (search-string) | 479 | (defun locate-do-setup (search-string) |
| 492 | (goto-char (point-min)) | 480 | (goto-char (point-min)) |