diff options
| author | Stefan Monnier | 2019-10-23 17:48:41 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2019-10-23 17:48:41 -0400 |
| commit | 53e7a763dd16509d90418bdf14d161db13271ea3 (patch) | |
| tree | 8e026692466ad086266fdac02cb40714da92e5c7 | |
| parent | 042fd120cc5988b15eae98b5dbcd9c2d62f968e6 (diff) | |
| download | emacs-53e7a763dd16509d90418bdf14d161db13271ea3.tar.gz emacs-53e7a763dd16509d90418bdf14d161db13271ea3.zip | |
* lisp/cedet/mode-local.el: Use lexical-binding and `declare`
(with-mode-local-symbol, with-mode-local, setq-mode-local)
(defvar-mode-local, defconst-mode-local)
(define-overloadable-function, define-mode-local-override):
Use `declare` for indent and edebug specs.
(xref-mode-local-find-overloadable-regexp): Simplify regexp.
(mode-local-setup-edebug-specs): Delete.
(edebug-setup-hook): Don't use any more.
| -rw-r--r-- | lisp/cedet/mode-local.el | 142 |
1 files changed, 69 insertions, 73 deletions
diff --git a/lisp/cedet/mode-local.el b/lisp/cedet/mode-local.el index 28867eea9b6..602961c199e 100644 --- a/lisp/cedet/mode-local.el +++ b/lisp/cedet/mode-local.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; mode-local.el --- Support for mode local facilities | 1 | ;;; mode-local.el --- Support for mode local facilities -*- lexical-binding:t -*- |
| 2 | ;; | 2 | ;; |
| 3 | ;; Copyright (C) 2004-2005, 2007-2019 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2004-2005, 2007-2019 Free Software Foundation, Inc. |
| 4 | ;; | 4 | ;; |
| @@ -120,7 +120,7 @@ which mode local bindings have been activated." | |||
| 120 | "Initialize mode-local facilities. | 120 | "Initialize mode-local facilities. |
| 121 | This is run from `find-file-hook', and from `post-command-hook' | 121 | This is run from `find-file-hook', and from `post-command-hook' |
| 122 | after changing the major mode." | 122 | after changing the major mode." |
| 123 | (remove-hook 'post-command-hook 'mode-local-post-major-mode-change nil) | 123 | (remove-hook 'post-command-hook #'mode-local-post-major-mode-change nil) |
| 124 | (let ((buffers mode-local-changed-mode-buffers)) | 124 | (let ((buffers mode-local-changed-mode-buffers)) |
| 125 | (setq mode-local-changed-mode-buffers nil) | 125 | (setq mode-local-changed-mode-buffers nil) |
| 126 | (mode-local-map-file-buffers | 126 | (mode-local-map-file-buffers |
| @@ -135,7 +135,7 @@ after changing the major mode." | |||
| 135 | (defun mode-local-on-major-mode-change () | 135 | (defun mode-local-on-major-mode-change () |
| 136 | "Function called in `change-major-mode-hook'." | 136 | "Function called in `change-major-mode-hook'." |
| 137 | (add-to-list 'mode-local-changed-mode-buffers (current-buffer)) | 137 | (add-to-list 'mode-local-changed-mode-buffers (current-buffer)) |
| 138 | (add-hook 'post-command-hook 'mode-local-post-major-mode-change t nil)) | 138 | (add-hook 'post-command-hook #'mode-local-post-major-mode-change t nil)) |
| 139 | 139 | ||
| 140 | ;;; Mode lineage | 140 | ;;; Mode lineage |
| 141 | ;; | 141 | ;; |
| @@ -149,7 +149,7 @@ local variables have been defined." | |||
| 149 | ;; PARENT mode local variables have been defined. | 149 | ;; PARENT mode local variables have been defined. |
| 150 | (mode-local-map-mode-buffers #'activate-mode-local-bindings mode)) | 150 | (mode-local-map-mode-buffers #'activate-mode-local-bindings mode)) |
| 151 | 151 | ||
| 152 | (defmacro define-child-mode (mode parent &optional docstring) | 152 | (defmacro define-child-mode (mode parent &optional _docstring) |
| 153 | "Make major mode MODE inherit behavior from PARENT mode. | 153 | "Make major mode MODE inherit behavior from PARENT mode. |
| 154 | DOCSTRING is optional and not used. | 154 | DOCSTRING is optional and not used. |
| 155 | To work properly, this should be put after PARENT mode local variables | 155 | To work properly, this should be put after PARENT mode local variables |
| @@ -347,46 +347,46 @@ If MODE is not specified it defaults to current `major-mode'." | |||
| 347 | (setq mode (get-mode-local-parent mode))))) | 347 | (setq mode (get-mode-local-parent mode))))) |
| 348 | 348 | ||
| 349 | (defmacro with-mode-local-symbol (mode &rest body) | 349 | (defmacro with-mode-local-symbol (mode &rest body) |
| 350 | "With the local bindings of MODE symbol, evaluate BODY. | 350 | "With the local bindings of MODE symbol, evaluate BODY. |
| 351 | The current mode bindings are saved, BODY is evaluated, and the saved | 351 | The current mode bindings are saved, BODY is evaluated, and the saved |
| 352 | bindings are restored, even in case of an abnormal exit. | 352 | bindings are restored, even in case of an abnormal exit. |
| 353 | Value is what BODY returns. | 353 | Value is what BODY returns. |
| 354 | This is like `with-mode-local', except that MODE's value is used. | 354 | This is like `with-mode-local', except that MODE's value is used. |
| 355 | To use the symbol MODE (quoted), use `with-mode-local'." | 355 | To use the symbol MODE (quoted), use `with-mode-local'." |
| 356 | (let ((old-mode (make-symbol "mode")) | 356 | (declare (indent 1)) |
| 357 | (old-locals (make-symbol "old-locals")) | 357 | (let ((old-mode (make-symbol "mode")) |
| 358 | (new-mode (make-symbol "new-mode")) | 358 | (old-locals (make-symbol "old-locals")) |
| 359 | (local (make-symbol "local"))) | 359 | (new-mode (make-symbol "new-mode")) |
| 360 | `(let ((,old-mode mode-local-active-mode) | 360 | (local (make-symbol "local"))) |
| 361 | (,old-locals nil) | 361 | `(let ((,old-mode mode-local-active-mode) |
| 362 | (,new-mode ,mode) | 362 | (,old-locals nil) |
| 363 | ) | 363 | (,new-mode ,mode) |
| 364 | (unwind-protect | 364 | ) |
| 365 | (progn | 365 | (unwind-protect |
| 366 | (deactivate-mode-local-bindings ,old-mode) | 366 | (progn |
| 367 | (setq mode-local-active-mode ,new-mode) | 367 | (deactivate-mode-local-bindings ,old-mode) |
| 368 | ;; Save the previous value of buffer-local variables | 368 | (setq mode-local-active-mode ,new-mode) |
| 369 | ;; changed by `activate-mode-local-bindings'. | 369 | ;; Save the previous value of buffer-local variables |
| 370 | (setq ,old-locals (activate-mode-local-bindings ,new-mode)) | 370 | ;; changed by `activate-mode-local-bindings'. |
| 371 | ,@body) | 371 | (setq ,old-locals (activate-mode-local-bindings ,new-mode)) |
| 372 | (deactivate-mode-local-bindings ,new-mode) | 372 | ,@body) |
| 373 | ;; Restore the previous value of buffer-local variables. | 373 | (deactivate-mode-local-bindings ,new-mode) |
| 374 | (dolist (,local ,old-locals) | 374 | ;; Restore the previous value of buffer-local variables. |
| 375 | (set (car ,local) (cdr ,local))) | 375 | (dolist (,local ,old-locals) |
| 376 | ;; Restore the mode local variables. | 376 | (set (car ,local) (cdr ,local))) |
| 377 | (setq mode-local-active-mode ,old-mode) | 377 | ;; Restore the mode local variables. |
| 378 | (activate-mode-local-bindings ,old-mode))))) | 378 | (setq mode-local-active-mode ,old-mode) |
| 379 | (put 'with-mode-local-symbol 'lisp-indent-function 1) | 379 | (activate-mode-local-bindings ,old-mode))))) |
| 380 | 380 | ||
| 381 | (defmacro with-mode-local (mode &rest body) | 381 | (defmacro with-mode-local (mode &rest body) |
| 382 | "With the local bindings of MODE, evaluate BODY. | 382 | "With the local bindings of MODE, evaluate BODY. |
| 383 | The current mode bindings are saved, BODY is evaluated, and the saved | 383 | The current mode bindings are saved, BODY is evaluated, and the saved |
| 384 | bindings are restored, even in case of an abnormal exit. | 384 | bindings are restored, even in case of an abnormal exit. |
| 385 | Value is what BODY returns. | 385 | Value is what BODY returns. |
| 386 | This is like `with-mode-local-symbol', except that MODE is quoted | 386 | This is like `with-mode-local-symbol', except that MODE is quoted |
| 387 | and is not evaluated." | 387 | and is not evaluated." |
| 388 | `(with-mode-local-symbol ',mode ,@body)) | 388 | (declare (indent 1)) |
| 389 | (put 'with-mode-local 'lisp-indent-function 1) | 389 | `(with-mode-local-symbol ',mode ,@body)) |
| 390 | 390 | ||
| 391 | 391 | ||
| 392 | (defsubst mode-local-value (mode sym) | 392 | (defsubst mode-local-value (mode sym) |
| @@ -403,6 +403,7 @@ The values VAL are expressions; they are evaluated. | |||
| 403 | Set each SYM to the value of its VAL, locally in buffers already in | 403 | Set each SYM to the value of its VAL, locally in buffers already in |
| 404 | MODE, or in buffers switched to that mode. | 404 | MODE, or in buffers switched to that mode. |
| 405 | Return the value of the last VAL." | 405 | Return the value of the last VAL." |
| 406 | (declare (debug (symbolp &rest symbolp form))) | ||
| 406 | (when args | 407 | (when args |
| 407 | (let (i ll bl sl tmp sym val) | 408 | (let (i ll bl sl tmp sym val) |
| 408 | (setq i 0) | 409 | (setq i 0) |
| @@ -427,16 +428,18 @@ Return the value of the last VAL." | |||
| 427 | (defmacro defvar-mode-local (mode sym val &optional docstring) | 428 | (defmacro defvar-mode-local (mode sym val &optional docstring) |
| 428 | "Define MODE local variable SYM with value VAL. | 429 | "Define MODE local variable SYM with value VAL. |
| 429 | DOCSTRING is optional." | 430 | DOCSTRING is optional." |
| 431 | (declare (indent defun) | ||
| 432 | (debug (&define symbolp name def-form [ &optional stringp ] ))) | ||
| 430 | `(progn | 433 | `(progn |
| 431 | (setq-mode-local ,mode ,sym ,val) | 434 | (setq-mode-local ,mode ,sym ,val) |
| 432 | (put (mode-local-symbol ',sym ',mode) | 435 | (put (mode-local-symbol ',sym ',mode) |
| 433 | 'variable-documentation ,docstring) | 436 | 'variable-documentation ,docstring) |
| 434 | ',sym)) | 437 | ',sym)) |
| 435 | (put 'defvar-mode-local 'lisp-indent-function 'defun) | ||
| 436 | 438 | ||
| 437 | (defmacro defconst-mode-local (mode sym val &optional docstring) | 439 | (defmacro defconst-mode-local (mode sym val &optional docstring) |
| 438 | "Define MODE local constant SYM with value VAL. | 440 | "Define MODE local constant SYM with value VAL. |
| 439 | DOCSTRING is optional." | 441 | DOCSTRING is optional." |
| 442 | (declare (indent defun) (debug defvar-mode-local)) | ||
| 440 | (let ((tmp (make-symbol "tmp"))) | 443 | (let ((tmp (make-symbol "tmp"))) |
| 441 | `(let (,tmp) | 444 | `(let (,tmp) |
| 442 | (setq-mode-local ,mode ,sym ,val) | 445 | (setq-mode-local ,mode ,sym ,val) |
| @@ -444,7 +447,6 @@ DOCSTRING is optional." | |||
| 444 | (put ,tmp 'constant-flag t) | 447 | (put ,tmp 'constant-flag t) |
| 445 | (put ,tmp 'variable-documentation ,docstring) | 448 | (put ,tmp 'variable-documentation ,docstring) |
| 446 | ',sym))) | 449 | ',sym))) |
| 447 | (put 'defconst-mode-local 'lisp-indent-function 'defun) | ||
| 448 | 450 | ||
| 449 | ;;; Function overloading | 451 | ;;; Function overloading |
| 450 | ;; | 452 | ;; |
| @@ -552,7 +554,8 @@ defined. The default is to call the function `NAME-default' with the | |||
| 552 | appropriate arguments deduced from ARGS. | 554 | appropriate arguments deduced from ARGS. |
| 553 | OVERARGS is a list of arguments passed to the override and | 555 | OVERARGS is a list of arguments passed to the override and |
| 554 | `NAME-default' function, in place of those deduced from ARGS." | 556 | `NAME-default' function, in place of those deduced from ARGS." |
| 555 | (declare (doc-string 3)) | 557 | (declare (doc-string 3) |
| 558 | (debug (&define name lambda-list stringp def-body))) | ||
| 556 | `(eval-and-compile | 559 | `(eval-and-compile |
| 557 | (defun ,name ,args | 560 | (defun ,name ,args |
| 558 | ,docstring | 561 | ,docstring |
| @@ -561,7 +564,7 @@ OVERARGS is a list of arguments passed to the override and | |||
| 561 | (put :override-with-args 'lisp-indent-function 1) | 564 | (put :override-with-args 'lisp-indent-function 1) |
| 562 | 565 | ||
| 563 | (define-obsolete-function-alias 'define-overload | 566 | (define-obsolete-function-alias 'define-overload |
| 564 | #'define-overloadable-function "27.1") | 567 | 'define-overloadable-function "27.1") |
| 565 | 568 | ||
| 566 | (defsubst function-overload-p (symbol) | 569 | (defsubst function-overload-p (symbol) |
| 567 | "Return non-nil if SYMBOL is a function which can be overloaded." | 570 | "Return non-nil if SYMBOL is a function which can be overloaded." |
| @@ -577,7 +580,8 @@ named function created with `define-overload'. | |||
| 577 | DOCSTRING is the documentation string. | 580 | DOCSTRING is the documentation string. |
| 578 | BODY is the implementation of this function." | 581 | BODY is the implementation of this function." |
| 579 | ;; FIXME: Make this obsolete and use cl-defmethod with &context instead. | 582 | ;; FIXME: Make this obsolete and use cl-defmethod with &context instead. |
| 580 | (declare (doc-string 4)) | 583 | (declare (doc-string 4) |
| 584 | (debug (&define name symbolp lambda-list stringp def-body))) | ||
| 581 | (let ((newname (intern (format "%s-%s" name mode)))) | 585 | (let ((newname (intern (format "%s-%s" name mode)))) |
| 582 | `(progn | 586 | `(progn |
| 583 | (eval-and-compile | 587 | (eval-and-compile |
| @@ -667,7 +671,7 @@ SYMBOL is a function that can be overridden." | |||
| 667 | ))) | 671 | ))) |
| 668 | ))) | 672 | ))) |
| 669 | 673 | ||
| 670 | (add-hook 'help-fns-describe-function-functions 'describe-mode-local-overload) | 674 | (add-hook 'help-fns-describe-function-functions #'describe-mode-local-overload) |
| 671 | 675 | ||
| 672 | (declare-function xref-item-location "xref" (xref) t) | 676 | (declare-function xref-item-location "xref" (xref) t) |
| 673 | 677 | ||
| @@ -684,9 +688,11 @@ SYMBOL is a function that can be overridden." | |||
| 684 | "For `elisp-xref-find-def-functions'; add overloads for SYMBOL." | 688 | "For `elisp-xref-find-def-functions'; add overloads for SYMBOL." |
| 685 | ;; Current buffer is the buffer where xref-find-definitions was invoked. | 689 | ;; Current buffer is the buffer where xref-find-definitions was invoked. |
| 686 | (when (function-overload-p symbol) | 690 | (when (function-overload-p symbol) |
| 687 | (let* ((symbol-file (find-lisp-object-file-name symbol (symbol-function symbol))) | 691 | (let* ((symbol-file (find-lisp-object-file-name |
| 692 | symbol (symbol-function symbol))) | ||
| 688 | (default (intern-soft (format "%s-default" (symbol-name symbol)))) | 693 | (default (intern-soft (format "%s-default" (symbol-name symbol)))) |
| 689 | (default-file (when default (find-lisp-object-file-name default (symbol-function default)))) | 694 | (default-file (when default (find-lisp-object-file-name |
| 695 | default (symbol-function default)))) | ||
| 690 | modes | 696 | modes |
| 691 | xrefs) | 697 | xrefs) |
| 692 | 698 | ||
| @@ -701,12 +707,15 @@ SYMBOL is a function that can be overridden." | |||
| 701 | (setq modes | 707 | (setq modes |
| 702 | (sort modes | 708 | (sort modes |
| 703 | (lambda (a b) | 709 | (lambda (a b) |
| 704 | (not (equal b (get a 'mode-local-parent)))))) ;; a is not a child, or not a child of b | 710 | ;; a is not a child, or not a child of b |
| 711 | (not (equal b (get a 'mode-local-parent)))))) | ||
| 705 | 712 | ||
| 706 | (dolist (mode modes) | 713 | (dolist (mode modes) |
| 707 | (let* ((major-mode mode) | 714 | (let* ((major-mode mode) |
| 708 | (override (fetch-overload symbol)) | 715 | (override (fetch-overload symbol)) |
| 709 | (override-file (when override (find-lisp-object-file-name override (symbol-function override))))) | 716 | (override-file (when override |
| 717 | (find-lisp-object-file-name | ||
| 718 | override (symbol-function override))))) | ||
| 710 | 719 | ||
| 711 | (when (and override override-file) | 720 | (when (and override override-file) |
| 712 | (let ((meta-name (cons override major-mode)) | 721 | (let ((meta-name (cons override major-mode)) |
| @@ -734,14 +743,16 @@ SYMBOL is a function that can be overridden." | |||
| 734 | (push (elisp--xref-make-xref nil default default-file) xrefs)) | 743 | (push (elisp--xref-make-xref nil default default-file) xrefs)) |
| 735 | 744 | ||
| 736 | (when symbol-file | 745 | (when symbol-file |
| 737 | (push (elisp--xref-make-xref 'define-overloadable-function symbol symbol-file) xrefs)) | 746 | (push (elisp--xref-make-xref 'define-overloadable-function |
| 747 | symbol symbol-file) | ||
| 748 | xrefs)) | ||
| 738 | 749 | ||
| 739 | xrefs))) | 750 | xrefs))) |
| 740 | 751 | ||
| 741 | (add-hook 'elisp-xref-find-def-functions 'xref-mode-local-overload) | 752 | (add-hook 'elisp-xref-find-def-functions #'xref-mode-local-overload) |
| 742 | 753 | ||
| 743 | (defconst xref-mode-local-find-overloadable-regexp | 754 | (defconst xref-mode-local-find-overloadable-regexp |
| 744 | "(\\(\\(define-overloadable-function\\)\\|\\(define-overload\\)\\) +%s" | 755 | "(define-overload\\(able-function\\)? +%s" |
| 745 | "Regexp used by `xref-find-definitions' when searching for a | 756 | "Regexp used by `xref-find-definitions' when searching for a |
| 746 | mode-local overloadable function definition.") | 757 | mode-local overloadable function definition.") |
| 747 | 758 | ||
| @@ -757,8 +768,12 @@ META-NAME is a cons (OVERLOADABLE-SYMBOL . MAJOR-MODE)." | |||
| 757 | (re-search-forward regexp nil t) | 768 | (re-search-forward regexp nil t) |
| 758 | )) | 769 | )) |
| 759 | 770 | ||
| 760 | (add-to-list 'find-function-regexp-alist '(define-overloadable-function . xref-mode-local-find-overloadable-regexp)) | 771 | (add-to-list 'find-function-regexp-alist |
| 761 | (add-to-list 'find-function-regexp-alist (cons 'define-mode-local-override #'xref-mode-local-find-override)) | 772 | '(define-overloadable-function |
| 773 | . xref-mode-local-find-overloadable-regexp)) | ||
| 774 | (add-to-list 'find-function-regexp-alist | ||
| 775 | (cons 'define-mode-local-override | ||
| 776 | #'xref-mode-local-find-override)) | ||
| 762 | 777 | ||
| 763 | ;; Help for mode-local bindings. | 778 | ;; Help for mode-local bindings. |
| 764 | (defun mode-local-print-binding (symbol) | 779 | (defun mode-local-print-binding (symbol) |
| @@ -796,19 +811,19 @@ META-NAME is a cons (OVERLOADABLE-SYMBOL . MAJOR-MODE)." | |||
| 796 | ;; Print symbols by type | 811 | ;; Print symbols by type |
| 797 | (when us | 812 | (when us |
| 798 | (princ "\n !! Unspecified symbols\n") | 813 | (princ "\n !! Unspecified symbols\n") |
| 799 | (mapc 'mode-local-print-binding us)) | 814 | (mapc #'mode-local-print-binding us)) |
| 800 | (when mc | 815 | (when mc |
| 801 | (princ "\n ** Mode local constants\n") | 816 | (princ "\n ** Mode local constants\n") |
| 802 | (mapc 'mode-local-print-binding mc)) | 817 | (mapc #'mode-local-print-binding mc)) |
| 803 | (when mv | 818 | (when mv |
| 804 | (princ "\n ** Mode local variables\n") | 819 | (princ "\n ** Mode local variables\n") |
| 805 | (mapc 'mode-local-print-binding mv)) | 820 | (mapc #'mode-local-print-binding mv)) |
| 806 | (when fo | 821 | (when fo |
| 807 | (princ "\n ** Final overloaded functions\n") | 822 | (princ "\n ** Final overloaded functions\n") |
| 808 | (mapc 'mode-local-print-binding fo)) | 823 | (mapc #'mode-local-print-binding fo)) |
| 809 | (when ov | 824 | (when ov |
| 810 | (princ "\n ** Overloaded functions\n") | 825 | (princ "\n ** Overloaded functions\n") |
| 811 | (mapc 'mode-local-print-binding ov)) | 826 | (mapc #'mode-local-print-binding ov)) |
| 812 | )) | 827 | )) |
| 813 | 828 | ||
| 814 | (defun mode-local-describe-bindings-2 (buffer-or-mode) | 829 | (defun mode-local-describe-bindings-2 (buffer-or-mode) |
| @@ -876,27 +891,8 @@ invoked interactively." | |||
| 876 | (when (setq mode (intern-soft mode)) | 891 | (when (setq mode (intern-soft mode)) |
| 877 | (mode-local-describe-bindings-1 mode (called-interactively-p 'any)))) | 892 | (mode-local-describe-bindings-1 mode (called-interactively-p 'any)))) |
| 878 | 893 | ||
| 879 | ;;; edebug support | 894 | (add-hook 'find-file-hook #'mode-local-post-major-mode-change) |
| 880 | ;; | 895 | (add-hook 'change-major-mode-hook #'mode-local-on-major-mode-change) |
| 881 | (defun mode-local-setup-edebug-specs () | ||
| 882 | "Define edebug specification for mode local macros." | ||
| 883 | (def-edebug-spec setq-mode-local | ||
| 884 | (symbolp &rest symbolp form)) | ||
| 885 | (def-edebug-spec defvar-mode-local | ||
| 886 | (&define symbolp name def-form [ &optional stringp ] )) | ||
| 887 | (def-edebug-spec defconst-mode-local | ||
| 888 | defvar-mode-local) | ||
| 889 | (def-edebug-spec define-overload | ||
| 890 | (&define name lambda-list stringp def-body)) | ||
| 891 | (def-edebug-spec define-overloadable-function | ||
| 892 | (&define name lambda-list stringp def-body)) | ||
| 893 | (def-edebug-spec define-mode-local-override | ||
| 894 | (&define name symbolp lambda-list stringp def-body))) | ||
| 895 | |||
| 896 | (add-hook 'edebug-setup-hook 'mode-local-setup-edebug-specs) | ||
| 897 | |||
| 898 | (add-hook 'find-file-hook 'mode-local-post-major-mode-change) | ||
| 899 | (add-hook 'change-major-mode-hook 'mode-local-on-major-mode-change) | ||
| 900 | 896 | ||
| 901 | (provide 'mode-local) | 897 | (provide 'mode-local) |
| 902 | 898 | ||