diff --git a/CHANGELOG.org b/CHANGELOG.org index 143718f23b..853f05f2cd 100644 --- a/CHANGELOG.org +++ b/CHANGELOG.org @@ -14,7 +14,9 @@ * Change ~ruff-lsp~ to ~ruff~ for python lsp client. All ~ruff-lsp~ customizable variable change to ~ruff~. Lsp server command now is ~["ruff" "server"]~ instead of ~["ruff-lsp"]~. * Add futhark support * Optimize overlay creation by checking window visibility first - + * Replace the per-interface ~(INTERFACE ...)~ pcase forms with a single, + unified ~(lsp-interface INTERFACE ...)~ form. The per-interface forms are no + longer generated. *This is a breaking change.* (See #4430.) ** 9.0.0 * Add language server config for QML (Qt Modeling Language) using qmlls. diff --git a/lsp-completion.el b/lsp-completion.el index 0f2be89544..dab10513fd 100644 --- a/lsp-completion.el +++ b/lsp-completion.el @@ -575,8 +575,8 @@ Others: CANDIDATES" (apply #'delete-region markers) (insert prefix) (pcase text-edit? - ((TextEdit) (lsp--apply-text-edit text-edit?)) - ((InsertReplaceEdit :insert :replace :new-text) + ((lsp-interface TextEdit) (lsp--apply-text-edit text-edit?)) + ((lsp-interface InsertReplaceEdit :insert :replace :new-text) (lsp--apply-text-edit (lsp-make-text-edit :new-text new-text diff --git a/lsp-mode.el b/lsp-mode.el index 19600a78a3..c397b70c82 100644 --- a/lsp-mode.el +++ b/lsp-mode.el @@ -5245,11 +5245,11 @@ identifier and the position respectively." type Location, LocationLink, Location[] or LocationLink[]." (setq locations (pcase locations - ((seq (or (Location) - (LocationLink))) + ((seq (or (lsp-interface Location) + (lsp-interface LocationLink))) (append locations nil)) - ((or (Location) - (LocationLink)) + ((or (lsp-interface Location) + (lsp-interface LocationLink)) (list locations)))) (cl-labels ((get-xrefs-in-file @@ -5616,9 +5616,9 @@ When language is nil render as markup if `markdown-mode' is loaded." (let ((inhibit-message t)) (or (pcase content - ((MarkedString :value :language) + ((lsp-interface MarkedString :value :language) (lsp--render-string value language)) - ((MarkupContent :value :kind) + ((lsp-interface MarkupContent :value :kind) (lsp--render-string value kind)) ;; plain string ((pred stringp) (lsp--render-string content "markdown")) @@ -6408,11 +6408,11 @@ perform the request synchronously." (-mapcat (-lambda (sym) (pcase-exhaustive sym - ((DocumentSymbol :name :children? :selection-range (Range :start)) + ((lsp-interface DocumentSymbol :name :children? :selection-range (lsp-interface Range :start)) (cons (cons (concat path name) (lsp--position-to-point start)) (lsp--xref-elements-index children? (concat path name " / ")))) - ((SymbolInformation :name :location (Location :range (Range :start))) + ((lsp-interface SymbolInformation :name :location (lsp-interface Location :range (lsp-interface Range :start))) (list (cons (concat path name) (lsp--position-to-point start)))))) symbols)) diff --git a/lsp-protocol.el b/lsp-protocol.el index d5b98a00e5..f3b8b6cd82 100644 --- a/lsp-protocol.el +++ b/lsp-protocol.el @@ -129,7 +129,7 @@ Allowed params: %s" interface (reverse (-map #'cl-first params))) $$result)) (-partition 2 plist)) $$result))) - `(pcase-defmacro ,interface (&rest property-bindings) + `(cl-defun ,(intern (format "lsp--pcase-macroexpander-%s" interface)) (&rest property-bindings) ,(if lsp-use-plists ``(and (pred listp) @@ -246,6 +246,25 @@ Allowed params: %s" interface (reverse (-map #'cl-first params))) (apply #'append) (cl-list* 'progn)))) +(pcase-defmacro lsp-interface (interface &rest property-bindings) + "If EXPVAL is an instance of INTERFACE, destructure it by matching its +properties. EXPVAL should be a plist or hash table depending on the variable +`lsp-use-plists'. + +INTERFACE should be an LSP interface defined with `lsp-interface'. This form +will not match if any of INTERFACE's required fields are missing in EXPVAL. + +Each :PROPERTY keyword matches a field in EXPVAL. The keyword may be followed by +an optional PATTERN, which is a `pcase' pattern to apply to the field's value. +Otherwise, PROPERTY is let-bound to the field's value. + +\(fn INTERFACE [:PROPERTY [PATTERN]]...)" + (cl-check-type interface symbol) + (let ((lsp-pcase-macroexpander + (intern (format "lsp--pcase-macroexpander-%s" interface)))) + (cl-assert (fboundp lsp-pcase-macroexpander) "not a known LSP interface: %s" interface) + (apply lsp-pcase-macroexpander property-bindings))) + (if lsp-use-plists (progn (defun lsp-get (from key) diff --git a/test/lsp-protocol-test.el b/test/lsp-protocol-test.el index 9a5adc2c65..7b5a422cf3 100644 --- a/test/lsp-protocol-test.el +++ b/test/lsp-protocol-test.el @@ -81,28 +81,34 @@ (lsp-make-my-position :line 30 :character 40 :camelCase nil) :specialProperty 42))) (should (pcase particular-range - ((MyRange :start (MyPosition :line start-line :character start-char :camel-case start-camelcase) - :end (MyPosition :line end-line :character end-char :camel-case end-camelCase)) + ((lsp-interface MyRange + :start (lsp-interface MyPosition + :line start-line :character start-char :camel-case start-camelcase) + :end (lsp-interface MyPosition + :line end-line :character end-char :camel-case end-camelCase)) t) (_ nil))) (should (pcase particular-extended-range - ((MyExtendedRange) + ((lsp-interface MyExtendedRange) t) (_ nil))) ;; a subclass can be matched by a pattern for a parent class (should (pcase particular-extended-range - ((MyRange :start (MyPosition :line start-line :character start-char :camel-case start-camelcase) - :end (MyPosition :line end-line :character end-char :camel-case end-camelCase)) + ((lsp-interface MyRange + :start (lsp-interface MyPosition + :line start-line :character start-char :camel-case start-camelcase) + :end (lsp-interface MyPosition + :line end-line :character end-char :camel-case end-camelCase)) t) (_ nil))) ;; the new patterns should be able to be used with existing ones (should (pcase (list particular-range particular-extended-range) - ((seq (MyRange) - (MyExtendedRange)) + ((seq (lsp-interface MyRange) + (lsp-interface MyExtendedRange)) t) (_ nil))) @@ -110,8 +116,8 @@ ;; not in the order specified by the inner patterns (should-not (pcase (list particular-range particular-extended-range) - ((seq (MyExtendedRange) - (MyRange)) + ((seq (lsp-interface MyExtendedRange) + (lsp-interface MyRange)) t) (_ nil))) @@ -122,8 +128,11 @@ ;; and the second instance is an equality check against the other ;; :character value, which is different. (should-not (pcase particular-range - ((MyRange :start (MyPosition :line start-line :character :camel-case start-camelcase) - :end (MyPosition :line end-line :character :camel-case end-camelCase)) + ((lsp-interface MyRange + :start (lsp-interface MyPosition + :line start-line :character :camel-case start-camelcase) + :end (lsp-interface MyPosition + :line end-line :character :camel-case end-camelCase)) t) (_ nil))) @@ -131,7 +140,7 @@ ;; should still match if the required stuff matches. Missing ;; optional properties are bound to nil. (should (pcase particular-range - ((MyRange :start (MyPosition :optional?)) + ((lsp-interface MyRange :start (lsp-interface MyPosition :optional?)) (null optional?)) (_ nil))) @@ -139,23 +148,23 @@ ;; the interface, even if the expr-val has all the types specified ;; by the interface. This is a programmer error. (should-error (pcase particular-range - ((MyRange :something-unrelated) + ((lsp-interface MyRange :something-unrelated) t) (_ nil))) ;; we do not use camelCase at this stage. This is a programmer error. (should-error (pcase particular-range - ((MyRange :start (MyPosition :camelCase)) + ((lsp-interface MyRange :start (lsp-interface MyPosition :camelCase)) t) (_ nil))) (should (pcase particular-range - ((MyRange :start (MyPosition :camel-case)) + ((lsp-interface MyRange :start (lsp-interface MyPosition :camel-case)) t) (_ nil))) ;; :end is missing, so we should fail to match the interface. (should-not (pcase (lsp-make-my-range :start (lsp-make-my-position :line 10 :character 20 :camelCase nil)) - ((MyRange) + ((lsp-interface MyRange) t) (_ nil)))))