elisp-mode.el, scope.el: Also highlight function symbols

diff --git a/lisp/emacs-lisp/scope.el b/lisp/emacs-lisp/scope.el
index 52dc261bffb6cd4e24158b10f70ac51ac1fdb562..fe575611e7efb7db6f5bc910bae6c866d8ceec9c 100644 (file)
--- a/lisp/emacs-lisp/scope.el
+++ b/lisp/emacs-lisp/scope.el
@@ -64,9 +64,8 @@ Optional argument LOCAL is a local context to extend."
            bindings)
    (let ((l local))
      (dolist (binding bindings)
-       (let ((sym (if (consp binding) (car binding) binding)))
-         (when binding
-           (setq l (scope-local-new (bare-symbol sym) (symbol-with-pos-pos sym) l)))))
+       (when-let ((sym (if (consp binding) (car binding) binding)))
+         (setq l (scope-local-new (bare-symbol sym) (symbol-with-pos-pos sym) l))))
      (scope-n l body))))
 
 (defun scope-let* (local bindings body)
@@ -301,8 +300,11 @@ Optional argument LOCAL is a local context to extend."
   (mapcan (apply-partially #'scope-n local) clauses))
 
 (defun scope-setq (local args)
-  (cl-loop for (var val) on args by #'cddr
-           nconc (nconc (scope-s local var) (scope-1 local val))))
+  (when args
+    (let ((var (car args)) (val (cadr args)))
+      (nconc (scope-s local var)
+             (scope-1 local val)
+             (scope-setq local (cddr args))))))
 
 (defun scope-defvar (local _sym init) (scope-1 local init))
 
@@ -873,6 +875,35 @@ Optional argument LOCAL is a local context to extend."
             (scope-loop-with local (car rest) (cadr rest) (caddr rest) (cdddr rest)))
            ((memq bare '(do)) (scope-loop-do local (car rest) (cdr rest))))))))))
 
+(defun scope-named-let (local name bindings body)
+  (let ((bare (bare-symbol name))
+        (beg (symbol-with-pos-pos name)))
+    (cons
+     (list beg (length (symbol-name bare)) beg)
+     (nconc
+      (mapcan (lambda (binding)
+                (cond
+                 ((consp binding)
+                  (cons
+                   (let* ((sym (car binding))
+                          (beg (symbol-with-pos-pos sym))
+                          (bare (bare-symbol sym))
+                          (len (length (symbol-name bare))))
+                     (list beg len beg))
+                   (scope-1 local (cadr binding))))
+                 (binding
+                  (let* ((sym binding)
+                         (beg (symbol-with-pos-pos sym))
+                         (bare (bare-symbol sym))
+                         (len (length (symbol-name bare))))
+                    (list (list beg len beg))))))
+              bindings)
+      (let ((l (scope-local-new bare beg local)))
+        (dolist (binding bindings)
+          (when-let ((sym (if (consp binding) (car binding) binding)))
+            (setq l (scope-local-new (bare-symbol sym) (symbol-with-pos-pos sym) l))))
+        (let ((scope-flet-list (cons bare scope-flet-list))) (scope-n l body)))))))
+
 (defvar scope-assume-func-p nil)
 
 (defun scope-1 (local form &optional top-level)
@@ -884,8 +915,11 @@ Optional argument LOCAL is a local context to extend."
        ((symbol-with-pos-p f)
         (let ((bare (bare-symbol f)))
           (cond
-           ((or (functionp bare)
-                (memq bare '( if and or while
+           ((functionp bare) ;; (scope-n local forms)
+            (cons
+             (list (symbol-with-pos-pos f) (length (symbol-name bare)) 'function)
+             (scope-n local forms)))
+           ((or (memq bare '( if and or while
                               save-excursion save-restriction save-current-buffer
                               catch unwind-protect
                               progn prog1 eval-when-compile eval-and-compile with-eval-after-load
@@ -914,6 +948,8 @@ Optional argument LOCAL is a local context to extend."
              ((memq bare '(declare-function))
               (scope-declare-function local (car forms) (cadr forms)
                                       (caddr forms) (cadddr forms)))
+             ((memq bare '(let-when-compile))
+              (scope-let* local (car forms) (cdr forms)))
              ((memq bare '(if-let when-let and-let))
               (scope-if-let local (car forms) (cdr forms)))
              ((memq bare '(if-let* when-let* and-let* while-let))
@@ -942,6 +978,8 @@ Optional argument LOCAL is a local context to extend."
               (scope-1 local (car forms)))
              ((memq bare '(letrec))
               (scope-letrec local (car forms) (cdr forms)))
+             ((memq bare '(named-let))
+              (scope-named-let local (car forms) (cadr forms) (cdr forms)))
              ((memq bare '(cl-flet))
               (scope-flet local (car forms) (cdr forms)))
              ((memq bare '(cl-labels))
@@ -1025,7 +1063,7 @@ starting with a top-level form, by inspecting HEAD at each level:
   `scope-n' to obtain bindings graphs for sub-forms.  See also
   `scope-local-new' for extending LOCAL with local bindings in TAIL.
 
-- If within the code under analysis HEAD is a `cl-letf'-bound local
+- If within the code under analysis HEAD is a `cl-flet'-bound local
   function name, analyze the form as a function call.
 
 - Otherwise, HEAD is unknown.  If the HEAD of the top-level form that

diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 1a5861d80dd7c45704bd3ce05aa085719e10b682..5490ef8dc528d3706c01f6ab15f00384369a6a41 100644 (file)
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -377,13 +377,16 @@ happens in interactive invocations."
                              (condition-case nil
                                  (scope (current-buffer))
                                (end-of-file nil)))
-                (if (null bin)
-                    (font-lock-append-text-property sym (+ sym len) 'face 'elisp-free-variable)
+                (cond
+                 ((numberp bin)
                   (font-lock-append-text-property sym (+ sym len) 'face (if (= sym bin)
                                                                             'elisp-binding-variable
                                                                           'elisp-bound-variable))
                   (put-text-property sym (+ sym len 1) 'cursor-sensor-functions
-                                     (elisp-cursor-sensor bin))))))
+                                     (elisp-cursor-sensor bin)))
+                 ((eq bin 'function)
+                  (font-lock-append-text-property sym (+ sym len) 'face 'font-lock-function-call-face))
+                 (t (font-lock-append-text-property sym (+ sym len) 'face 'elisp-free-variable))))))
           `(jit-lock-bounds ,beg . ,end)))
       (font-lock-default-fontify-region beg end loudly)))
 
@@ -409,6 +412,7 @@ be used instead.
 \\{emacs-lisp-mode-map}"
   :group 'lisp
   (defvar project-vc-external-roots-function)
+  (setq font-lock-defaults (copy-tree font-lock-defaults))
   (setcar font-lock-defaults
           '(lisp-el-font-lock-keywords
             lisp-el-font-lock-keywords-1
@@ -416,8 +420,10 @@ be used instead.
   (setcdr (nthcdr 4 font-lock-defaults)
           (cons '(font-lock-fontify-region-function . elisp-fontify-region)
                 (nthcdr 5 font-lock-defaults)))
-  (push 'cursor-sensor-functions
-        (alist-get 'font-lock-extra-managed-props (nthcdr 5 font-lock-defaults)))
+  (unless (memq 'cursor-sensor-functions
+                (alist-get 'font-lock-extra-managed-props (nthcdr 5 font-lock-defaults)))
+    (push 'cursor-sensor-functions
+          (alist-get 'font-lock-extra-managed-props (nthcdr 5 font-lock-defaults))))
   (setf (nth 2 font-lock-defaults) nil)
   (add-hook 'after-load-functions #'elisp--font-lock-flush-elisp-buffers)
   (if (boundp 'electric-pair-text-pairs)
@@ -1111,15 +1117,17 @@ namespace but with lower confidence."
 
 (cl-defmethod xref-backend-definitions ((_backend (eql 'elisp)) identifier)
   (let* ((pos (get-text-property 0 'pos identifier))
-         (dec (seq-some
-               (pcase-lambda (`(,beg ,len ,dec))
-                 (when (<= beg pos (+ beg len)) dec))
-               (save-excursion
-                 (goto-char pos)
-                 (beginning-of-defun)
-                 (scope (current-buffer))))))
-    (if dec (list (xref-make "lexical binding"
-                             (xref-make-buffer-location (current-buffer) dec)))
+         (dec (when pos
+                (seq-some
+                 (pcase-lambda (`(,beg ,len ,dec))
+                   (when (<= beg pos (+ beg len)) dec))
+                 (save-excursion
+                   (goto-char pos)
+                   (beginning-of-defun)
+                   (scope (current-buffer)))))))
+    (if (numberp dec)
+        (list (xref-make "lexical binding"
+                         (xref-make-buffer-location (current-buffer) dec)))
       (require 'find-func)
       (let ((sym (intern-soft identifier)))
         (when sym

diff --git a/lisp/progmodes/refactor-elisp.el b/lisp/progmodes/refactor-elisp.el
index be33e7ece440699a66a067b88f626756ed58a2cd..996dbecdc3f5b861d2362f7e738bde9587b13d88 100644 (file)
--- a/lisp/progmodes/refactor-elisp.el
+++ b/lisp/progmodes/refactor-elisp.el
@@ -35,7 +35,7 @@
                (scope (current-buffer)))))
     (seq-some
      (pcase-lambda (`(,beg ,len ,bin))
-       (and bin (<= beg (point) (+ beg len))
+       (and (numberp bin) (<= beg (point) (+ beg len))
             (list (propertize (buffer-substring-no-properties beg (+ beg len))
                               'pos beg))))
      all)))

diff --git a/test/lisp/emacs-lisp/scope-tests.el b/test/lisp/emacs-lisp/scope-tests.el
index 030e05d0335279cbff48efa920ed9d1d2712d988..d57c982175620d1053fa14a9c22a3641eb9d8cb7 100644 (file)
--- a/test/lisp/emacs-lisp/scope-tests.el
+++ b/test/lisp/emacs-lisp/scope-tests.el
@@ -32,8 +32,10 @@
                    (76 3 13)
                    (80 4 nil)
                    (85 3 51)
+                   (97 6 function)
                    (104 3 13)
                    (108 3 51)
+                   (118 6 function)
                    (125 3 17))
                  (scope "
 (defun foo (bar baz)
@@ -45,13 +47,16 @@
 
 (ert-deftest scope-test-2 ()
   (should (equal '((110 11 110)
+                   (133 16 function)
                    (197 6 197)
+                   (228 7 function)
                    (236 6 197)
                    (257 2 257)
                    (263 3 263)
                    (287 2 287)
                    (290 3 263)
                    (313 2 257)
+                   (317 9 function)
                    (327 2 287)
                    (330 11 110)
                    (353 11 110))
@@ -69,10 +74,12 @@
     op-be-alist))"))))
 
 (ert-deftest scope-test-3 ()
-  (should (equal '((45 3 45)            ;env
-                   (55 4 55)            ;body
-                   (136 4 136)          ;syms
-                   (172 4 172)          ;vals
+  (should (equal '((45 3 45)
+                   (55 4 55)
+                   (136 4 136)
+                   (142 11 function)
+                   (172 4 172)
+                   (178 11 function)
                    (212 4 136)
                    (218 4 172)
                    (258 3 45)

diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el
index 591c32a8271284bc3d9dc5de3fa18f31ccf3416e..e8224db361324f6282099bbd6165a498a8dd8ad5 100644 (file)
--- a/test/lisp/progmodes/elisp-mode-tests.el
+++ b/test/lisp/progmodes/elisp-mode-tests.el
@@ -785,7 +785,8 @@ to (xref-elisp-test-descr-to-target xref)."
 (xref-elisp-deftest find-defs-minor-defvar-c
   (with-temp-buffer
     (emacs-lisp-mode)
-    (insert "(foo overwrite-mode")
+    (insert "(foo overwrite-mode)")
+    (backward-char)
     (xref-backend-definitions 'elisp
                               (xref-backend-identifier-at-point 'elisp)))
   (list