commit 73a320801e9af61a48fd0e803afcd02b059b2338 (HEAD, refs/remotes/origin/master) Author: Yuan Fu Date: Fri Mar 24 13:13:05 2023 -0700 Add treesit-node-get * doc/lispref/parsing.texi (Retrieving Nodes): Add manual entry. * lisp/treesit.el (treesit-node--get): New function. diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index 86a5d9f2e52..38c9ec8c2f0 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -849,6 +849,53 @@ Retrieving Nodes @heading More convenience functions +@defun treesit-node-get node instructions +This is a convenience function that chains together multiple node +accessor functions together. For example, to get @var{node}'s +parent's next sibling's second child's text: + +@example +@group +(treesit-node-get node + '((parent 1) + (sibling 1 nil) + (child 1 nil) + (text nil))) +@end group +@end example + +@var{instruction} is a list of INSTRUCTIONs of the form +@w{@code{(@var{fn} @var{arg}...)}}. The following @var{fn}'s are +supported: + +@table @code +@item (child @var{idx} @var{named}) +Get the @var{idx}'th child. + +@item (parent @var{n}) +Go to parent @var{n} times. + +@item (field-name) +Get the field name of the current node. + +@item (type) +Get the type of the current node. + +@item (text @var{no-property}) +Get the text of the current node. + +@item (children @var{named}) +Get a list of children. + +@item (sibling @var{step} @var{named}) +Get the nth prev/next sibling, negative @var{step} means prev sibling, +positive means next sibling. +@end table + +Note that arguments like @var{named} and @var{no-property} can't be +omitted, unlike in their original functions. +@end defun + @defun treesit-filter-child node predicate &optional named This function finds immediate children of @var{node} that satisfy @var{predicate}. diff --git a/lisp/treesit.el b/lisp/treesit.el index e3c7d569ea6..4c4ba4ad6ac 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -363,6 +363,50 @@ treesit-node-field-name (idx (treesit-node-index node))) (treesit-node-field-name-for-child parent idx))) +(defun treesit-node-get (node instructions) + "Get things from NODE by INSTRUCTIONS. + +This is a convenience function that chains together multiple node +accessor functions together. For example, to get NODE's parent's +next sibling's second child's text, call + + (treesit-node-get node + \\='((parent 1) + (sibling 1 nil) + (child 1 nil) + (text nil))) + +INSTRUCTION is a list of INSTRUCTIONs of the form (FN ARG...). +The following FN's are supported: + +\(child IDX NAMED) Get the IDX'th child +\(parent N) Go to parent N times +\(field-name) Get the field name of the current node +\(type) Get the type of the current node +\(text NO-PROPERTY) Get the text of the current node +\(children NAMED) Get a list of children +\(sibling STEP NAMED) Get the nth prev/next sibling, negative STEP + means prev sibling, positive means next + +Note that arguments like NAMED and NO-PROPERTY can't be omitted, +unlike in their original functions." + (declare (indent 1)) + (while (and node instructions) + (pcase (pop instructions) + ('(field-name) (setq node (treesit-node-field-name node))) + ('(type) (setq node (treesit-node-type node))) + (`(child ,idx ,named) (setq node (treesit-node-child node idx named))) + (`(parent ,n) (dotimes (_ n) + (setq node (treesit-node-parent node)))) + (`(text ,no-property) (setq node (treesit-node-text node no-property))) + (`(children ,named) (setq node (treesit-node-children node named))) + (`(sibling ,step ,named) + (dotimes (_ (abs step)) + (setq node (if (> step 0) + (treesit-node-next-sibling node named) + (treesit-node-prev-sibling node named))))))) + node) + ;;; Query API supplement (defun treesit-query-string (string query language) commit 560c27a332cf3739fc0b2bab7ad3118cd6998f12 Author: Mattias Engdegård Date: Wed Mar 29 22:16:37 2023 +0200 ; * test/lisp/dired-aux-tests.el: remove mistaken unwind-protect diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index 5939f480680..62011d8b0f0 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -55,12 +55,11 @@ with-dired-bug28834-test (setq to-mv (expand-file-name "foo-mv" (file-name-as-directory (expand-file-name "qux" ,foo)))) - (unwind-protect - (if ,yes-or-no - (cl-letf (((symbol-function 'yes-or-no-p) - (lambda (_prompt) (eq ,yes-or-no 'yes)))) - ,@body) - ,@body))))))) + (if ,yes-or-no + (cl-letf (((symbol-function 'yes-or-no-p) + (lambda (_prompt) (eq ,yes-or-no 'yes)))) + ,@body) + ,@body)))))) (ert-deftest dired-test-bug28834 () "test for https://debbugs.gnu.org/28834 ." commit bfa3500c3c6e4df58978e84753718cd5358c06fb Author: Michael Albinus Date: Wed Mar 29 20:22:04 2023 +0200 Rework zeroconf integration into tramp-gvfs.el * lisp/net/tramp-gvfs.el (tramp-gvfs-enabled): Do not check for :system bus. (tramp-gvfs-mounttypes): New defconst. (tramp-gvfs-maybe-open-connection): Use it. (top): Call zeroconf only when :system bus is available. diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index f925d2f3da5..d44fd55b225 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -119,8 +119,6 @@ (defconst tramp-gvfs-enabled (ignore-errors (and (featurep 'dbusbind) - (autoload 'zeroconf-init "zeroconf") - (tramp-compat-funcall 'dbus-get-unique-name :system) (tramp-compat-funcall 'dbus-get-unique-name :session) (or (tramp-process-running-p "gvfs-fuse-daemon") (tramp-process-running-p "gvfsd-fuse")))) @@ -224,6 +222,13 @@ tramp-gvfs-listmounttypes "The name of the \"listMountTypes\" method. It has been changed in GVFS 1.14.") +(defconst tramp-gvfs-mounttypes + (and tramp-gvfs-enabled + (dbus-call-method + :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker + tramp-gvfs-interface-mounttracker tramp-gvfs-listmounttypes)) + "The list of supported mount types of the mount tracking interface.") + (defconst tramp-gvfs-listmounts (if (member "ListMounts" tramp-gvfs-methods-mounttracker) "ListMounts" @@ -2188,11 +2193,7 @@ tramp-gvfs-maybe-open-connection ("afp". "afp-volume") ("gdrive" . "google-drive"))) method) - (with-tramp-dbus-call-method vec t - :session tramp-gvfs-service-daemon - tramp-gvfs-path-mounttracker - tramp-gvfs-interface-mounttracker - tramp-gvfs-listmounttypes)) + tramp-gvfs-mounttypes) (tramp-error vec 'file-error "Method `%s' not supported by GVFS" method))) ;; For password handling, we need a process bound to the connection @@ -2538,43 +2539,45 @@ tramp-gvfs-parse-device-names ;; Suppress D-Bus error messages and Tramp traces. (let ((tramp-verbose 0) tramp-gvfs-dbus-event-vector fun) - ;; Add completion functions for services announced by DNS-SD. - ;; See for valid service types. - (zeroconf-init tramp-gvfs-zeroconf-domain) - (when (setq fun (or (and (zeroconf-list-service-types) - #'tramp-zeroconf-parse-device-names) - (and (executable-find "avahi-browse") - #'tramp-gvfs-parse-device-names))) - (when (member "afp" tramp-gvfs-methods) - (tramp-set-completion-function - "afp" `((,fun "_afpovertcp._tcp")))) - (when (member "dav" tramp-gvfs-methods) - (tramp-set-completion-function - "dav" `((,fun "_webdav._tcp") - (,fun "_webdavs._tcp")))) - (when (member "davs" tramp-gvfs-methods) - (tramp-set-completion-function - "davs" `((,fun "_webdav._tcp") - (,fun "_webdavs._tcp")))) - (when (member "ftp" tramp-gvfs-methods) - (tramp-set-completion-function - "ftp" `((,fun "_ftp._tcp")))) - (when (member "http" tramp-gvfs-methods) - (tramp-set-completion-function - "http" `((,fun "_http._tcp") - (,fun "_https._tcp")))) - (when (member "https" tramp-gvfs-methods) - (tramp-set-completion-function - "https" `((,fun "_http._tcp") - (,fun "_https._tcp")))) - (when (member "sftp" tramp-gvfs-methods) - (tramp-set-completion-function - "sftp" `((,fun "_sftp-ssh._tcp") - (,fun "_ssh._tcp") - (,fun "_workstation._tcp")))) - (when (member "smb" tramp-gvfs-methods) - (tramp-set-completion-function - "smb" `((,fun "_smb._tcp"))))) + (when (and (autoload 'zeroconf-init "zeroconf") + (tramp-compat-funcall 'dbus-get-unique-name :system)) + ;; Add completion functions for services announced by DNS-SD. + ;; See for valid service types. + (zeroconf-init tramp-gvfs-zeroconf-domain) + (when (setq fun (or (and (zeroconf-list-service-types) + #'tramp-zeroconf-parse-device-names) + (and (executable-find "avahi-browse") + #'tramp-gvfs-parse-device-names))) + (when (member "afp" tramp-gvfs-methods) + (tramp-set-completion-function + "afp" `((,fun "_afpovertcp._tcp")))) + (when (member "dav" tramp-gvfs-methods) + (tramp-set-completion-function + "dav" `((,fun "_webdav._tcp") + (,fun "_webdavs._tcp")))) + (when (member "davs" tramp-gvfs-methods) + (tramp-set-completion-function + "davs" `((,fun "_webdav._tcp") + (,fun "_webdavs._tcp")))) + (when (member "ftp" tramp-gvfs-methods) + (tramp-set-completion-function + "ftp" `((,fun "_ftp._tcp")))) + (when (member "http" tramp-gvfs-methods) + (tramp-set-completion-function + "http" `((,fun "_http._tcp") + (,fun "_https._tcp")))) + (when (member "https" tramp-gvfs-methods) + (tramp-set-completion-function + "https" `((,fun "_http._tcp") + (,fun "_https._tcp")))) + (when (member "sftp" tramp-gvfs-methods) + (tramp-set-completion-function + "sftp" `((,fun "_sftp-ssh._tcp") + (,fun "_ssh._tcp") + (,fun "_workstation._tcp")))) + (when (member "smb" tramp-gvfs-methods) + (tramp-set-completion-function + "smb" `((,fun "_smb._tcp")))))) ;; Add completion functions for GNOME Online Accounts. (tramp-get-goa-accounts nil) @@ -2604,9 +2607,9 @@ tramp-gvfs-parse-device-names ;; * Host name completion for existing mount points (afp-server, ;; smb-server) or via smb-network or network. ;; +;; * What's up with the other types in `tramp-gvfs-mounttypes'? +;; ;; * Check, how two shares of the same SMB server can be mounted in ;; parallel. -;; -;; * What's up with ftps dns-sd afc admin computer? ;;; tramp-gvfs.el ends here commit e324060369f7b729ca66a45fd10f15e780f754ca Author: Mattias Engdegård Date: Wed Mar 29 17:03:31 2023 +0200 Avoid unwind-protect without unwind forms in cl-letf * lisp/emacs-lisp/cl-macs.el (cl--letf): Use unwind-protect only if necessary, avoiding a warning. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index cffe8b09f53..8dc8b475a7f 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2758,26 +2758,29 @@ cl--letf ;; Common-Lisp's `psetf' does the first, so we'll do the same. (if (null bindings) (if (and (null binds) (null simplebinds)) (macroexp-progn body) + (let ((body-form + (macroexp-progn + (append + (delq nil + (mapcar (lambda (x) + (pcase x + ;; If there's no vnew, do nothing. + (`(,_vold ,_getter ,setter ,vnew) + (funcall setter vnew)))) + binds)) + body)))) `(let* (,@(mapcar (lambda (x) (pcase-let ((`(,vold ,getter ,_setter ,_vnew) x)) (list vold getter))) binds) ,@simplebinds) - (unwind-protect - ,(macroexp-progn - (append - (delq nil - (mapcar (lambda (x) - (pcase x - ;; If there's no vnew, do nothing. - (`(,_vold ,_getter ,setter ,vnew) - (funcall setter vnew)))) - binds)) - body)) - ,@(mapcar (lambda (x) - (pcase-let ((`(,vold ,_getter ,setter ,_vnew) x)) - (funcall setter vold))) - binds)))) + ,(if binds + `(unwind-protect ,body-form + ,@(mapcar (lambda (x) + (pcase-let ((`(,vold ,_getter ,setter ,_vnew) x)) + (funcall setter vold))) + binds)) + body-form)))) (let* ((binding (car bindings)) (place (car binding))) (gv-letplace (getter setter) place commit 9c31ee468618c95959454736d939eb46bc52b19b Author: Mattias Engdegård Date: Wed Mar 29 13:21:26 2023 +0200 Warn about unwind-protect without unwind forms `unwind-protect` without unwind forms is not just pointless but often indicates a mistake where the intended unwind part is misplaced, as in (unwind-protect (progn PROT-FORMS UNWIND-FORMS)) ; oops or (unwind-protect PROT-FORM) UNWIND-FORMS ; also oops or entirely forgotten for that matter. Warning about this makes sense, and the warning can always be silenced by removing the `unwind-protect` altogether if it shouldn't be there in the first place. * lisp/emacs-lisp/macroexp.el (macroexp--expand-all): Implement warning. * etc/NEWS: Announce. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-test--with-suppressed-warnings): Add test case. diff --git a/etc/NEWS b/etc/NEWS index 9e45b1d80b2..f27cafb3d41 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -418,6 +418,21 @@ was to catch all errors, add an explicit handler for 'error', or use This warning can be suppressed using 'with-suppressed-warnings' with the warning name 'suspicious'. +--- +*** Warn about 'unwind-protect' without unwind forms. +The compiler now warns when the 'unwind-protect' form is used without +any unwind forms, as in + + (unwind-protect (read buffer)) + +because the behaviour is identical to that of the argument; there is +no protection of any kind. Perhaps the intended unwind forms have +been misplaced or forgotten, or the use of 'unwind-protect' could be +simplified away. + +This warning can be suppressed using 'with-suppressed-warnings' with +the warning name 'suspicious'. + +++ ** New function 'file-user-uid'. This function is like 'user-uid', but is aware of file name handlers, diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 8cb67c3b8b5..b05aba3e1a7 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -383,6 +383,11 @@ macroexp--expand-all (format-message "missing `while' condition") `(signal 'wrong-number-of-arguments '(while 0)) nil 'compile-only form)) + (`(unwind-protect ,expr) + (macroexp-warn-and-return + (format-message "`unwind-protect' without unwind forms") + (macroexp--expand-all expr) + (list 'suspicious 'unwind-protect) t form)) (`(setq ,(and var (pred symbolp) (pred (not booleanp)) (pred (not keywordp))) ,expr) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 2cd4dd75742..5bad1ce41a8 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -1461,6 +1461,12 @@ bytecomp-test--with-suppressed-warnings '((suspicious condition-case)) "Warning: `condition-case' without handlers") + (test-suppression + '(defun zot (x) + (unwind-protect (print x))) + '((suspicious unwind-protect)) + "Warning: `unwind-protect' without unwind forms") + (test-suppression '(defun zot () (let ((_ 1)) commit 7177393826c73c87ffe9b428f0e5edae244d7a98 Author: Michael Albinus Date: Wed Mar 29 16:10:29 2023 +0200 Fix D-Bus event loop when executing a keyboard macro * lisp/net/dbus.el (dbus-call-method): Don't loop for events when `executing-kbd-macro' is non-nil. (Bug#62018) diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index f35d11db152..fff860b05c3 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -371,7 +371,11 @@ dbus-call-method (apply #'dbus-message-internal dbus-message-type-method-call bus service path interface method #'dbus-call-method-handler args)) - (result (cons :pending nil))) + (result (unless executing-kbd-macro (cons :pending nil)))) + + ;; While executing a keyboard macro, we run into an infinite loop, + ;; receiving the event -1. So we don't try to get the result. + ;; (Bug#62018) ;; Wait until `dbus-call-method-handler' has put the result into ;; `dbus-return-values-table'. If no timeout is given, use the commit fea7708a48a762a396d014ecd5a1c61a776e635a Author: dannyfreeman Date: Sat Mar 25 15:13:41 2023 -0400 Add clojure-ts-mode to eglot-server-programs * lisp/progmodes/eglot.el (eglot-server-programs): Add clojure-ts-mode. (Bug#62449) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index cc9c8115b08..3072095aeb2 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -246,7 +246,7 @@ eglot-server-programs ("css-languageserver" "--stdio")))) (html-mode . ,(eglot-alternatives '(("vscode-html-language-server" "--stdio") ("html-languageserver" "--stdio")))) ((dockerfile-mode dockerfile-ts-mode) . ("docker-langserver" "--stdio")) - ((clojure-mode clojurescript-mode clojurec-mode) + ((clojure-mode clojurescript-mode clojurec-mode clojure-ts-mode) . ("clojure-lsp")) ((csharp-mode csharp-ts-mode) . ,(eglot-alternatives commit 953ad30a52816126309c30e3239d28caef10cc0e Author: Michael Albinus Date: Wed Mar 29 13:18:15 2023 +0200 * test/infra/Dockerfile.emba (emacs-eglot): Adapt software selection. diff --git a/test/infra/Dockerfile.emba b/test/infra/Dockerfile.emba index c7a5b36749c..f8a10f913ef 100644 --- a/test/infra/Dockerfile.emba +++ b/test/infra/Dockerfile.emba @@ -64,17 +64,22 @@ FROM emacs-base as emacs-eglot RUN apt-get update && \ apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 \ - snapd wget lsb-release software-properties-common gpg \ + wget lsb-release software-properties-common gpg \ && rm -rf /var/lib/apt/lists/* # A recent clangd. It must be at least clangd 14, which is in Debian # bookworm. RUN bash -c "$(wget --no-check-certificate -O - https://apt.llvm.org/llvm.sh)" +RUN ln -s /usr/bin/clangd-15 /usr/bin/clangd -# A recent pylsp. Since Debian bookworm there is the package +# A recent pylsp. In Debian bookworm there is the package # python3-pylsp. -# RUN snap install core -# RUN snap install pylsp +RUN apt-get update && \ + apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 \ + python3-pyls \ + && rm -rf /var/lib/apt/lists/* +# eglot.el knows pyls. However, eglot-tests.el checks only for pylsp. +RUN ln -s /usr/bin/pyls /usr/bin/pylsp COPY . /checkout WORKDIR /checkout