aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2019-10-23 17:48:41 -0400
committerStefan Monnier2019-10-23 17:48:41 -0400
commit53e7a763dd16509d90418bdf14d161db13271ea3 (patch)
tree8e026692466ad086266fdac02cb40714da92e5c7
parent042fd120cc5988b15eae98b5dbcd9c2d62f968e6 (diff)
downloademacs-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.el142
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.
121This is run from `find-file-hook', and from `post-command-hook' 121This is run from `find-file-hook', and from `post-command-hook'
122after changing the major mode." 122after 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.
154DOCSTRING is optional and not used. 154DOCSTRING is optional and not used.
155To work properly, this should be put after PARENT mode local variables 155To 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.
351The current mode bindings are saved, BODY is evaluated, and the saved 351The current mode bindings are saved, BODY is evaluated, and the saved
352bindings are restored, even in case of an abnormal exit. 352bindings are restored, even in case of an abnormal exit.
353Value is what BODY returns. 353Value is what BODY returns.
354This is like `with-mode-local', except that MODE's value is used. 354This is like `with-mode-local', except that MODE's value is used.
355To use the symbol MODE (quoted), use `with-mode-local'." 355To 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.
383The current mode bindings are saved, BODY is evaluated, and the saved 383The current mode bindings are saved, BODY is evaluated, and the saved
384bindings are restored, even in case of an abnormal exit. 384bindings are restored, even in case of an abnormal exit.
385Value is what BODY returns. 385Value is what BODY returns.
386This is like `with-mode-local-symbol', except that MODE is quoted 386This is like `with-mode-local-symbol', except that MODE is quoted
387and is not evaluated." 387and 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.
403Set each SYM to the value of its VAL, locally in buffers already in 403Set each SYM to the value of its VAL, locally in buffers already in
404MODE, or in buffers switched to that mode. 404MODE, or in buffers switched to that mode.
405Return the value of the last VAL." 405Return 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.
429DOCSTRING is optional." 430DOCSTRING 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.
439DOCSTRING is optional." 441DOCSTRING 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
552appropriate arguments deduced from ARGS. 554appropriate arguments deduced from ARGS.
553OVERARGS is a list of arguments passed to the override and 555OVERARGS 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'.
577DOCSTRING is the documentation string. 580DOCSTRING is the documentation string.
578BODY is the implementation of this function." 581BODY 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