mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-30 08:09:04 +00:00
* 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.
This commit is contained in:
Stefan Monnier
parent
042fd120cc
commit
53e7a763dd
@ -1,4 +1,4 @@
|
||||
;;; mode-local.el --- Support for mode local facilities
|
||||
;;; mode-local.el --- Support for mode local facilities -*- lexical-binding:t -*-
|
||||
;;
|
||||
;; Copyright (C) 2004-2005, 2007-2019 Free Software Foundation, Inc.
|
||||
;;
|
||||
@ -120,7 +120,7 @@ which mode local bindings have been activated."
|
||||
"Initialize mode-local facilities.
|
||||
This is run from `find-file-hook', and from `post-command-hook'
|
||||
after changing the major mode."
|
||||
(remove-hook 'post-command-hook 'mode-local-post-major-mode-change nil)
|
||||
(remove-hook 'post-command-hook #'mode-local-post-major-mode-change nil)
|
||||
(let ((buffers mode-local-changed-mode-buffers))
|
||||
(setq mode-local-changed-mode-buffers nil)
|
||||
(mode-local-map-file-buffers
|
||||
@ -135,7 +135,7 @@ after changing the major mode."
|
||||
(defun mode-local-on-major-mode-change ()
|
||||
"Function called in `change-major-mode-hook'."
|
||||
(add-to-list 'mode-local-changed-mode-buffers (current-buffer))
|
||||
(add-hook 'post-command-hook 'mode-local-post-major-mode-change t nil))
|
||||
(add-hook 'post-command-hook #'mode-local-post-major-mode-change t nil))
|
||||
|
||||
;;; Mode lineage
|
||||
;;
|
||||
@ -149,7 +149,7 @@ local variables have been defined."
|
||||
;; PARENT mode local variables have been defined.
|
||||
(mode-local-map-mode-buffers #'activate-mode-local-bindings mode))
|
||||
|
||||
(defmacro define-child-mode (mode parent &optional docstring)
|
||||
(defmacro define-child-mode (mode parent &optional _docstring)
|
||||
"Make major mode MODE inherit behavior from PARENT mode.
|
||||
DOCSTRING is optional and not used.
|
||||
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'."
|
||||
(setq mode (get-mode-local-parent mode)))))
|
||||
|
||||
(defmacro with-mode-local-symbol (mode &rest body)
|
||||
"With the local bindings of MODE symbol, evaluate BODY.
|
||||
"With the local bindings of MODE symbol, evaluate BODY.
|
||||
The current mode bindings are saved, BODY is evaluated, and the saved
|
||||
bindings are restored, even in case of an abnormal exit.
|
||||
Value is what BODY returns.
|
||||
This is like `with-mode-local', except that MODE's value is used.
|
||||
To use the symbol MODE (quoted), use `with-mode-local'."
|
||||
(let ((old-mode (make-symbol "mode"))
|
||||
(old-locals (make-symbol "old-locals"))
|
||||
(new-mode (make-symbol "new-mode"))
|
||||
(local (make-symbol "local")))
|
||||
`(let ((,old-mode mode-local-active-mode)
|
||||
(,old-locals nil)
|
||||
(,new-mode ,mode)
|
||||
)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(deactivate-mode-local-bindings ,old-mode)
|
||||
(setq mode-local-active-mode ,new-mode)
|
||||
;; Save the previous value of buffer-local variables
|
||||
;; changed by `activate-mode-local-bindings'.
|
||||
(setq ,old-locals (activate-mode-local-bindings ,new-mode))
|
||||
,@body)
|
||||
(deactivate-mode-local-bindings ,new-mode)
|
||||
;; Restore the previous value of buffer-local variables.
|
||||
(dolist (,local ,old-locals)
|
||||
(set (car ,local) (cdr ,local)))
|
||||
;; Restore the mode local variables.
|
||||
(setq mode-local-active-mode ,old-mode)
|
||||
(activate-mode-local-bindings ,old-mode)))))
|
||||
(put 'with-mode-local-symbol 'lisp-indent-function 1)
|
||||
(declare (indent 1))
|
||||
(let ((old-mode (make-symbol "mode"))
|
||||
(old-locals (make-symbol "old-locals"))
|
||||
(new-mode (make-symbol "new-mode"))
|
||||
(local (make-symbol "local")))
|
||||
`(let ((,old-mode mode-local-active-mode)
|
||||
(,old-locals nil)
|
||||
(,new-mode ,mode)
|
||||
)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(deactivate-mode-local-bindings ,old-mode)
|
||||
(setq mode-local-active-mode ,new-mode)
|
||||
;; Save the previous value of buffer-local variables
|
||||
;; changed by `activate-mode-local-bindings'.
|
||||
(setq ,old-locals (activate-mode-local-bindings ,new-mode))
|
||||
,@body)
|
||||
(deactivate-mode-local-bindings ,new-mode)
|
||||
;; Restore the previous value of buffer-local variables.
|
||||
(dolist (,local ,old-locals)
|
||||
(set (car ,local) (cdr ,local)))
|
||||
;; Restore the mode local variables.
|
||||
(setq mode-local-active-mode ,old-mode)
|
||||
(activate-mode-local-bindings ,old-mode)))))
|
||||
|
||||
(defmacro with-mode-local (mode &rest body)
|
||||
"With the local bindings of MODE, evaluate BODY.
|
||||
"With the local bindings of MODE, evaluate BODY.
|
||||
The current mode bindings are saved, BODY is evaluated, and the saved
|
||||
bindings are restored, even in case of an abnormal exit.
|
||||
Value is what BODY returns.
|
||||
This is like `with-mode-local-symbol', except that MODE is quoted
|
||||
and is not evaluated."
|
||||
`(with-mode-local-symbol ',mode ,@body))
|
||||
(put 'with-mode-local 'lisp-indent-function 1)
|
||||
(declare (indent 1))
|
||||
`(with-mode-local-symbol ',mode ,@body))
|
||||
|
||||
|
||||
(defsubst mode-local-value (mode sym)
|
||||
@ -403,6 +403,7 @@ The values VAL are expressions; they are evaluated.
|
||||
Set each SYM to the value of its VAL, locally in buffers already in
|
||||
MODE, or in buffers switched to that mode.
|
||||
Return the value of the last VAL."
|
||||
(declare (debug (symbolp &rest symbolp form)))
|
||||
(when args
|
||||
(let (i ll bl sl tmp sym val)
|
||||
(setq i 0)
|
||||
@ -427,16 +428,18 @@ Return the value of the last VAL."
|
||||
(defmacro defvar-mode-local (mode sym val &optional docstring)
|
||||
"Define MODE local variable SYM with value VAL.
|
||||
DOCSTRING is optional."
|
||||
(declare (indent defun)
|
||||
(debug (&define symbolp name def-form [ &optional stringp ] )))
|
||||
`(progn
|
||||
(setq-mode-local ,mode ,sym ,val)
|
||||
(put (mode-local-symbol ',sym ',mode)
|
||||
'variable-documentation ,docstring)
|
||||
',sym))
|
||||
(put 'defvar-mode-local 'lisp-indent-function 'defun)
|
||||
|
||||
(defmacro defconst-mode-local (mode sym val &optional docstring)
|
||||
"Define MODE local constant SYM with value VAL.
|
||||
DOCSTRING is optional."
|
||||
(declare (indent defun) (debug defvar-mode-local))
|
||||
(let ((tmp (make-symbol "tmp")))
|
||||
`(let (,tmp)
|
||||
(setq-mode-local ,mode ,sym ,val)
|
||||
@ -444,7 +447,6 @@ DOCSTRING is optional."
|
||||
(put ,tmp 'constant-flag t)
|
||||
(put ,tmp 'variable-documentation ,docstring)
|
||||
',sym)))
|
||||
(put 'defconst-mode-local 'lisp-indent-function 'defun)
|
||||
|
||||
;;; Function overloading
|
||||
;;
|
||||
@ -552,7 +554,8 @@ defined. The default is to call the function `NAME-default' with the
|
||||
appropriate arguments deduced from ARGS.
|
||||
OVERARGS is a list of arguments passed to the override and
|
||||
`NAME-default' function, in place of those deduced from ARGS."
|
||||
(declare (doc-string 3))
|
||||
(declare (doc-string 3)
|
||||
(debug (&define name lambda-list stringp def-body)))
|
||||
`(eval-and-compile
|
||||
(defun ,name ,args
|
||||
,docstring
|
||||
@ -561,7 +564,7 @@ OVERARGS is a list of arguments passed to the override and
|
||||
(put :override-with-args 'lisp-indent-function 1)
|
||||
|
||||
(define-obsolete-function-alias 'define-overload
|
||||
#'define-overloadable-function "27.1")
|
||||
'define-overloadable-function "27.1")
|
||||
|
||||
(defsubst function-overload-p (symbol)
|
||||
"Return non-nil if SYMBOL is a function which can be overloaded."
|
||||
@ -577,7 +580,8 @@ named function created with `define-overload'.
|
||||
DOCSTRING is the documentation string.
|
||||
BODY is the implementation of this function."
|
||||
;; FIXME: Make this obsolete and use cl-defmethod with &context instead.
|
||||
(declare (doc-string 4))
|
||||
(declare (doc-string 4)
|
||||
(debug (&define name symbolp lambda-list stringp def-body)))
|
||||
(let ((newname (intern (format "%s-%s" name mode))))
|
||||
`(progn
|
||||
(eval-and-compile
|
||||
@ -667,7 +671,7 @@ SYMBOL is a function that can be overridden."
|
||||
)))
|
||||
)))
|
||||
|
||||
(add-hook 'help-fns-describe-function-functions 'describe-mode-local-overload)
|
||||
(add-hook 'help-fns-describe-function-functions #'describe-mode-local-overload)
|
||||
|
||||
(declare-function xref-item-location "xref" (xref) t)
|
||||
|
||||
@ -684,9 +688,11 @@ SYMBOL is a function that can be overridden."
|
||||
"For `elisp-xref-find-def-functions'; add overloads for SYMBOL."
|
||||
;; Current buffer is the buffer where xref-find-definitions was invoked.
|
||||
(when (function-overload-p symbol)
|
||||
(let* ((symbol-file (find-lisp-object-file-name symbol (symbol-function symbol)))
|
||||
(let* ((symbol-file (find-lisp-object-file-name
|
||||
symbol (symbol-function symbol)))
|
||||
(default (intern-soft (format "%s-default" (symbol-name symbol))))
|
||||
(default-file (when default (find-lisp-object-file-name default (symbol-function default))))
|
||||
(default-file (when default (find-lisp-object-file-name
|
||||
default (symbol-function default))))
|
||||
modes
|
||||
xrefs)
|
||||
|
||||
@ -701,12 +707,15 @@ SYMBOL is a function that can be overridden."
|
||||
(setq modes
|
||||
(sort modes
|
||||
(lambda (a b)
|
||||
(not (equal b (get a 'mode-local-parent)))))) ;; a is not a child, or not a child of b
|
||||
;; a is not a child, or not a child of b
|
||||
(not (equal b (get a 'mode-local-parent))))))
|
||||
|
||||
(dolist (mode modes)
|
||||
(let* ((major-mode mode)
|
||||
(override (fetch-overload symbol))
|
||||
(override-file (when override (find-lisp-object-file-name override (symbol-function override)))))
|
||||
(override-file (when override
|
||||
(find-lisp-object-file-name
|
||||
override (symbol-function override)))))
|
||||
|
||||
(when (and override override-file)
|
||||
(let ((meta-name (cons override major-mode))
|
||||
@ -734,14 +743,16 @@ SYMBOL is a function that can be overridden."
|
||||
(push (elisp--xref-make-xref nil default default-file) xrefs))
|
||||
|
||||
(when symbol-file
|
||||
(push (elisp--xref-make-xref 'define-overloadable-function symbol symbol-file) xrefs))
|
||||
(push (elisp--xref-make-xref 'define-overloadable-function
|
||||
symbol symbol-file)
|
||||
xrefs))
|
||||
|
||||
xrefs)))
|
||||
|
||||
(add-hook 'elisp-xref-find-def-functions 'xref-mode-local-overload)
|
||||
(add-hook 'elisp-xref-find-def-functions #'xref-mode-local-overload)
|
||||
|
||||
(defconst xref-mode-local-find-overloadable-regexp
|
||||
"(\\(\\(define-overloadable-function\\)\\|\\(define-overload\\)\\) +%s"
|
||||
"(define-overload\\(able-function\\)? +%s"
|
||||
"Regexp used by `xref-find-definitions' when searching for a
|
||||
mode-local overloadable function definition.")
|
||||
|
||||
@ -757,8 +768,12 @@ META-NAME is a cons (OVERLOADABLE-SYMBOL . MAJOR-MODE)."
|
||||
(re-search-forward regexp nil t)
|
||||
))
|
||||
|
||||
(add-to-list 'find-function-regexp-alist '(define-overloadable-function . xref-mode-local-find-overloadable-regexp))
|
||||
(add-to-list 'find-function-regexp-alist (cons 'define-mode-local-override #'xref-mode-local-find-override))
|
||||
(add-to-list 'find-function-regexp-alist
|
||||
'(define-overloadable-function
|
||||
. xref-mode-local-find-overloadable-regexp))
|
||||
(add-to-list 'find-function-regexp-alist
|
||||
(cons 'define-mode-local-override
|
||||
#'xref-mode-local-find-override))
|
||||
|
||||
;; Help for mode-local bindings.
|
||||
(defun mode-local-print-binding (symbol)
|
||||
@ -796,19 +811,19 @@ META-NAME is a cons (OVERLOADABLE-SYMBOL . MAJOR-MODE)."
|
||||
;; Print symbols by type
|
||||
(when us
|
||||
(princ "\n !! Unspecified symbols\n")
|
||||
(mapc 'mode-local-print-binding us))
|
||||
(mapc #'mode-local-print-binding us))
|
||||
(when mc
|
||||
(princ "\n ** Mode local constants\n")
|
||||
(mapc 'mode-local-print-binding mc))
|
||||
(mapc #'mode-local-print-binding mc))
|
||||
(when mv
|
||||
(princ "\n ** Mode local variables\n")
|
||||
(mapc 'mode-local-print-binding mv))
|
||||
(mapc #'mode-local-print-binding mv))
|
||||
(when fo
|
||||
(princ "\n ** Final overloaded functions\n")
|
||||
(mapc 'mode-local-print-binding fo))
|
||||
(mapc #'mode-local-print-binding fo))
|
||||
(when ov
|
||||
(princ "\n ** Overloaded functions\n")
|
||||
(mapc 'mode-local-print-binding ov))
|
||||
(mapc #'mode-local-print-binding ov))
|
||||
))
|
||||
|
||||
(defun mode-local-describe-bindings-2 (buffer-or-mode)
|
||||
@ -876,27 +891,8 @@ invoked interactively."
|
||||
(when (setq mode (intern-soft mode))
|
||||
(mode-local-describe-bindings-1 mode (called-interactively-p 'any))))
|
||||
|
||||
;;; edebug support
|
||||
;;
|
||||
(defun mode-local-setup-edebug-specs ()
|
||||
"Define edebug specification for mode local macros."
|
||||
(def-edebug-spec setq-mode-local
|
||||
(symbolp &rest symbolp form))
|
||||
(def-edebug-spec defvar-mode-local
|
||||
(&define symbolp name def-form [ &optional stringp ] ))
|
||||
(def-edebug-spec defconst-mode-local
|
||||
defvar-mode-local)
|
||||
(def-edebug-spec define-overload
|
||||
(&define name lambda-list stringp def-body))
|
||||
(def-edebug-spec define-overloadable-function
|
||||
(&define name lambda-list stringp def-body))
|
||||
(def-edebug-spec define-mode-local-override
|
||||
(&define name symbolp lambda-list stringp def-body)))
|
||||
|
||||
(add-hook 'edebug-setup-hook 'mode-local-setup-edebug-specs)
|
||||
|
||||
(add-hook 'find-file-hook 'mode-local-post-major-mode-change)
|
||||
(add-hook 'change-major-mode-hook 'mode-local-on-major-mode-change)
|
||||
(add-hook 'find-file-hook #'mode-local-post-major-mode-change)
|
||||
(add-hook 'change-major-mode-hook #'mode-local-on-major-mode-change)
|
||||
|
||||
(provide 'mode-local)
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user