From 80c88470d9ea151ed6082c554ff9a8ba805c28f8 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Fri, 13 Jun 2025 19:56:59 +0200 Subject: [PATCH] elisp-mode.el: Optimize Xref integration --- lisp/emacs-lisp/scope.el | 12 +- lisp/progmodes/elisp-mode.el | 264 +++++++++++++++++------------------ 2 files changed, 140 insertions(+), 136 deletions(-) diff --git a/lisp/emacs-lisp/scope.el b/lisp/emacs-lisp/scope.el index d857c510542..34c9261b6b4 100644 --- a/lisp/emacs-lisp/scope.el +++ b/lisp/emacs-lisp/scope.el @@ -113,6 +113,7 @@ (scope-define-symbol-type symbol-type-definition (symbol-type) :doc "Symbol type name definitions." + :definition t :face 'elisp-symbol-type-definition :help (constantly "Symbol type definition") :imenu "Symbol Type" @@ -294,6 +295,7 @@ (scope-define-symbol-type defun () :doc "Function definitions." + :definition t :face 'font-lock-function-name-face :help (constantly "Function definition") :imenu "Function" @@ -301,6 +303,7 @@ (scope-define-symbol-type defvar () :doc "Variable definitions." + :definition t :face 'font-lock-variable-name-face :help (constantly "Special variable definition") :imenu "Variable" @@ -308,6 +311,7 @@ (scope-define-symbol-type defface () :doc "Face definitions." + :definition t :face 'font-lock-variable-name-face :help (constantly "Face definition") :imenu "Face" @@ -340,13 +344,14 @@ (scope-define-symbol-type deficon () :doc "Icon definitions." + :definition t :face 'font-lock-type-face :help (constantly "Icon definition") :imenu "Icon" :namespace 'icon) (scope-define-symbol-type oclosure () - :doc "oclosure type names." + :doc "OClosure type names." :face 'font-lock-type-face :help (lambda (beg end _def) (if-let ((sym (intern (buffer-substring-no-properties beg end)))) @@ -360,7 +365,8 @@ :namespace 'oclosure) (scope-define-symbol-type defoclosure () - :doc "oclosure type definitions." + :doc "OClosure type definitions." + :definition t :face 'font-lock-type-face :help (constantly "OClosure type definition") :imenu "OClosure type" @@ -381,6 +387,7 @@ (scope-define-symbol-type defcoding () :doc "Coding system definitions." + :definition t :face 'font-lock-type-face :help (constantly "Coding system definition") :imenu "Coding system" @@ -401,6 +408,7 @@ (scope-define-symbol-type defcharset () :doc "Charset definitions." + :definition t :face 'font-lock-type-face :help (constantly "Charset definition") :imenu "Charset" diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 3ce93afcfb5..50cb318cd0a 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1139,33 +1139,79 @@ confidence." ;; Use a property to transport the location of the identifier. (propertize ident 'pos (car bounds)))))) +(declare-function project-files "project" (project &optional dirs)) + (cl-defmethod xref-backend-definitions ((_backend (eql 'elisp)) identifier) (let* ((pos (get-text-property 0 'pos identifier)) - (dec (when pos - (save-excursion - (goto-char pos) - (beginning-of-defun) - (catch 'var-def - (scope (lambda (_type beg len _id &optional def) - (when (<= beg pos (+ beg len)) - (throw 'var-def def)))) - nil))))) - (if (numberp dec) + (enable-local-variables nil) + (gc-cons-threshold (* 1024 1024 1024)) + (type-def (when pos + (save-excursion + (goto-char pos) + (beginning-of-defun) + (catch 'var-def + (scope (lambda (type beg len _id &optional def) + (when (<= beg pos (+ beg len)) + (throw 'var-def (cons type def))))) + nil)))) + (type (car type-def)) + (def (cdr type-def))) + (if (numberp def) (list (xref-make "lexical binding" - (xref-make-buffer-location (current-buffer) dec))) - (require 'find-func) - (let ((sym (intern-soft identifier))) - (when sym - (let* ((namespace (if (and pos - ;; Reusing it in Help Mode. - (derived-mode-p 'emacs-lisp-mode)) - (elisp--xref-infer-namespace pos) - 'any)) - (defs (elisp--xref-find-definitions sym))) - (if (eq namespace 'maybe-variable) - (or (elisp--xref-filter-definitions defs 'variable sym) - (elisp--xref-filter-definitions defs 'any sym)) - (elisp--xref-filter-definitions defs namespace sym)))))))) + (xref-make-buffer-location (current-buffer) def))) + (let (res + (tar + (case type + ((symbol-type symbol-type-definition) 'symbol-type-definition) + ((variable defvar) 'defval) + ((face defface) 'defface) + ((defun function macro) 'defun) + ((icon deficon) 'deficon) + ((coding defcoding) 'defcoding) + ((charset defcharset) 'defcharset) + ((oclosure defoclosure) 'defoclosure)))) + (when tar + (require 'project) + (dolist-with-progress-reporter + (file + (seq-filter + (lambda (file) (string= (file-name-extension file) "el")) + (project-files (project-current)))) + "Scanning for definitions" + (let (all lla) + (pcase-dolist (`(,type ,beg ,len . ,_) (gethash identifier (elisp-sym-name-index file))) + (when (eq type tar) + (unless (eq beg (caar lla)) + (push (cons beg len) lla)))) + (when lla + (with-work-buffer + (insert-file-contents file) + (pcase-dolist (`(,beg . ,len) lla) + (goto-char beg) + (push + (let* ((begg (pos-bol)) + (endd (pos-eol)) + (line (buffer-substring begg endd)) + (cur (- beg begg))) + (add-face-text-property + cur (+ len cur) 'xref-match t line) + (xref-make-match + line + (xref-make-file-pos-location + file beg (line-number-at-pos beg)) + len)) + all)))) + (when all (setq res (nconc res (nreverse all))))))) + (if res res + (require 'find-func) + (let ((sym (intern-soft identifier))) + (when sym + (let* ((namespace (if pos (elisp--xref-infer-namespace pos) 'any)) + (defs (elisp--xref-find-definitions sym))) + (if (eq namespace 'maybe-variable) + (or (elisp--xref-filter-definitions defs 'variable sym) + (elisp--xref-filter-definitions defs 'any sym)) + (elisp--xref-filter-definitions defs namespace sym)))))))))) (defun elisp-local-references (pos) "Return references to local variable at POS as (BEG . LEN) cons cells." @@ -1181,9 +1227,7 @@ confidence." (pcase-lambda (`(,beg ,len ,id)) (when (equal id cur) (cons beg len))) all))) -(declare-function project-files "project" (project &optional dirs)) - -(cl-defmethod xref-backend-references :around ((_backend (eql 'elisp)) identifier) +(cl-defmethod xref-backend-references ((_backend (eql 'elisp)) identifier) (let* ((pos (get-text-property 0 'pos identifier)) (enable-local-variables nil) (gc-cons-threshold (* 1024 1024 1024))) @@ -1208,28 +1252,31 @@ confidence." (lambda (file) (string= (file-name-extension file) "el")) (project-files (project-current)))) "Scanning for references" - (pcase-dolist (`(,type ,beg ,len ,sym . ,_) (elisp-symbols-index file)) - (and (or (null types) (memq type types)) - (string= identifier sym) - (with-work-buffer - (insert-file-contents file) - (goto-char beg) - (push - (let* ((begg (pos-bol)) - (endd (pos-eol)) - (line (buffer-substring begg endd)) - (cur (- beg begg))) - (add-face-text-property - cur (+ len cur) 'xref-match t line) - (xref-make-match - line - (xref-make-file-pos-location - file beg (line-number-at-pos beg)) - len)) - res))))) - (nreverse res)) - ;; (cl-call-next-method backend identifier) - ))) + (let (all lla) + (pcase-dolist (`(,type ,beg ,len . ,_) (gethash identifier (elisp-sym-name-index file))) + (when (or (null types) (memq type types)) + (unless (eq beg (caar lla)) + (push (cons beg len) lla)))) + (when lla + (with-work-buffer + (insert-file-contents file) + (pcase-dolist (`(,beg . ,len) lla) + (goto-char beg) + (push + (let* ((begg (pos-bol)) + (endd (pos-eol)) + (line (buffer-substring begg endd)) + (cur (- beg begg))) + (add-face-text-property + cur (+ len cur) 'xref-match t line) + (xref-make-match + line + (xref-make-file-pos-location + file beg (line-number-at-pos beg)) + len)) + all)))) + (when all (setq res (nconc res (nreverse all)))))) + res)))) (defun elisp-make-xref (beg len) (let* ((beg-end (save-excursion @@ -2775,10 +2822,10 @@ of TARGET." (put 'read-symbol-shorthands 'safe-local-variable #'consp) -(defvar elisp-symbols-index-cache (make-hash-table :test #'equal)) +(defvar elisp-sym-type-index-cache (make-hash-table :test #'equal)) -(defun elisp-symbols-index (file) - (let ((cached (gethash file elisp-symbols-index-cache)) +(defun elisp-sym-type-index (file) + (let ((cached (gethash file elisp-sym-type-index-cache)) (modtime (file-attribute-modification-time (file-attributes file)))) (cdr (if (time-less-p (or (car cached) 0) modtime) @@ -2786,11 +2833,11 @@ of TARGET." (with-work-buffer (setq lexical-binding t) (insert-file-contents file) - (elisp-symbols-index-1 file))) - elisp-symbols-index-cache) + (elisp-sym-type-index-1 file))) + elisp-sym-type-index-cache) cached)))) -(defun elisp-symbols-index-1 (file) +(defun elisp-sym-type-index-1 (file) (let (all) (save-excursion (goto-char (point-min)) @@ -2799,90 +2846,39 @@ of TARGET." (scope (lambda (type beg len &rest _) (push - (list type beg len (buffer-substring beg (+ beg len))) - all)))) + (list beg len (buffer-substring beg (+ beg len))) + (alist-get type all))))) (end-of-file (nreverse all)) (error (message "Encountered error while scanning %s: %S" file e) nil))))) -(defun elisp-eval-1 (vars form) - (cond - ((consp form) - (let ((fun (car form)) (args (cdr form)) (evaluator nil)) - (cond - ((not (listp args)) '(error . wrong-type-argument)) - ((not (symbolp fun)) '(error . invalid-function)) - ((setq evaluator (elisp-get-evaluator fun)) (apply evaluator vars args)) - (t '(error . void-function))))) - ((and (symbolp form) (not (or (keywordp form) (booleanp form)))) - (if-let ((val (alist-get form vars))) `(ok . ,val) '(error . void-variable))) - (t `(ok . ,form)))) - -(defun elisp-eval-n (vars forms) - (catch 'ball - (while (cdr forms) - (let ((val (elisp-eval-1 vars (car forms)))) - (if (eq (car val) 'ok) (setq forms (cdr forms)) - (throw 'ball val)))) - (elisp-eval-1 vars (car forms)))) - -(defvar elisp-symbol-functions-alist nil) - -(defun elisp-get-evaluator (sym) - (or (get sym 'elisp-evaluator) (alist-get sym elisp-symbol-functions-alist))) - -(defmacro elisp-define-evaluator (fsym args &rest body) - (declare (indent defun)) - (let ((analyzer (intern (concat "elisp--evaluate-" (symbol-name fsym))))) - `(progn - (defun ,analyzer ,args ,@body) - (put ',fsym 'elisp-evaluator #',analyzer)))) - -(defmacro elisp-mark-function-as-safe (fsym) - (let ((analyzer (intern (concat "elisp--evaluate-" (symbol-name fsym))))) - `(progn - (defun ,analyzer (vars &rest args) - (elisp-eval-apply vars #',fsym args)) - (put ',fsym 'elisp-evaluator #',analyzer)))) - -(elisp-mark-function-as-safe cons) -(elisp-mark-function-as-safe car) -(elisp-mark-function-as-safe list) - -;; TODO: Look into unsafep.el. -;; TODO: Trust `side-effect-free' property. - -(defmacro elisp-mark-macro-as-safe (msym) - (let ((analyzer (intern (concat "elisp--evaluate-" (symbol-name msym))))) - `(progn - (defun ,analyzer (vars &rest args) - (elisp-eval-expand vars ',msym args)) - (put ',msym 'elisp-evaluator #',analyzer)))) - -(elisp-mark-macro-as-safe ignore-errors) - -(defun elisp-eval-apply (vars fun args) - (catch 'ball - (let (vals) - (dolist (arg args) - (let ((val (elisp-eval-1 vars arg))) - (if (eq (car val) 'ok) (push (cdr val) vals) - (throw 'ball val)))) - (condition-case e - `(ok . ,(apply fun vals)) - (error `(error . ,(car-safe e))))))) - -(defun elisp-eval-expand (vars mac args) - (elisp-eval-1 vars (macroexpand-1 (cons mac args)))) +(defvar elisp-sym-name-index-cache (make-hash-table :test #'equal)) -(elisp-define-evaluator progn (vars &rest body) - (elisp-eval-n vars body)) +(defun elisp-sym-name-index (file) + (let ((cached (gethash file elisp-sym-name-index-cache)) + (modtime (file-attribute-modification-time (file-attributes file)))) + (cdr + (if (time-less-p (or (car cached) 0) modtime) + (puthash file (cons modtime + (with-work-buffer + (setq lexical-binding t) + (insert-file-contents file) + (elisp-sym-name-index-1 file))) + elisp-sym-name-index-cache) + cached)))) -(elisp-define-evaluator if (vars cond then &rest else) - (let ((cond-val (elisp-eval-1 vars cond))) - (if (not (eq (car cond-val) 'ok)) cond-val - (if (cdr cond-val) - (elisp-eval-1 vars then) - (elisp-eval-n vars else))))) +(defun elisp-sym-name-index-1 (file) + (let ((all (make-hash-table :test #'equal))) + (save-excursion + (goto-char (point-min)) + (condition-case e + (while t + (scope + (lambda (type beg len &rest _) + (push + (list type beg len) + (gethash (buffer-substring beg (+ beg len)) all))))) + (end-of-file all) + (error (message "Encountered error while scanning %s: %S" file e) all))))) (provide 'elisp-mode) ;;; elisp-mode.el ends here -- 2.39.5