commit b3207538c61c0e5d370df36a35e47c951214055c (HEAD, refs/remotes/origin/master) Merge: 25daf56dad e8912d5be9 Author: Michael Albinus Date: Tue May 29 10:07:24 2018 +0200 ; Merge from origin/emacs-26 The following commit was skipped: e8912d5be9 Sync with Tramp 2.3.4-pre commit 25daf56dadb8d06ab6872566bb117727bea2ce50 Merge: 0f2a560a0e 9a7a2e919a Author: Michael Albinus Date: Tue May 29 10:07:23 2018 +0200 Merge from origin/emacs-26 9a7a2e919a ; ChangeLog.3: Remove stray phrase. commit 0f2a560a0ed716bddafb67f2840eb7f611195c23 Merge: 8a09ec0d45 038063651e Author: Michael Albinus Date: Tue May 29 10:07:23 2018 +0200 ; Merge from origin/emacs-26 The following commit was skipped: 038063651e Bump Emacs version to 26.1.50 commit 8a09ec0d45cdc8fa54203a0f7cc1a8c909627497 Merge: 0f48d18fd2 9d6a3ac73a Author: Michael Albinus Date: Tue May 29 10:07:21 2018 +0200 Merge from origin/emacs-26 9d6a3ac73a Mention pcase as a fifth conditional form 567cb9046d Overhaul pcase documentation 4d7e54acff Use EXPVAL in docstrings of patterns defined using pcase-d... 7e8227ed68 Introduce EXPVAL for pcase, pcase-defmacro docstrings e6de5b3d51 Ensure pcase doc shows `QPAT first among extensions commit e8912d5be9180e661273706782473919368a0b67 (refs/remotes/origin/emacs-26) Author: Michael Albinus Date: Tue May 29 09:57:48 2018 +0200 Sync with Tramp 2.3.4-pre * doc/misc/trampver.texi: Change version to "2.3.4-pre * lisp/net/tramp.el (tramp-mode, tramp-verbose) (tramp-backup-directory-alist, tramp-auto-save-directory) (tramp-encoding-shell, tramp-encoding-command-switch) (tramp-encoding-command-interactive, tramp-default-method) (tramp-default-method-alist, tramp-default-user) (tramp-default-user-alist, tramp-default-host) (tramp-default-host-alist, tramp-default-proxies-alist) (tramp-save-ad-hoc-proxies, tramp-restricted-shell-hosts-alist) (tramp-local-end-of-line, tramp-rsh-end-of-line) (tramp-login-prompt-regexp, tramp-shell-prompt-pattern) (tramp-password-prompt-regexp, tramp-wrong-passwd-regexp) (tramp-yesno-prompt-regexp, tramp-yn-prompt-regexp) (tramp-terminal-prompt-regexp) (tramp-operation-not-permitted-regexp, tramp-copy-failed-regexp) (tramp-process-alive-regexp, tramp-chunksize) (tramp-process-connection-type, tramp-connection-timeout) (tramp-connection-min-time-diff) (tramp-completion-reread-directory-timeout): * lisp/net/tramp-adb.el (tramp-adb-program) (tramp-adb-connect-if-not-connected, tramp-adb-prompt): * lisp/net/tramp-cache.el (tramp-connection-properties) (tramp-persistency-file-name): * lisp/net/tramp-gvfs.el (tramp-gvfs-methods) (tramp-gvfs-zeroconf-domain, tramp-bluez-discover-devices-timeout): * lisp/net/tramp-sh.el (tramp-inline-compress-start-size) (tramp-copy-size-limit, tramp-terminal-type) (tramp-histfile-override, tramp-use-ssh-controlmaster-options) (tramp-remote-path, tramp-remote-process-environment) (tramp-sh-extra-args): * lisp/net/tramp-smb.el (tramp-smb-program, tramp-smb-acl-program) (tramp-smb-conf, tramp-smb-winexe-program) (tramp-smb-winexe-shell-command) (tramp-smb-winexe-shell-command-switch): Dont't require 'tramp. (Bug#31558) * lisp/net/tramp.el (tramp-accept-process-output): * lisp/net/tramp-adb.el (tramp-adb-handle-start-file-process): * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band) (tramp-sh-handle-start-file-process): * lisp/net/tramp-smb.el (tramp-smb-handle-copy-directory) (tramp-smb-handle-file-acl, tramp-smb-handle-process-file) (tramp-smb-handle-set-file-acl) (tramp-smb-handle-start-file-process): Suppress timers. * lisp/net/tramp-adb.el (tramp-adb-handle-write-region): * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-write-region): * lisp/net/tramp-sh.el (tramp-sh-handle-write-region): * lisp/net/tramp-smb.el (tramp-smb-handle-write-region): Write proper message. * lisp/net/tramp-cmds.el (tramp-change-syntax): Use `customize-set-variable'. * lisp/net/tramp-sh.el (tramp-open-connection-setup-interactive-shell): Ensure proper EOL handling for Darwin. (tramp-find-inline-compress): Improve command quoting for w32. Reported by Chris Zheng . (tramp-open-connection-setup-interactive-shell): Wrap both echo calls in parentheses, in order to avoid double prompt. * lisp/net/tramp-smb.el (tramp-smb-errors): Add "NT_STATUS_RESOURCE_NAME_NOT_FOUND". * lisp/net/tramp.el (tramp-default-user-alist) (tramp-default-host-alist): Fix docstring. (tramp-dissect-file-name): Adapt docstring. (Bug#30904) (tramp-make-tramp-file-name): Check, that method is not empty. (Bug#30038) (tramp-message-show-message): Change default. * lisp/net/trampver.el: Change version to "2.3.4-pre". * test/lisp/net/tramp-tests.el (ert-x): Require it. (tramp-test10-write-region): Extend test. (tramp--test-emacs27-p, tramp--test-windows-nt): New defuns. (tramp-test11-copy-file, tramp-test12-rename-file) (tramp-test21-file-links, tramp-test24-file-acl) (tramp-test25-file-selinux, tramp--test-check-files): Use them. (tramp-test21-file-links): Do not call `make-symbolic-link' on w32. Fix file name quoting test. (tramp-test32-environment-variables-and-port-numbers): Adapt check for systems which do not support "echo -n". (Bug#29712) (tramp-test36-find-backup-file-name): Call also `convert-standard-filename' due to w32. (tramp-test41-asynchronous-requests): Use $REMOTE_PARALLEL_PROCESSES. Flush cache prior file operations. (tramp-test42-auto-load, tramp-test42-delay-load) (tramp-test42-recursive-load, tramp-test42-remote-load-path): Quote command due to w32. diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index f81593fad3..68619dcbe9 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -8,7 +8,7 @@ @c In the Tramp GIT, the version number is auto-frobbed from @c configure.ac, so you should edit that file and run @c "autoconf && ./configure" to change the version number. -@set trampver 2.3.3.26.1 +@set trampver 2.3.4-pre @c Other flags from configuration @set instprefix /usr/local diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 0395eb4380..58f748bd71 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -40,8 +40,7 @@ "Name of the Android Debug Bridge program." :group 'tramp :version "24.4" - :type 'string - :require 'tramp) + :type 'string) ;;;###tramp-autoload (defcustom tramp-adb-connect-if-not-connected nil @@ -49,8 +48,7 @@ It is used for TCP/IP devices." :group 'tramp :version "25.1" - :type 'boolean - :require 'tramp) + :type 'boolean) ;;;###tramp-autoload (defconst tramp-adb-method "adb" @@ -62,8 +60,7 @@ It is used for TCP/IP devices." "Regexp used as prompt in almquist shell." :type 'string :version "24.4" - :group 'tramp - :require 'tramp) + :group 'tramp) (defconst tramp-adb-ls-date-regexp "[[:space:]][0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9][[:space:]][0-9][0-9]:[0-9][0-9][[:space:]]" @@ -689,13 +686,22 @@ But handle the case, if the \"test\" command is not available." (tramp-error v 'file-error "Cannot write: `%s'" filename)) (delete-file tmpfile))) - (when (or (eq visit t) (stringp visit)) - (set-visited-file-modtime)) - (unless (equal curbuf (current-buffer)) (tramp-error v 'file-error - "Buffer has changed from `%s' to `%s'" curbuf (current-buffer)))))) + "Buffer has changed from `%s' to `%s'" curbuf (current-buffer))) + + ;; Set file modification time. + (when (or (eq visit t) (stringp visit)) + (set-visited-file-modtime + (tramp-compat-file-attribute-modification-time + (file-attributes filename)))) + + ;; The end. + (when (and (null noninteractive) + (or (eq visit t) (null visit) (stringp visit))) + (tramp-message v 0 "Wrote %s" filename)) + (run-hooks 'tramp-handle-write-region-hook)))) (defun tramp-adb-handle-set-file-modes (filename mode) "Like `set-file-modes' for Tramp files." @@ -1046,7 +1052,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (or (null program) tramp-process-connection-type)) (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer))) (name1 name) - (i 0)) + (i 0) + ;; We do not want to run timers. + timer-list timer-idle-list) (while (get-process name1) ;; NAME must be unique as process name. diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index b95d293592..1db93eadf6 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -73,16 +73,14 @@ details see the info pages." :version "24.4" :type '(repeat (list (choice :tag "File Name regexp" regexp (const nil)) (choice :tag " Property" string) - (choice :tag " Value" sexp))) - :require 'tramp) + (choice :tag " Value" sexp)))) ;;;###tramp-autoload (defcustom tramp-persistency-file-name (expand-file-name (locate-user-emacs-file "tramp")) "File which keeps connection history for Tramp connections." :group 'tramp - :type 'file - :require 'tramp) + :type 'file) (defvar tramp-cache-data-changed nil "Whether persistent cache data have been changed.") diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index ef9aca723d..7adac135ae 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -49,7 +49,7 @@ SYNTAX can be one of the symbols `default' (default), (unless (string-equal input "") (list (intern input))))) (when syntax - (custom-set-variables `(tramp-syntax ',syntax)))) + (customize-set-variable 'tramp-syntax syntax))) (defun tramp-list-tramp-buffers () "Return a list of all Tramp connection buffers." diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index f370abba31..39962de834 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -69,7 +69,7 @@ ;; 'car ;; (dbus-call-method ;; :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker -;; tramp-gvfs-interface-mounttracker "listMountableInfo"))) +;; tramp-gvfs-interface-mounttracker "ListMountableInfo"))) ;; Note that all other connection methods are not tested, beside the ;; ones offered for customization in `tramp-gvfs-methods'. If you @@ -122,8 +122,7 @@ (const "obex") (const "sftp") (const "smb") - (const "synce"))) - :require 'tramp) + (const "synce")))) ;; Add defaults for `tramp-default-user-alist' and `tramp-default-host-alist'. ;;;###tramp-autoload @@ -141,8 +140,7 @@ "Zeroconf domain to be used for discovering services, like host names." :group 'tramp :version "23.2" - :type 'string - :require 'tramp) + :type 'string) ;; Add the methods to `tramp-methods', in order to allow minibuffer ;; completion. @@ -393,8 +391,7 @@ completion, nil means to use always cached values for discovered devices." :group 'tramp :version "23.2" - :type '(choice (const nil) integer) - :require 'tramp) + :type '(choice (const nil) integer)) (defvar tramp-bluez-discovery nil "Indicator for a running bluetooth device discovery. @@ -1270,7 +1267,8 @@ file-notify events." (file-attributes filename)))) ;; The end. - (when (or (eq visit t) (null visit) (stringp visit)) + (when (and (null noninteractive) + (or (eq visit t) (null visit) (stringp visit))) (tramp-message v 0 "Wrote %s" filename)) (run-hooks 'tramp-handle-write-region-hook))) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 9b74da6580..02fb8648d8 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -47,8 +47,7 @@ When inline transfer, compress transferred data of file whose size is this value or above (up to `tramp-copy-size-limit'). If it is nil, no compression at all will be applied." :group 'tramp - :type '(choice (const nil) integer) - :require 'tramp) + :type '(choice (const nil) integer)) ;;;###tramp-autoload (defcustom tramp-copy-size-limit 10240 @@ -56,8 +55,7 @@ If it is nil, no compression at all will be applied." out-of-the-band copy. If it is nil, out-of-the-band copy will be used without a check." :group 'tramp - :type '(choice (const nil) integer) - :require 'tramp) + :type '(choice (const nil) integer)) ;;;###tramp-autoload (defcustom tramp-terminal-type "dumb" @@ -66,8 +64,7 @@ Because Tramp wants to parse the output of the remote shell, it is easily confused by ANSI color escape sequences and suchlike. Often, shell init files conditionalize this setup based on the TERM environment variable." :group 'tramp - :type 'string - :require 'tramp) + :type 'string) ;;;###tramp-autoload (defcustom tramp-histfile-override "~/.tramp_history" @@ -84,8 +81,7 @@ the default storage location, e.g. \"$HOME/.sh_history\"." :version "25.2" :type '(choice (const :tag "Do not override HISTFILE" nil) (const :tag "Unset HISTFILE" t) - (string :tag "Redirect to a file")) - :require 'tramp) + (string :tag "Redirect to a file"))) ;;;###tramp-autoload (defconst tramp-display-escape-sequence-regexp "\e[[;0-9]+m" @@ -119,8 +115,7 @@ detected as prompt when being sent on echoing hosts, therefore.") "Whether to use `tramp-ssh-controlmaster-options'." :group 'tramp :version "24.4" - :type 'boolean - :require 'tramp) + :type 'boolean) (defvar tramp-ssh-controlmaster-options nil "Which ssh Control* arguments to use. @@ -528,8 +523,7 @@ the list by the special value `tramp-own-remote-path'." :type '(repeat (choice (const :tag "Default Directories" tramp-default-remote-path) (const :tag "Private Directories" tramp-own-remote-path) - (string :tag "Directory"))) - :require 'tramp) + (string :tag "Directory")))) ;;;###tramp-autoload (defcustom tramp-remote-process-environment @@ -553,8 +547,7 @@ The INSIDE_EMACS environment variable will automatically be set based on the TRAMP and Emacs versions, and should not be set here." :group 'tramp :version "26.1" - :type '(repeat string) - :require 'tramp) + :type '(repeat string)) ;;;###tramp-autoload (defcustom tramp-sh-extra-args '(("/bash\\'" . "-norc -noprofile")) @@ -567,8 +560,7 @@ This variable is only used when Tramp needs to start up another shell for tilde expansion. The extra arguments should typically prevent the shell from reading its init file." :group 'tramp - :type '(alist :key-type regexp :value-type string) - :require 'tramp) + :type '(alist :key-type regexp :value-type string)) (defconst tramp-actions-before-shell '((tramp-login-prompt-regexp tramp-action-login) @@ -2481,7 +2473,9 @@ The method used must be an out-of-band method." ;; The default directory must be remote. (let ((default-directory (file-name-directory (if t1 filename newname))) - (process-environment (copy-sequence process-environment))) + (process-environment (copy-sequence process-environment)) + ;; We do not want to run timers. + timer-list timer-idle-list) ;; Set the transfer process properties. (tramp-set-connection-property v "process-name" (buffer-name (current-buffer))) @@ -2908,7 +2902,9 @@ the result will be a local, non-Tramp, file name." ;; We do not want to raise an error when ;; `start-file-process' has been started several times in ;; `eshell' and friends. - (tramp-current-connection nil) + tramp-current-connection + ;; We do not want to run timers. + timer-list timer-idle-list p) (while (get-process name1) @@ -3420,7 +3416,8 @@ the result will be a local, non-Tramp, file name." ;; Set the ownership. (when need-chown (tramp-set-file-uid-gid filename uid gid)) - (when (or (eq visit t) (null visit) (stringp visit)) + (when (and (null noninteractive) + (or (eq visit t) (null visit) (stringp visit))) (tramp-message v 0 "Wrote %s" filename)) (run-hooks 'tramp-handle-write-region-hook))))) @@ -4103,7 +4100,10 @@ process to set up. VEC specifies the connection." (with-current-buffer (process-buffer proc) ;; Use MULE to select the right EOL convention for communicating ;; with the process. - (let ((cs (or (and (memq 'utf-8 (coding-system-list)) + (let ((cs (or (and (memq 'utf-8-hfs (coding-system-list)) + (string-match "^Darwin" uname) + (cons 'utf-8-hfs 'utf-8-hfs)) + (and (memq 'utf-8 (coding-system-list)) (string-match "utf-?8" (tramp-get-remote-locale vec)) (cons 'utf-8 'utf-8)) (process-coding-system proc) @@ -4115,16 +4115,11 @@ process to set up. VEC specifies the connection." cs-encode (coding-system-change-eol-conversion cs-encode (if (string-match "^Darwin" uname) 'mac 'unix))) - (tramp-send-command vec "echo foo ; echo bar" t) + (tramp-send-command vec "(echo foo ; echo bar)" t) (goto-char (point-min)) (when (search-forward "\r" nil t) (setq cs-decode (coding-system-change-eol-conversion cs-decode 'dos))) - ;; Special setting for macOS. - (when (and (string-match "^Darwin" uname) - (memq 'utf-8-hfs (coding-system-list))) - (setq cs-decode 'utf-8-hfs - cs-encode 'utf-8-hfs)) - (set-buffer-process-coding-system cs-decode cs-encode) + (set-process-coding-system proc cs-decode cs-encode) (tramp-message vec 5 "Setting coding system to `%s' and `%s'" cs-decode cs-encode))) @@ -4470,13 +4465,14 @@ Goes through the list `tramp-inline-compress-commands'." (zerop (tramp-call-local-coding-command (format + "echo %s | %s | %s" magic ;; Windows shells need the program file name after ;; the pipe symbol be quoted if they use forward ;; slashes as directory separators. - (if (memq system-type '(windows-nt)) - "echo %s | \"%s\" | \"%s\"" - "echo %s | %s | %s") - magic compress decompress) + (mapconcat + 'shell-quote-argument (split-string compress) " ") + (mapconcat + 'shell-quote-argument (split-string decompress) " ")) nil nil)) (throw 'next nil)) (tramp-message diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 59db6ee607..7e96142a5f 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -66,16 +66,14 @@ (defcustom tramp-smb-program "smbclient" "Name of SMB client to run." :group 'tramp - :type 'string - :require 'tramp) + :type 'string) ;;;###tramp-autoload (defcustom tramp-smb-acl-program "smbcacls" "Name of SMB acls to run." :group 'tramp :type 'string - :version "24.4" - :require 'tramp) + :version "24.4") ;;;###tramp-autoload (defcustom tramp-smb-conf "/dev/null" @@ -83,8 +81,7 @@ If it is nil, no smb.conf will be added to the `tramp-smb-program' call, letting the SMB client use the default one." :group 'tramp - :type '(choice (const nil) (file :must-match t)) - :require 'tramp) + :type '(choice (const nil) (file :must-match t))) (defvar tramp-smb-version nil "Version string of the SMB client.") @@ -151,6 +148,7 @@ call, letting the SMB client use the default one." "NT_STATUS_OBJECT_NAME_NOT_FOUND" "NT_STATUS_OBJECT_PATH_SYNTAX_BAD" "NT_STATUS_PASSWORD_MUST_CHANGE" + "NT_STATUS_RESOURCE_NAME_NOT_FOUND" "NT_STATUS_SHARING_VIOLATION" "NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE" "NT_STATUS_UNSUCCESSFUL" @@ -295,8 +293,7 @@ If it isn't found in the local $PATH, the absolute path of winexe shall be given. This is needed for remote processes." :group 'tramp :type 'string - :version "24.3" - :require 'tramp) + :version "24.3") ;;;###tramp-autoload (defcustom tramp-smb-winexe-shell-command "powershell.exe" @@ -304,8 +301,7 @@ shall be given. This is needed for remote processes." This must be Powershell V2 compatible." :group 'tramp :type 'string - :version "24.3" - :require 'tramp) + :version "24.3") ;;;###tramp-autoload (defcustom tramp-smb-winexe-shell-command-switch "-file -" @@ -313,8 +309,7 @@ This must be Powershell V2 compatible." This can be used to disable echo etc." :group 'tramp :type 'string - :version "24.3" - :require 'tramp) + :version "24.3") ;; It must be a `defsubst' in order to push the whole code into ;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading. @@ -464,7 +459,9 @@ pass to the OPERATION." (expand-file-name tramp-temp-name-prefix (tramp-compat-temporary-file-directory)))) - (args (list (concat "//" host "/" share) "-E"))) + (args (list (concat "//" host "/" share) "-E")) + ;; We do not want to run timers. + timer-list timer-idle-list) (if (not (zerop (length user))) (setq args (append args (list "-U" user))) @@ -752,7 +749,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (let* ((share (tramp-smb-get-share v)) (localname (replace-regexp-in-string "\\\\" "/" (tramp-smb-get-localname v))) - (args (list (concat "//" host "/" share) "-E"))) + (args (list (concat "//" host "/" share) "-E")) + ;; We do not want to run timers. + timer-list timer-idle-list) (if (not (zerop (length user))) (setq args (append args (list "-U" user))) @@ -1235,6 +1234,8 @@ component is used as the target of the symlink." (let* ((name (file-name-nondirectory program)) (name1 name) (i 0) + ;; We do not want to run timers. + timer-list timer-idle-list input tmpinput outbuf command ret) ;; Determine input. @@ -1417,7 +1418,9 @@ component is used as the target of the symlink." "\\\\" "/" (tramp-smb-get-localname v))) (args (list (concat "//" host "/" share) "-E" "-S" (replace-regexp-in-string - "\n" "," acl-string)))) + "\n" "," acl-string))) + ;; We do not want to run timers. + timer-list timer-idle-list) (if (not (zerop (length user))) (setq args (append args (list "-U" user))) @@ -1497,7 +1500,9 @@ component is used as the target of the symlink." (command (mapconcat 'identity (cons program args) " ")) (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer))) (name1 name) - (i 0)) + (i 0) + ;; We do not want to run timers. + timer-list timer-idle-list) (unwind-protect (save-excursion (save-restriction @@ -1589,9 +1594,18 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." (tramp-error v 'file-error "Buffer has changed from `%s' to `%s'" curbuf (current-buffer))) - (when (eq visit t) - (set-visited-file-modtime))))) + ;; Set file modification time. + (when (or (eq visit t) (stringp visit)) + (set-visited-file-modtime + (tramp-compat-file-attribute-modification-time + (file-attributes filename)))) + + ;; The end. + (when (and (null noninteractive) + (or (eq visit t) (null visit) (stringp visit))) + (tramp-message v 0 "Wrote %s" filename)) + (run-hooks 'tramp-handle-write-region-hook)))) ;; Internal file name functions. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index c4839e7f69..59f4ceaa54 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -79,8 +79,7 @@ "Whether Tramp is enabled. If it is set to nil, all remote file names are used literally." :group 'tramp - :type 'boolean - :require 'tramp) + :type 'boolean) (defcustom tramp-verbose 3 "Verbosity level for Tramp messages. @@ -98,8 +97,7 @@ Any level x includes messages for all levels 1 .. x-1. The levels are 9 test commands 10 traces (huge)." :group 'tramp - :type 'integer - :require 'tramp) + :type 'integer) (defcustom tramp-backup-directory-alist nil "Alist of filename patterns and backup directory names. @@ -114,8 +112,7 @@ gives the same backup policy for Tramp files on their hosts like the policy for local files." :group 'tramp :type '(repeat (cons (regexp :tag "Regexp matching filename") - (directory :tag "Backup directory name"))) - :require 'tramp) + (directory :tag "Backup directory name")))) (defcustom tramp-auto-save-directory nil "Put auto-save files in this directory, if set. @@ -123,8 +120,7 @@ The idea is to use a local directory so that auto-saving is faster. This setting has precedence over `auto-save-file-name-transforms'." :group 'tramp :type '(choice (const :tag "Use default" nil) - (directory :tag "Auto save directory name")) - :require 'tramp) + (directory :tag "Auto save directory name"))) (defcustom tramp-encoding-shell (or (tramp-compat-funcall 'w32-shell-name) "/bin/sh") @@ -148,16 +144,14 @@ Note that this variable is not used for remote commands. There are mechanisms in tramp.el which automatically determine the right shell to use for the remote host." :group 'tramp - :type '(file :must-match t) - :require 'tramp) + :type '(file :must-match t)) (defcustom tramp-encoding-command-switch (if (tramp-compat-funcall 'w32-shell-dos-semantics) "/c" "-c") "Use this switch together with `tramp-encoding-shell' for local commands. See the variable `tramp-encoding-shell' for more information." :group 'tramp - :type 'string - :require 'tramp) + :type 'string) (defcustom tramp-encoding-command-interactive (unless (tramp-compat-funcall 'w32-shell-dos-semantics) "-i") @@ -165,8 +159,7 @@ See the variable `tramp-encoding-shell' for more information." See the variable `tramp-encoding-shell' for more information." :version "24.1" :group 'tramp - :type '(choice (const nil) string) - :require 'tramp) + :type '(choice (const nil) string)) ;;;###tramp-autoload (defvar tramp-methods nil @@ -309,8 +302,7 @@ useful only in combination with `tramp-default-proxies-alist'.") See `tramp-methods' for possibilities. Also see `tramp-default-method-alist'." :group 'tramp - :type 'string - :require 'tramp) + :type 'string) ;;;###tramp-autoload (defcustom tramp-default-method-alist nil @@ -328,8 +320,7 @@ See `tramp-methods' for a list of possibilities for METHOD." :group 'tramp :type '(repeat (list (choice :tag "Host regexp" regexp sexp) (choice :tag "User regexp" regexp sexp) - (choice :tag "Method name" string (const nil)))) - :require 'tramp) + (choice :tag "Method name" string (const nil))))) (defconst tramp-default-method-marker "-" "Marker for default method in remote file names.") @@ -341,15 +332,14 @@ It is nil by default; otherwise settings in configuration files like This variable is regarded as obsolete, and will be removed soon." :group 'tramp - :type '(choice (const nil) string) - :require 'tramp) + :type '(choice (const nil) string)) ;;;###tramp-autoload (defcustom tramp-default-user-alist nil "Default user to use for specific method/host pairs. This is an alist of items (METHOD HOST USER). The first matching item specifies the user to use for a file name which does not specify a -user. METHOD and USER are regular expressions or nil, which is +user. METHOD and HOST are regular expressions or nil, which is interpreted as a regular expression which always matches. If no entry matches, the variable `tramp-default-user' takes effect. @@ -358,22 +348,20 @@ empty string for the method name." :group 'tramp :type '(repeat (list (choice :tag "Method regexp" regexp sexp) (choice :tag " Host regexp" regexp sexp) - (choice :tag " User name" string (const nil)))) - :require 'tramp) + (choice :tag " User name" string (const nil))))) (defcustom tramp-default-host (system-name) "Default host to use for transferring files. Useful for su and sudo methods mostly." :group 'tramp - :type 'string - :require 'tramp) + :type 'string) ;;;###tramp-autoload (defcustom tramp-default-host-alist nil "Default host to use for specific method/user pairs. This is an alist of items (METHOD USER HOST). The first matching item specifies the host to use for a file name which does not specify a -host. METHOD and HOST are regular expressions or nil, which is +host. METHOD and USER are regular expressions or nil, which is interpreted as a regular expression which always matches. If no entry matches, the variable `tramp-default-host' takes effect. @@ -383,8 +371,7 @@ empty string for the method name." :version "24.4" :type '(repeat (list (choice :tag "Method regexp" regexp sexp) (choice :tag " User regexp" regexp sexp) - (choice :tag " Host name" string (const nil)))) - :require 'tramp) + (choice :tag " Host name" string (const nil))))) (defcustom tramp-default-proxies-alist nil "Route to be followed for specific host/user pairs. @@ -403,15 +390,13 @@ interpreted as a regular expression which always matches." :group 'tramp :type '(repeat (list (choice :tag "Host regexp" regexp sexp) (choice :tag "User regexp" regexp sexp) - (choice :tag " Proxy name" string (const nil)))) - :require 'tramp) + (choice :tag " Proxy name" string (const nil))))) (defcustom tramp-save-ad-hoc-proxies nil "Whether to save ad-hoc proxies persistently." :group 'tramp :version "24.3" - :type 'boolean - :require 'tramp) + :type 'boolean) (defcustom tramp-restricted-shell-hosts-alist (when (memq system-type '(windows-nt)) @@ -423,8 +408,7 @@ proxies only, see `tramp-default-proxies-alist'. If the local host runs a registered shell, it shall be added to this list, too." :version "24.3" :group 'tramp - :type '(repeat (regexp :tag "Host regexp")) - :require 'tramp) + :type '(repeat (regexp :tag "Host regexp"))) ;;;###tramp-autoload (defconst tramp-local-host-regexp @@ -485,16 +469,14 @@ the remote shell.") "String used for end of line in local processes." :version "24.1" :group 'tramp - :type 'string - :require 'tramp) + :type 'string) (defcustom tramp-rsh-end-of-line "\n" "String used for end of line in rsh connections. I don't think this ever needs to be changed, so please tell me about it if you need to change this." :group 'tramp - :type 'string - :require 'tramp) + :type 'string) (defcustom tramp-login-prompt-regexp ".*\\(user\\|login\\)\\( .*\\)?: *" @@ -503,8 +485,7 @@ The regexp should match at end of buffer. Sometimes the prompt is reported to look like \"login as:\"." :group 'tramp - :type 'regexp - :require 'tramp) + :type 'regexp) (defcustom tramp-shell-prompt-pattern ;; Allow a prompt to start right after a ^M since it indeed would be @@ -526,8 +507,7 @@ which should work well in many cases. This regexp must match both `tramp-initial-end-of-output' and `tramp-end-of-output'." :group 'tramp - :type 'regexp - :require 'tramp) + :type 'regexp) (defcustom tramp-password-prompt-regexp (format "^.*\\(%s\\).*:\^@? *" @@ -540,8 +520,7 @@ The regexp should match at end of buffer. The `sudo' program appears to insert a `^@' character into the prompt." :version "24.4" :group 'tramp - :type 'regexp - :require 'tramp) + :type 'regexp) (defcustom tramp-wrong-passwd-regexp (concat "^.*" @@ -566,8 +545,7 @@ The `sudo' program appears to insert a `^@' character into the prompt." "Regexp matching a `login failed' message. The regexp should match at end of buffer." :group 'tramp - :type 'regexp - :require 'tramp) + :type 'regexp) (defcustom tramp-yesno-prompt-regexp (concat @@ -578,8 +556,7 @@ The confirmation should be done with yes or no. The regexp should match at end of buffer. See also `tramp-yn-prompt-regexp'." :group 'tramp - :type 'regexp - :require 'tramp) + :type 'regexp) (defcustom tramp-yn-prompt-regexp (concat @@ -592,8 +569,7 @@ The confirmation should be done with y or n. The regexp should match at end of buffer. See also `tramp-yesno-prompt-regexp'." :group 'tramp - :type 'regexp - :require 'tramp) + :type 'regexp) (defcustom tramp-terminal-prompt-regexp (concat "\\(" @@ -605,8 +581,7 @@ See also `tramp-yesno-prompt-regexp'." The regexp should match at end of buffer. The answer will be provided by `tramp-action-terminal', which see." :group 'tramp - :type 'regexp - :require 'tramp) + :type 'regexp) (defcustom tramp-operation-not-permitted-regexp (concat "\\(" "preserving times.*" "\\|" "set mode" "\\)" ":\\s-*" @@ -615,8 +590,7 @@ The answer will be provided by `tramp-action-terminal', which see." Copying has been performed successfully already, so this message can be ignored safely." :group 'tramp - :type 'regexp - :require 'tramp) + :type 'regexp) (defcustom tramp-copy-failed-regexp (concat "\\(.+: " @@ -628,8 +602,7 @@ be ignored safely." "\\)\\s-*") "Regular expression matching copy problems in (s)cp operations." :group 'tramp - :type 'regexp - :require 'tramp) + :type 'regexp) (defcustom tramp-process-alive-regexp "" @@ -639,8 +612,7 @@ check regularly the status of the associated process. The answer will be provided by `tramp-action-process-alive', `tramp-action-out-of-band', which see." :group 'tramp - :type 'regexp - :require 'tramp) + :type 'regexp) (defconst tramp-temp-name-prefix "tramp." "Prefix to use for temporary files. @@ -1127,8 +1099,7 @@ in the third line of the code. Please raise a bug report via \"M-x tramp-bug\" if your system needs this variable to be set as well." :group 'tramp - :type '(choice (const nil) integer) - :require 'tramp) + :type '(choice (const nil) integer)) ;; Logging in to a remote host normally requires obtaining a pty. But ;; Emacs on macOS has process-connection-type set to nil by default, @@ -1139,8 +1110,7 @@ this variable to be set as well." Tramp binds `process-connection-type' to the value given here before opening a connection to a remote host." :group 'tramp - :type '(choice (const nil) (const t) (const pty)) - :require 'tramp) + :type '(choice (const nil) (const t) (const pty))) (defcustom tramp-connection-timeout 60 "Defines the max time to wait for establishing a connection (in seconds). @@ -1149,8 +1119,7 @@ This can be overwritten for different connection types in `tramp-methods'. The timeout does not include the time reading a password." :group 'tramp :version "24.4" - :type 'integer - :require 'tramp) + :type 'integer) (defcustom tramp-connection-min-time-diff 5 "Defines seconds between two consecutive connection attempts. @@ -1164,8 +1133,7 @@ in a short time frame. In those cases it is recommended to let-bind this variable." :group 'tramp :version "24.4" - :type '(choice (const nil) integer) - :require 'tramp) + :type '(choice (const nil) integer)) (defcustom tramp-completion-reread-directory-timeout 10 "Defines seconds since last remote command before rereading a directory. @@ -1177,8 +1145,7 @@ have been gone since last remote command execution. A value of t would require an immediate reread during filename completion, nil means to use always cached values for the directory contents." :group 'tramp - :type '(choice (const nil) (const t) integer) - :require 'tramp) + :type '(choice (const nil) (const t) integer)) ;;; Internal Variables: @@ -1353,11 +1320,13 @@ This is HOST, if non-nil. Otherwise, it is `tramp-default-host'." tramp-default-host)) (defun tramp-dissect-file-name (name &optional nodefault) - "Return a `tramp-file-name' structure. -The structure consists of remote method, remote user, remote host, -localname (file name on remote host) and hop. If NODEFAULT is -non-nil, the file name parts are not expanded to their default -values." + "Return a `tramp-file-name' structure of NAME, a remote file name. +The structure consists of method, user, domain, host, port, +localname (file name on remote host), and hop. + +Unless NODEFAULT is non-nil, method, user and host are expanded +to their default values. For the other file name parts, no +default values are used." (save-match-data (unless (tramp-tramp-file-p name) (tramp-compat-user-error nil "Not a Tramp file name: \"%s\"" name)) @@ -1405,9 +1374,10 @@ values." (method user domain host port localname &optional hop) "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME. When not nil, optional DOMAIN, PORT and HOP are used." + (when (zerop (length method)) + (signal 'wrong-type-argument (list 'stringp method))) (concat tramp-prefix-format hop - (unless (or (zerop (length method)) - (zerop (length tramp-postfix-method-format))) + (unless (zerop (length tramp-postfix-method-format)) (concat method tramp-postfix-method-format)) user (unless (zerop (length domain)) @@ -1614,10 +1584,11 @@ ARGUMENTS to actually emit the message (if applicable)." ;; The message. (insert (apply #'format-message fmt-string arguments)))) -(defvar tramp-message-show-message t +(defvar tramp-message-show-message (null noninteractive) "Show Tramp message in the minibuffer. -This variable is used to disable messages from `tramp-error'. -The messages are visible anyway, because an error is raised.") +This variable is used to suppress progress reporter output, and +to disable messages from `tramp-error'. Those messages are +visible anyway, because an error is raised.") (defsubst tramp-message (vec-or-proc level fmt-string &rest arguments) "Emit a message depending on verbosity level. @@ -3823,7 +3794,9 @@ connection buffer." This is needed in order to hide `last-coding-system-used', which is set for process communication also." (with-current-buffer (process-buffer proc) - (let (buffer-read-only last-coding-system-used) + (let (buffer-read-only last-coding-system-used + ;; We do not want to run timers. + timer-list timer-idle-list) ;; Under Windows XP, `accept-process-output' doesn't return ;; sometimes. So we add an additional timeout. JUST-THIS-ONE ;; is set due to Bug#12145. It is an integer, in order to avoid diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 1a7727820e..25498418dd 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -7,7 +7,7 @@ ;; Maintainer: Michael Albinus ;; Keywords: comm, processes ;; Package: tramp -;; Version: 2.3.3.26.1 +;; Version: 2.3.4-pre ;; This file is part of GNU Emacs. @@ -33,7 +33,7 @@ ;; should be changed only there. ;;;###tramp-autoload -(defconst tramp-version "2.3.3.26.1" +(defconst tramp-version "2.3.4-pre" "This version of Tramp.") ;;;###tramp-autoload @@ -55,7 +55,7 @@ ;; Check for Emacs version. (let ((x (if (>= emacs-major-version 24) "ok" - (format "Tramp 2.3.3.26.1 is not fit for %s" + (format "Tramp 2.3.4-pre is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version))))))) (unless (string-match "\\`ok\\'" x) (error "%s" x))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 996a31d375..d2cbebd63c 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -33,12 +33,17 @@ ;; remote host, set this environment variable to "/dev/null" or ;; whatever is appropriate on your system. +;; For slow remote connections, `tramp-test41-asynchronous-requests' +;; might be too heavy. Setting $REMOTE_PARALLEL_PROCESSES to a proper +;; value less than 10 could help. + ;; A whole test run can be performed calling the command `tramp-test-all'. ;;; Code: (require 'dired) (require 'ert) +(require 'ert-x) (require 'tramp) (require 'vc) (require 'vc-bzr) @@ -1862,6 +1867,23 @@ This checks also `file-name-as-directory', `file-name-directory', (insert-file-contents tmp-name) (should (string-equal (buffer-string) "34"))) + ;; Check message. + ;; Macro `ert-with-message-capture' was introduced in Emacs 26.1. + (with-no-warnings (when (symbol-plist 'ert-with-message-capture) + (let ((tramp-message-show-message t)) + (dolist (noninteractive '(nil t)) + (dolist (visit '(nil t "string" no-message)) + (ert-with-message-capture tramp--test-messages + (write-region "foo" nil tmp-name nil visit) + ;; We must check the last line. There could be + ;; other messages from the progress reporter. + (should + (string-match + (if (and (null noninteractive) + (or (eq visit t) (null visit) (stringp visit))) + (format "^Wrote %s\n\\'" tmp-name) "^\\'") + tramp--test-messages)))))))) + ;; Do not overwrite if excluded. (cl-letf (((symbol-function 'y-or-n-p) (lambda (_prompt) t))) (write-region "foo" nil tmp-name nil nil nil 'mustbenew)) @@ -1882,9 +1904,9 @@ This checks also `file-name-as-directory', `file-name-directory', "Check `copy-file'." (skip-unless (tramp--test-enabled)) - ;; TODO: The quoted case does not work. Copy local file to remote. - ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) - (let (quoted) + ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579. + (dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs27-p)) + '(nil t) '(nil))) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (tramp--test-make-temp-name nil quoted)) (tmp-name3 (tramp--test-make-temp-name 'local quoted))) @@ -1984,9 +2006,9 @@ This checks also `file-name-as-directory', `file-name-directory', "Check `rename-file'." (skip-unless (tramp--test-enabled)) - ;; TODO: The quoted case does not work. - ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) - (let (quoted) + ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579. + (dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs27-p)) + '(nil t) '(nil))) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (tramp--test-make-temp-name nil quoted)) (tmp-name3 (tramp--test-make-temp-name 'local quoted))) @@ -2718,9 +2740,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (file-symlink-p tmp-name2))) ;; `tmp-name3' is a local file name. Therefore, the link ;; target remains unchanged, even if quoted. - (make-symbolic-link tmp-name1 tmp-name3) - (should - (string-equal tmp-name1 (file-symlink-p tmp-name3))) + ;; `make-symbolic-link' might not be permitted on w32 systems. + (unless (tramp--test-windows-nt) + (make-symbolic-link tmp-name1 tmp-name3) + (should + (string-equal tmp-name1 (file-symlink-p tmp-name3)))) ;; Check directory as newname. (make-directory tmp-name4) (should-error @@ -2810,7 +2834,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Symbolic links could look like a remote file name. ;; They must be quoted then. (delete-file tmp-name2) - (make-symbolic-link "/penguin:motd:" tmp-name2) + (make-symbolic-link + (funcall + (if quoted 'tramp-compat-file-name-unquote 'identity) + "/penguin:motd:") + tmp-name2) (should (file-symlink-p tmp-name2)) (should (string-equal @@ -2818,15 +2846,20 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (tramp-compat-file-name-quote (concat (file-remote-p tmp-name2) "/penguin:motd:")))) ;; `tmp-name3' is a local file name. - (make-symbolic-link tmp-name1 tmp-name3) - (should (file-symlink-p tmp-name3)) - (should-not (string-equal tmp-name3 (file-truename tmp-name3))) - ;; `file-truename' returns a quoted file name for `tmp-name3'. - ;; We must unquote it. - (should - (string-equal - (file-truename tmp-name1) - (tramp-compat-file-name-unquote (file-truename tmp-name3))))) + ;; `make-symbolic-link' might not be permitted on w32 systems. + (unless (tramp--test-windows-nt) + (make-symbolic-link tmp-name1 tmp-name3) + (should (file-symlink-p tmp-name3)) + (should-not (string-equal tmp-name3 (file-truename tmp-name3))) + ;; `file-truename' returns a quoted file name for `tmp-name3'. + ;; We must unquote it. + (should + (string-equal + (funcall + (if (tramp--test-emacs27-p) + 'tramp-compat-file-name-unquote 'identity) + (file-truename tmp-name1)) + (tramp-compat-file-name-unquote (file-truename tmp-name3)))))) ;; Cleanup. (ignore-errors @@ -2951,9 +2984,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (skip-unless (tramp--test-enabled)) (skip-unless (file-acl tramp-test-temporary-file-directory)) - ;; TODO: The quoted case does not work. Copy local file to remote. - ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) - (let (quoted) + ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579. + (dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs27-p)) + '(nil t) '(nil))) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (tramp--test-make-temp-name nil quoted)) (tmp-name3 (tramp--test-make-temp-name 'local quoted))) @@ -3029,9 +3062,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (not (equal (file-selinux-context tramp-test-temporary-file-directory) '(nil nil nil nil)))) - ;; TODO: The quoted case does not work. Copy local file to remote. - ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) - (let (quoted) + ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579. + (dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs27-p)) + '(nil t) '(nil))) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (tramp--test-make-temp-name nil quoted)) (tmp-name3 (tramp--test-make-temp-name 'local quoted))) @@ -3911,9 +3944,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (expand-file-name (format "%s~" - ;; This is taken from `make-backup-file-name-1'. + ;; This is taken from `make-backup-file-name-1'. We + ;; call `convert-standard-filename', because on MS + ;; Windows the (local) colons must be replaced by + ;; exclamation marks. (subst-char-in-string - ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1))) + ?/ ?! + (replace-regexp-in-string + "!" "!!" (convert-standard-filename tmp-name1)))) tmp-name2))))) ;; The backup directory is created. (should (file-directory-p tmp-name2))) @@ -3934,9 +3972,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (expand-file-name (format "%s~" - ;; This is taken from `make-backup-file-name-1'. + ;; This is taken from `make-backup-file-name-1'. We + ;; call `convert-standard-filename', because on MS + ;; Windows the (local) colons must be replaced by + ;; exclamation marks. (subst-char-in-string - ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1))) + ?/ ?! + (replace-regexp-in-string + "!" "!!" (convert-standard-filename tmp-name1)))) tmp-name2))))) ;; The backup directory is created. (should (file-directory-p tmp-name2))) @@ -3958,9 +4001,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (expand-file-name (format "%s~" - ;; This is taken from `make-backup-file-name-1'. + ;; This is taken from `make-backup-file-name-1'. We + ;; call `convert-standard-filename', because on MS + ;; Windows the (local) colons must be replaced by + ;; exclamation marks. (subst-char-in-string - ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1))) + ?/ ?! + (replace-regexp-in-string + "!" "!!" (convert-standard-filename tmp-name1)))) tmp-name2))))) ;; The backup directory is created. (should (file-directory-p tmp-name2))) @@ -4011,6 +4059,12 @@ Some semantics has been changed for there, w/o new functions or variables, so we check the Emacs version directly." (>= emacs-major-version 26)) +(defun tramp--test-emacs27-p () + "Check for Emacs version >= 27.1. +Some semantics has been changed for there, w/o new functions or +variables, so we check the Emacs version directly." + (>= emacs-major-version 27)) + (defun tramp--test-adb-p () "Check, whether the remote host runs Android. This requires restrictions of file name syntax." @@ -4061,6 +4115,10 @@ This does not support special file names." (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) 'tramp-sh-file-name-handler)) +(defun tramp--test-windows-nt () + "Check, whether the locale host runs MS Windows." + (eq system-type 'windows-nt)) + (defun tramp--test-windows-nt-and-batch () "Check, whether the locale host runs MS Windows in batch mode. This does not support special characters." @@ -4082,9 +4140,9 @@ This requires restrictions of file name syntax." (defun tramp--test-check-files (&rest files) "Run a simple but comprehensive test over every file in FILES." - ;; TODO: The quoted case does not work. - ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) - (let (quoted) + ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579. + (dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs27-p)) + '(nil t) '(nil))) ;; We must use `file-truename' for the temporary directory, ;; because it could be located on a symlinked directory. This ;; would let the test fail. @@ -4493,8 +4551,13 @@ process sentinels. They shall not disturb each other." (inhibit-message t) ;; Do not run delayed timers. (timer-max-repeats 0) - ;; Number of asynchronous processes for test. - (number-proc 10) + ;; Number of asynchronous processes for test. Tests on + ;; some machines handle less parallel processes. + (number-proc + (or + (ignore-errors + (string-to-number (getenv "REMOTE_PARALLEL_PROCESSES"))) + 10)) ;; On hydra, timings are bad. (timer-repeat (cond @@ -4558,11 +4621,13 @@ process sentinels. They shall not disturb each other." (with-current-buffer (process-buffer proc) (insert string)) (unless (zerop (length string)) + (dired-uncache (process-get proc 'foo)) (should (file-attributes (process-get proc 'foo)))))) ;; Add process sentinel. (set-process-sentinel proc (lambda (proc _state) + (dired-uncache (process-get proc 'foo)) (should-not (file-attributes (process-get proc 'foo))))))) ;; Send a string. Use a random order of the buffers. Mix @@ -4576,6 +4641,7 @@ process sentinels. They shall not disturb each other." (file (process-get proc 'foo)) (count (process-get proc 'bar))) ;; Regular operation prior process action. + (dired-uncache file) (if (= count 0) (should-not (file-attributes file)) (should (file-attributes file))) @@ -4585,6 +4651,7 @@ process sentinels. They shall not disturb each other." ;; Give the watchdog a chance. (read-event nil nil 0.01) ;; Regular operation post process action. + (dired-uncache file) (if (= count 2) (should-not (file-attributes file)) (should (file-attributes file))) @@ -4625,7 +4692,8 @@ process sentinels. They shall not disturb each other." (shell-command-to-string (format "%s -batch -Q -L %s --eval %s" - (expand-file-name invocation-name invocation-directory) + (shell-quote-argument + (expand-file-name invocation-name invocation-directory)) (mapconcat 'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) @@ -4657,7 +4725,8 @@ process sentinels. They shall not disturb each other." (shell-command-to-string (format "%s -batch -Q -L %s --eval %s" - (expand-file-name invocation-name invocation-directory) + (shell-quote-argument + (expand-file-name invocation-name invocation-directory)) (mapconcat 'shell-quote-argument load-path " -L ") (shell-quote-argument (format code tm))))))))) @@ -4680,7 +4749,8 @@ process sentinels. They shall not disturb each other." (shell-command-to-string (format "%s -batch -Q -L %s --eval %s" - (expand-file-name invocation-name invocation-directory) + (shell-quote-argument + (expand-file-name invocation-name invocation-directory)) (mapconcat 'shell-quote-argument load-path " -L ") (shell-quote-argument code)))))))) @@ -4707,7 +4777,8 @@ process sentinels. They shall not disturb each other." (shell-command-to-string (format "%s -batch -Q -L %s -l tramp-sh --eval %s" - (expand-file-name invocation-name invocation-directory) + (shell-quote-argument + (expand-file-name invocation-name invocation-directory)) (mapconcat 'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) commit 9a7a2e919a50e862f0dec19a89cb4de29c07d44d Author: Noam Postavsky Date: Sun May 27 22:13:38 2018 -0400 ; ChangeLog.3: Remove stray phrase. diff --git a/ChangeLog.3 b/ChangeLog.3 index b19d6bd724..42452c3397 100644 --- a/ChangeLog.3 +++ b/ChangeLog.3 @@ -43575,8 +43575,6 @@ * src/bytecode.c (exec_byte_code): Remove MAX_ALLOCA-based limit on bytecode maxdepth, by using SAFE_ALLOCA_LISP instead of alloca. - pipeline is fuller. - 2016-08-09 Paul Eggert Tune bytecode quitting commit 038063651ec0d16300095b9056282ffb1535c03a Author: Eli Zaretskii Date: Mon May 28 19:09:55 2018 +0300 Bump Emacs version to 26.1.50 * msdos/sed2v2.inp: * nt/README.W32: * configure.ac: * README: Bump Emacs version to 26.1.50. diff --git a/README b/README index 682caf01ca..8fcbb2f43d 100644 --- a/README +++ b/README @@ -2,7 +2,7 @@ Copyright (C) 2001-2018 Free Software Foundation, Inc. See the end of the file for license conditions. -This directory tree holds version 26.1 of GNU Emacs, the extensible, +This directory tree holds version 26.1.50 of GNU Emacs, the extensible, customizable, self-documenting real-time display editor. The file INSTALL in this directory says how to build and install GNU diff --git a/configure.ac b/configure.ac index 256b954a89..c66c80adbb 100644 --- a/configure.ac +++ b/configure.ac @@ -23,7 +23,7 @@ dnl along with GNU Emacs. If not, see . AC_PREREQ(2.65) dnl Note this is parsed by (at least) make-dist and lisp/cedet/ede/emacs.el. -AC_INIT(GNU Emacs, 26.1, bug-gnu-emacs@gnu.org) +AC_INIT(GNU Emacs, 26.1.50, bug-gnu-emacs@gnu.org) dnl Set emacs_config_options to the options of 'configure', quoted for the shell, dnl and then quoted again for a C string. Separate options with spaces. diff --git a/msdos/sed2v2.inp b/msdos/sed2v2.inp index 535aa7d898..89cb7dcdd0 100644 --- a/msdos/sed2v2.inp +++ b/msdos/sed2v2.inp @@ -66,7 +66,7 @@ /^#undef PACKAGE_NAME/s/^.*$/#define PACKAGE_NAME ""/ /^#undef PACKAGE_STRING/s/^.*$/#define PACKAGE_STRING ""/ /^#undef PACKAGE_TARNAME/s/^.*$/#define PACKAGE_TARNAME ""/ -/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION "26.1"/ +/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION "26.1.50"/ /^#undef SYSTEM_TYPE/s/^.*$/#define SYSTEM_TYPE "ms-dos"/ /^#undef HAVE_DECL_GETENV/s/^.*$/#define HAVE_DECL_GETENV 1/ /^#undef SYS_SIGLIST_DECLARED/s/^.*$/#define SYS_SIGLIST_DECLARED 1/ diff --git a/nt/README.W32 b/nt/README.W32 index 6a0ae9fc3b..1d3064c05d 100644 --- a/nt/README.W32 +++ b/nt/README.W32 @@ -1,7 +1,7 @@ Copyright (C) 2001-2018 Free Software Foundation, Inc. See the end of the file for license conditions. - Emacs version 26.1 for MS-Windows + Emacs version 26.1.50 for MS-Windows This README file describes how to set up and run a precompiled distribution of the latest version of GNU Emacs for MS-Windows. You commit 9d6a3ac73af66184e5bb23555b93833f6a4d9f2e (refs/remotes/origin/fix/bug-31311-pcase-doc-squash) Author: Thien-Thi Nguyen Date: Sat May 26 09:44:10 2018 +0200 Mention pcase as a fifth conditional form * doc/lispref/control.texi (Conditionals): ...here, in first para, w/ xref to "Pattern-Matching Conditional". diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index 72dacdf1e0..9e1bd6b3ec 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -148,9 +148,11 @@ following @var{forms}, in textual order, returning the result of @cindex conditional evaluation Conditional control structures choose among alternatives. Emacs Lisp -has four conditional forms: @code{if}, which is much the same as in +has five conditional forms: @code{if}, which is much the same as in other languages; @code{when} and @code{unless}, which are variants of -@code{if}; and @code{cond}, which is a generalized case statement. +@code{if}; @code{cond}, which is a generalized case statement; +and @code{pcase}, which is a generalization of @code{cond} +(@pxref{Pattern-Matching Conditional}). @defspec if condition then-form else-forms@dots{} @code{if} chooses between the @var{then-form} and the @var{else-forms} commit 567cb9046d098b617c76541a75516ac6ef563be7 Author: Thien-Thi Nguyen Date: Mon May 21 18:16:35 2018 +0200 Overhaul pcase documentation Suggested by Drew Adams (Bug#31311). * doc/lispref/control.texi (Control Structures): Add "Pattern-Matching Conditional" to menu, before "Iteration". (Conditionals): Delete menu. (Pattern matching case statement): Delete node/subsection, by actually moving, renaming, and overhauling it to... (Pattern-Matching Conditional): ...new node/section. (pcase Macro): New node/subsection. (Extending pcase): Likewise. (Backquote Patterns): Likewise. * doc/lispref/elisp.texi (Top) In @detailmenu, add "Pattern-Matching Conditional" under "Control Structures" section and delete "Conditionals" section. * lisp/emacs-lisp/pcase.el (pcase): Rewrite docstring. (pcase-defmacro \` (qpat) ...): Likewise. diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index adec632da6..72dacdf1e0 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -38,6 +38,7 @@ structure constructs (@pxref{Macros}). * Sequencing:: Evaluation in textual order. * Conditionals:: @code{if}, @code{cond}, @code{when}, @code{unless}. * Combining Conditions:: @code{and}, @code{or}, @code{not}. +* Pattern-Matching Conditional:: How to use @code{pcase} and friends. * Iteration:: @code{while} loops. * Generators:: Generic sequences and coroutines. * Nonlocal Exits:: Jumping out of a sequence. @@ -288,214 +289,6 @@ For example: @end group @end example -@menu -* Pattern matching case statement:: -@end menu - -@node Pattern matching case statement -@subsection Pattern matching case statement -@cindex pcase -@cindex pattern matching - -The @code{cond} form lets you choose between alternatives using -predicate conditions that compare values of expressions against -specific values known and written in advance. However, sometimes it -is useful to select alternatives based on more general conditions that -distinguish between broad classes of values. The @code{pcase} macro -allows you to choose between alternatives based on matching the value -of an expression against a series of patterns. A pattern can be a -literal value (for comparisons to literal values you'd use -@code{cond}), or it can be a more general description of the expected -structure of the expression's value. - -@defmac pcase expression &rest clauses -Evaluate @var{expression} and choose among an arbitrary number of -alternatives based on the value of @var{expression}. The possible -alternatives are specified by @var{clauses}, each of which must be a -list of the form @code{(@var{pattern} @var{body-forms}@dots{})}. -@code{pcase} tries to match the value of @var{expression} to the -@var{pattern} of each clause, in textual order. If the value matches, -the clause succeeds; @code{pcase} then evaluates its @var{body-forms}, -and returns the value of the last of @var{body-forms}. Any remaining -@var{clauses} are ignored. If no clauses match, then the @code{pcase} -form evaluates to @code{nil}. - -The @var{pattern} part of a clause can be of one of two types: -@dfn{QPattern}, a pattern quoted with a backquote; or a -@dfn{UPattern}, which is not quoted. UPatterns are simpler, so we -describe them first. - -Note: In the description of the patterns below, we use ``the value -being matched'' to refer to the value of the @var{expression} that is -the first argument of @code{pcase}. - -A UPattern can have the following forms: - -@table @code - -@item '@var{val} -Matches if the value being matched is @code{equal} to @var{val}. -@item @var{atom} -Matches any @var{atom}, which can be a keyword, a number, or a string. -(These are self-quoting, so this kind of UPattern is actually a -shorthand for @code{'@var{atom}}.) Note that a string or a float -matches any string or float with the same contents/value. -@item _ -Matches any value. This is known as @dfn{don't care} or @dfn{wildcard}. -@item @var{symbol} -Matches any value, and additionally let-binds @var{symbol} to the -value it matched, so that you can later refer to it, either in the -@var{body-forms} or also later in the pattern. -@item (pred @var{predfun}) -Matches if the predicate function @var{predfun} returns non-@code{nil} -when called with the value being matched as its argument. -@var{predfun} can be one of the possible forms described below. -@item (guard @var{boolean-expression}) -Matches if @var{boolean-expression} evaluates to non-@code{nil}. This -allows you to include in a UPattern boolean conditions that refer to -symbols bound to values (including the value being matched) by -previous UPatterns. Typically used inside an @code{and} UPattern, see -below. For example, @w{@code{(and x (guard (< x 10)))}} is a pattern -which matches any number smaller than 10 and let-binds the variable -@code{x} to that number. -@item (let @var{upattern} @var{expression}) -Matches if the specified @var{expression} matches the specified -@var{upattern}. This allows matching a pattern against the value of -an @emph{arbitrary} expression, not just the expression that is the -first argument to @code{pcase}. (It is called @code{let} because -@var{upattern} can bind symbols to values using the @var{symbol} -UPattern. For example: -@w{@code{((or `(key . ,val) (let val 5)) val)}}.) -@item (app @var{function} @var{upattern}) -Matches if @var{function} applied to the value being matched returns a -value that matches @var{upattern}. This is like the @code{pred} -UPattern, except that it tests the result against @var{upattern}, -rather than against a boolean truth value. The @var{function} call can -use one of the forms described below. -@item (or @var{upattern1} @var{upattern2}@dots{}) -Matches if one the argument UPatterns matches. As soon as the first -matching UPattern is found, the rest are not tested. For this reason, -if any of the UPatterns let-bind symbols to the matched value, they -should all bind the same symbols. -@item (and @var{upattern1} @var{upattern2}@dots{}) -Matches if all the argument UPatterns match. -@end table - -The function calls used in the @code{pred} and @code{app} UPatterns -can have one of the following forms: - -@table @asis -@item function symbol, like @code{integerp} -In this case, the named function is applied to the value being -matched. -@item lambda-function @code{(lambda (@var{arg}) @var{body})} -In this case, the lambda-function is called with one argument, the -value being matched. -@item @code{(@var{func} @var{args}@dots{})} -This is a function call with @var{n} specified arguments; the function -is called with these @var{n} arguments and an additional @var{n}+1-th -argument that is the value being matched. -@end table - -Here's an illustrative example of using UPatterns: - -@c FIXME: This example should use every one of the UPatterns described -@c above at least once. -@example -(pcase (get-return-code x) - ('success (message "Done!")) - ('would-block (message "Sorry, can't do it now")) - ('read-only (message "The shmliblick is read-only")) - ('access-denied (message "You do not have the needed rights")) - (code (message "Unknown return code %S" code))) -@end example - -In addition, you can use backquoted patterns that are more powerful. -They allow matching the value of the @var{expression} that is the -first argument of @code{pcase} against specifications of its -@emph{structure}. For example, you can specify that the value must be -a list of 2 elements whose first element is a specific string and the -second element is any value with a backquoted pattern like -@code{`("first" ,second-elem)}. - -Backquoted patterns have the form @code{`@var{qpattern}} where -@var{qpattern} can have the following forms: - -@table @code -@item (@var{qpattern1} . @var{qpattern2}) -Matches if the value being matched is a cons cell whose @code{car} -matches @var{qpattern1} and whose @code{cdr} matches @var{qpattern2}. -This readily generalizes to backquoted lists as in -@w{@code{(@var{qpattern1} @var{qpattern2} @dots{})}}. -@item [@var{qpattern1} @var{qpattern2} @dots{} @var{qpatternm}] -Matches if the value being matched is a vector of length @var{m} whose -@code{0}..@code{(@var{m}-1)}th elements match @var{qpattern1}, -@var{qpattern2} @dots{} @var{qpatternm}, respectively. -@item @var{atom} -Matches if corresponding element of the value being matched is -@code{equal} to the specified @var{atom}. -@item ,@var{upattern} -Matches if the corresponding element of the value being matched -matches the specified @var{upattern}. -@end table - -Note that uses of QPatterns can be expressed using only UPatterns, as -QPatterns are implemented on top of UPatterns using -@code{pcase-defmacro}, described below. However, using QPatterns will -in many cases lead to a more readable code. -@c FIXME: There should be an example here showing how a 'pcase' that -@c uses QPatterns can be rewritten using UPatterns. - -@end defmac - -Here is an example of using @code{pcase} to implement a simple -interpreter for a little expression language (note that this example -requires lexical binding, @pxref{Lexical Binding}): - -@example -(defun evaluate (exp env) - (pcase exp - (`(add ,x ,y) (+ (evaluate x env) (evaluate y env))) - (`(call ,fun ,arg) (funcall (evaluate fun env) (evaluate arg env))) - (`(fn ,arg ,body) (lambda (val) - (evaluate body (cons (cons arg val) env)))) - ((pred numberp) exp) - ((pred symbolp) (cdr (assq exp env))) - (_ (error "Unknown expression %S" exp)))) -@end example - -Here @code{`(add ,x ,y)} is a pattern that checks that @code{exp} is a -three-element list starting with the literal symbol @code{add}, then -extracts the second and third elements and binds them to the variables -@code{x} and @code{y}. Then it evaluates @code{x} and @code{y} and -adds the results. The @code{call} and @code{fn} patterns similarly -implement two flavors of function calls. @code{(pred numberp)} is a -pattern that simply checks that @code{exp} is a number and if so, -evaluates it. @code{(pred symbolp)} matches symbols, and returns -their association. Finally, @code{_} is the catch-all pattern that -matches anything, so it's suitable for reporting syntax errors. - -Here are some sample programs in this small language, including their -evaluation results: - -@example -(evaluate '(add 1 2) nil) ;=> 3 -(evaluate '(add x y) '((x . 1) (y . 2))) ;=> 3 -(evaluate '(call (fn x (add 1 x)) 2) nil) ;=> 3 -(evaluate '(sub 1 2) nil) ;=> error -@end example - -Additional UPatterns can be defined using the @code{pcase-defmacro} -macro. - -@defmac pcase-defmacro name args &rest body -Define a new kind of UPattern for @code{pcase}. The new UPattern will -be invoked as @code{(@var{name} @var{actual-args})}. The @var{body} -should describe how to rewrite the UPattern @var{name} into some other -UPattern. The rewriting will be the result of evaluating @var{body} -in an environment where @var{args} are bound to @var{actual-args}. -@end defmac - @node Combining Conditions @section Constructs for Combining Conditions @cindex combining conditions @@ -621,6 +414,758 @@ This is not completely equivalent because it can evaluate @var{arg1} or @var{arg3})} never evaluates any argument more than once. @end defspec +@node Pattern-Matching Conditional +@section Pattern-Matching Conditional +@cindex pcase +@cindex pattern matching + +Aside from the four basic conditional forms, Emacs Lisp also +has a pattern-matching conditional form, the @code{pcase} macro, +a hybrid of @code{cond} and @code{cl-case} +(@pxref{Conditionals,,,cl,Common Lisp Extensions}) +that overcomes their limitations and introduces +the @dfn{pattern matching} programming style. +First, the limitations: + +@itemize +@item The @code{cond} form chooses among alternatives +by evaluating the predicate @var{condition} of each +of its clauses (@pxref{Conditionals}). +The primary limitation is that variables let-bound in @var{condition} +are not available to the clause's @var{body-forms}. + +Another annoyance (more an inconvenience than a limitation) +is that when a series of @var{condition} predicates implement +equality tests, there is a lot of repeated code. +For that, why not use @code{cl-case}? + +@item +The @code{cl-case} macro chooses among alternatives by evaluating +the equality of its first argument against a set of specific +values. +The limitations are two-fold: + +@enumerate +@item The equality tests use @code{eql}. +@item The values must be known and written in advance. +@end enumerate + +@noindent +These render @code{cl-case} unsuitable for strings or compound +data structures (e.g., lists or vectors). +For that, why not use @code{cond}? +(And here we end up in a circle.) +@end itemize + +@noindent +Conceptually, the @code{pcase} macro borrows the first-arg focus +of @code{cl-case} and the clause-processing flow of @code{cond}, +replacing @var{condition} with a generalization of +the equality test called @dfn{matching}, +and adding facilities so that you can concisely express a +clause's predicate, and arrange to share let-bindings between +a clause's predicate and @var{body-forms}. + +The concise expression of a predicate is known as a @dfn{pattern}. +When the predicate, called on the value of the first arg, +returns non-@code{nil}, the pattern matches the value +(or sometimes ``the value matches the pattern''). + +@menu +* The @code{pcase} macro: pcase Macro. Plus examples and caveats. +* Extending @code{pcase}: Extending pcase. Define new kinds of patterns. +* Backquote-Style Patterns: Backquote Patterns. Structural matching. +@end menu + +@node pcase Macro +@subsection The @code{pcase} macro + +For background, @xref{Pattern-Matching Conditional}. + +@defmac pcase expression &rest clauses +Each clause in @var{clauses} has the form: +@w{@code{(@var{pattern} @var{body-forms}@dots{})}}. + +Evaluate @var{expression} to determine its value, @var{expval}. +Find the first clause in @var{clauses} whose @var{pattern} matches +@var{expval} and pass control to that clause's @var{body-forms}. + +If there is a match, the value of @code{pcase} is the value +of the last of @var{body-forms} in the successful clause. +Otherwise, @code{pcase} evaluates to @code{nil}. +@end defmac + +The rest of this subsection +describes different forms of core patterns, +presents some examples, +and concludes with important caveats on using the +let-binding facility provided by some pattern forms. +A core pattern can have the following forms: + +@table @code + +@item _ +Matches any @var{expval}. +This is known as @dfn{don't care} or @dfn{wildcard}. + +@item '@var{val} +Matches if @var{expval} is @code{equal} to @var{val}. + +@item @var{keyword} +@itemx @var{integer} +@itemx @var{string} +Matches if @var{expval} is @code{equal} to the literal object. +This is a special case of @code{'@var{val}}, above, +possible because literal objects of these types are self-quoting. + +@item @var{symbol} +Matches any @var{expval}, and additionally let-binds @var{symbol} to +@var{expval}, such that this binding is available to +@var{body-forms} (@pxref{Dynamic Binding}). + +If @var{symbol} is part of a sequencing pattern @var{seqpat} +(e.g., by using @code{and}, below), the binding is also available to +the portion of @var{seqpat} following the appearance of @var{symbol}. +This usage has some caveats (@pxref{pcase-symbol-caveats,,caveats}). + +Two symbols to avoid are @code{t}, which behaves like @code{_} +(above) and is deprecated, and @code{nil}, which signals error. +Likewise, it makes no sense to bind keyword symbols +(@pxref{Constant Variables}). + +@item (pred @var{function}) +Matches if the predicate @var{function} returns non-@code{nil} +when called on @var{expval}. +@var{function} can have one of the possible forms: + +@table @asis +@item function name (a symbol) +Call the named function with one argument, @var{expval}. + +Example: @code{integerp} + +@item lambda expression +Call the anonymous function with one argument, +@var{expval} (@pxref{Lambda Expressions}). + +Example: @code{(lambda (n) (= 42 n))} + +@item function call with @var{n} args +Call the function (the first element of the function call) +with @var{n} arguments (the other elements) and an additional +@var{n}+1-th argument that is @var{expval}. + +Example: @code{(= 42)}@* +In this example, the function is @code{=}, @var{n} is one, and +the actual function call becomes: @w{@code{(= 42 @var{expval})}}. +@end table + +@item (app @var{function} @var{pattern}) +Matches if @var{function} called on @var{expval} returns a +value that matches @var{pattern}. +@var{function} can take one of the +forms described for @code{pred}, above. +Unlike @code{pred}, however, +@code{app} tests the result against @var{pattern}, +rather than against a boolean truth value. + +@item (guard @var{boolean-expression}) +Matches if @var{boolean-expression} evaluates to non-@code{nil}. + +@item (let @var{pattern} @var{expr}) +Evaluates @var{expr} to get @var{exprval} +and matches if @var{exprval} matches @var{pattern}. +(It is called @code{let} because +@var{pattern} can bind symbols to values using @var{symbol}.) +@end table + +@cindex sequencing pattern +A @dfn{sequencing pattern} (also known as @var{seqpat}) is a +pattern that processes its sub-pattern arguments in sequence. +There are two for @code{pcase}: @code{and} and @code{or}. +They behave in a similar manner to the special forms +that share their name (@pxref{Combining Conditions}), +but instead of processing values, they process sub-patterns. + +@table @code +@item (and @var{pattern1}@dots{}) +Attempts to match @var{pattern1}@dots{}, in order, +until one of them fails to match. +In that case, @code{and} likewise fails to match, +and the rest of the sub-patterns are not tested. +If all sub-patterns match, @code{and} matches. + +@item (or @var{pattern1} @var{pattern2}@dots{}) +Attempts to match @var{pattern1}, @var{pattern2}, @dots{}, in order, +until one of them succeeds. +In that case, @code{or} likewise matches, +and the rest of the sub-patterns are not tested. +(Note that there must be at least two sub-patterns. +Simply @w{@code{(or @var{pattern1})}} signals error.) +@c Issue: Is this correct and intended? +@c Are there exceptions, qualifications? +@c (Btw, ``Please avoid it'' is a poor error message.) + +To present a consistent environment (@pxref{Intro Eval}) +to @var{body-forms} (thus avoiding an evaluation error on match), +if any of the sub-patterns let-binds a set of symbols, +they @emph{must} all bind the same set of symbols. +@end table + +@anchor{pcase-example-0} +@subheading Example: Advantage Over @code{cl-case} + +Here's an example that highlights some advantages @code{pcase} +has over @code{cl-case} +(@pxref{Conditionals,,,cl,Common Lisp Extensions}). + +@example +@group +(pcase (get-return-code x) + ;; string + ((and (pred stringp) msg) + (message "%s" msg)) +@end group +@group + ;; symbol + ('success (message "Done!")) + ('would-block (message "Sorry, can't do it now")) + ('read-only (message "The shmliblick is read-only")) + ('access-denied (message "You do not have the needed rights")) +@end group +@group + ;; default + (code (message "Unknown return code %S" code))) +@end group +@end example + +@noindent +With @code{cl-case}, you would need to explicitly declare a local +variable @code{code} to hold the return value of @code{get-return-code}. +Also @code{cl-case} is difficult to use with strings because it +uses @code{eql} for comparison. + +@anchor{pcase-example-1} +@subheading Example: Using @code{and} + +A common idiom is to write a pattern starting with @code{and}, +with one or more @var{symbol} sub-patterns providing bindings +to the sub-patterns that follow (as well as to the body forms). +For example, the following pattern matches single-digit integers. + +@example +@group +(and + (pred integerp) + n ; @r{bind @code{n} to @var{expval}} + (guard (<= -9 n 9))) +@end group +@end example + +@noindent +First, @code{pred} matches if @w{@code{(integerp @var{expval})}} +evaluates to non-@code{nil}. +Next, @code{n} is a @var{symbol} pattern that matches +anything and binds @code{n} to @var{expval}. +Lastly, @code{guard} matches if the boolean expression +@w{@code{(<= -9 n 9)}} (note the reference to @code{n}) +evaluates to non-@code{nil}. +If all these sub-patterns match, @code{and} matches. + +@anchor{pcase-example-2} +@subheading Example: Reformulation with @code{pcase} + +Here is another example that shows how to reformulate a simple +matching task from its traditional implementation +(function @code{grok/traditional}) to one using +@code{pcase} (function @code{grok/pcase}). +The docstring for both these functions is: +``If OBJ is a string of the form "key:NUMBER", return NUMBER +(a string). Otherwise, return the list ("149" default).'' +First, the traditional implementation (@pxref{Regular Expressions}): + +@example +@group +(defun grok/traditional (obj) + (if (and (stringp obj) + (string-match "^key:\\([[:digit:]]+\\)$" obj)) + (match-string 1 obj) + (list "149" 'default))) +@end group + +@group +(grok/traditional "key:0") @result{} "0" +(grok/traditional "key:149") @result{} "149" +(grok/traditional 'monolith) @result{} ("149" default) +@end group +@end example + +@noindent +The reformulation demonstrates @var{symbol} binding as well as +@code{or}, @code{and}, @code{pred}, @code{app} and @code{let}. + +@example +@group +(defun grok/pcase (obj) + (pcase obj + ((or ; @r{line 1} + (and ; @r{line 2} + (pred stringp) ; @r{line 3} + (pred (string-match ; @r{line 4} + "^key:\\([[:digit:]]+\\)$")) ; @r{line 5} + (app (match-string 1) ; @r{line 6} + val)) ; @r{line 7} + (let val (list "149" 'default))) ; @r{line 8} + val))) ; @r{line 9} +@end group + +@group +(grok/pcase "key:0") @result{} "0" +(grok/pcase "key:149") @result{} "149" +(grok/pcase 'monolith) @result{} ("149" default) +@end group +@end example + +@noindent +The bulk of @code{grok/pcase} is a single clause of a @code{pcase} +form, the pattern on lines 1-8, the (single) body form on line 9. +The pattern is @code{or}, which tries to match in turn its argument +sub-patterns, first @code{and} (lines 2-7), then @code{let} (line 8), +until one of them succeeds. + +As in the previous example (@pxref{pcase-example-1,,Example 1}), +@code{and} begins with a @code{pred} sub-pattern to ensure +the following sub-patterns work with an object of the correct +type (string, in this case). If @w{@code{(stringp @var{expval})}} +returns @code{nil}, @code{pred} fails, and thus @code{and} fails, too. + +The next @code{pred} (lines 4-5) evaluates +@w{@code{(string-match RX @var{expval})}} +and matches if the result is non-@code{nil}, which means +that @var{expval} has the desired form: @code{key:NUMBER}. +Again, failing this, @code{pred} fails and @code{and}, too. + +Lastly (in this series of @code{and} sub-patterns), @code{app} +evaluates @w{@code{(match-string 1 @var{expval})}} (line 6) +to get a temporary value @var{tmp} (i.e., the ``NUMBER'' substring) +and tries to match @var{tmp} against pattern @code{val} (line 7). +Since that is a @var{symbol} pattern, it matches unconditionally +and additionally binds @code{val} to @var{tmp}. + +Now that @code{app} has matched, all @code{and} sub-patterns +have matched, and so @code{and} matches. +Likewise, once @code{and} has matched, @code{or} matches +and does not proceed to try sub-pattern @code{let} (line 8). + +Let's consider the situation where @code{obj} is not a string, +or it is a string but has the wrong form. +In this case, one of the @code{pred} (lines 3-5) fails to match, +thus @code{and} (line 2) fails to match, +thus @code{or} (line 1) proceeds to try sub-pattern @code{let} (line 8). + +First, @code{let} evaluates @w{@code{(list "149" 'default)}} +to get @w{@code{("149" default)}}, the @var{exprval}, and then +tries to match @var{exprval} against pattern @code{val}. +Since that is a @var{symbol} pattern, it matches unconditionally +and additionally binds @code{val} to @var{exprval}. +Now that @code{let} has matched, @code{or} matches. + +Note how both @code{and} and @code{let} sub-patterns finish in the +same way: by trying (always successfully) to match against the +@var{symbol} pattern @code{val}, in the process binding @code{val}. +Thus, @code{or} always matches and control always passes +to the body form (line 9). +Because that is the last body form in a successfully matched +@code{pcase} clause, it is the value of @code{pcase} and likewise +the return value of @code{grok/pcase} (@pxref{What Is a Function}). + +@anchor{pcase-symbol-caveats} +@subheading Caveats for @var{symbol} in Sequencing Patterns + +The preceding examples all use sequencing patterns +which include the @var{symbol} +sub-pattern in some way. +Here are some important details about that usage. + +@enumerate +@item When @var{symbol} occurs more than once in @var{seqpat}, +the second and subsequent occurances do not expand to re-binding, +but instead expand to an equality test using @code{eq}. + +The following example features a @code{pcase} form +with two clauses and two @var{seqpat}, A and B. +Both A and B first check that @var{expval} is a +pair (using @code{pred}), +and then bind symbols to the @code{car} and @code{cdr} +of @var{expval} (using one @code{app} each). + +For A, because symbol @code{st} is mentioned twice, the second +mention becomes an equality test using @code{eq}. +On the other hand, B uses two separate symbols, @code{s1} and +@code{s2}, both of which become independent bindings. + +@example +@group +(defun grok (object) + (pcase object + ((and (pred consp) ; seqpat A + (app car st) ; first mention: st + (app cdr st)) ; second mention: st + (list 'eq st)) +@end group +@group + ((and (pred consp) ; seqpat B + (app car s1) ; first mention: s1 + (app cdr s2)) ; first mention: s2 + (list 'not-eq s1 s2)))) +@end group + +@group +(let ((s "yow!")) + (grok (cons s s))) @result{} (eq "yow!") +(grok (cons "yo!" "yo!")) @result{} (not-eq "yo!" "yo!") +(grok '(4 2)) @result{} (not-eq 4 (2)) +@end group +@end example + +@item Side-effecting code referencing @var{symbol} is undefined. +Avoid. +For example, here are two similar functions. +Both use @code{and}, @var{symbol} and @code{guard}: + +@example +@group +(defun square-double-digit-p/CLEAN (integer) + (pcase (* integer integer) + ((and n (guard (< 9 n 100))) (list 'yes n)) + (sorry (list 'no sorry)))) + +(square-double-digit-p/CLEAN 9) @result{} (yes 81) +(square-double-digit-p/CLEAN 3) @result{} (no 9) +@end group + +@group +(defun square-double-digit-p/MAYBE (integer) + (pcase (* integer integer) + ((and n (guard (< 9 (incf n) 100))) (list 'yes n)) + (sorry (list 'no sorry)))) + +(square-double-digit-p/MAYBE 9) @result{} (yes 81) +(square-double-digit-p/MAYBE 3) @result{} (yes 9) ; @r{WRONG!} +@end group +@end example + +@noindent +The difference is in @var{boolean-expression} in @code{guard}: +@code{CLEAN} references @code{n} simply and directly, +while @code{MAYBE} references @code{n} with a side-effect, +in the expression @code{(incf n)}. +When @code{integer} is 3, here's what happens: + +@itemize +@item The first @code{n} binds it to @var{expval}, +i.e., the result of evaluating @code{(* 3 3)}, or 9. + +@item @var{boolean-expression} is evaluated: + +@example +@group +start: (< 9 (incf n) 100) +becomes: (< 9 (setq n (1+ n)) 100) +becomes: (< 9 (setq n (1+ 9)) 100) +@end group +@group +becomes: (< 9 (setq n 10) 100) + ; @r{side-effect here!} +becomes: (< 9 n 100) ; @r{@code{n} now bound to 10} +becomes: (< 9 10 100) +becomes: t +@end group +@end example + +@item Because the result of the evaluation is non-@code{nil}, +@code{guard} matches, @code{and} matches, and +control passes to that clause's body forms. +@end itemize + +@noindent +Aside from the mathematical incorrectness of asserting that 9 is a +double-digit integer, there is another problem with @code{MAYBE}. +The body form references @code{n} once more, yet we do not see +the updated value---10---at all. What happened to it? + +To sum up, it's best to avoid side-effecting references to +@var{symbol} patterns entirely, not only +in @var{boolean-expression} (in @code{guard}), +but also in @var{expr} (in @code{let}) +and @var{function} (in @code{pred} and @code{app}). + +@item On match, the clause's body forms can reference the set +of symbols the pattern let-binds. +When @var{seqpat} is @code{and}, this set is +the union of all the symbols each of its sub-patterns let-binds. +This makes sense because, for @code{and} to match, +all the sub-patterns must match. + +When @var{seqpat} is @code{or}, things are different: +@code{or} matches at the first sub-pattern that matches; +the rest of the sub-patterns are ignored. +It makes no sense for each sub-pattern to let-bind a different +set of symbols because the body forms have no way to distinguish +which sub-pattern matched and choose among the different sets. +For example, the following is invalid: + +@example +@group +(pcase (read-number "Enter an integer: ") + ((or (and (pred evenp) + e-num) ; @r{bind @code{e-num} to @var{expval}} + o-num) ; @r{bind @code{o-num} to @var{expval}} + (list e-num o-num))) +@end group + +@group +Enter an integer: 42 +@error{} Symbol’s value as variable is void: o-num +@end group +@group +Enter an integer: 149 +@error{} Symbol’s value as variable is void: e-num +@end group +@end example + +@noindent +Evaluating body form @w{@code{(list e-num o-num)}} signals error. +To distinguish between sub-patterns, you can use another symbol, +identical in name in all sub-patterns but differing in value. +Reworking the above example: + +@example +@group +(pcase (read-number "Enter an integer: ") + ((and num ; @r{line 1} + (or (and (pred evenp) ; @r{line 2} + (let spin 'even)) ; @r{line 3} + (let spin 'odd))) ; @r{line 4} + (list spin num))) ; @r{line 5} +@end group + +@group +Enter an integer: 42 +@result{} (even 42) +@end group +@group +Enter an integer: 149 +@result{} (odd 149) +@end group +@end example + +@noindent +Line 1 ``factors out'' the @var{expval} binding with +@code{and} and @var{symbol} (in this case, @code{num}). +On line 2, @code{or} begins in the same way as before, +but instead of binding different symbols, uses @code{let} twice +(lines 3-4) to bind the same symbol @code{spin} in both sub-patterns. +The value of @code{spin} distinguishes the sub-patterns. +The body form references both symbols (line 5). +@end enumerate + +@node Extending pcase +@subsection Extending @code{pcase} +@cindex pcase, defining new kinds of patterns + +The @code{pcase} macro supports several kinds of patterns +(@pxref{Pattern-Matching Conditional}). +You can add support for other kinds of patterns +using the @code{pcase-defmacro} macro. + +@defmac pcase-defmacro name args [doc] &rest body +Define a new kind of pattern for @code{pcase}, to be invoked +as @w{@code{(@var{name} @var{actual-args})}}. +The @code{pcase} macro expands this into a function call +that evaluates @var{body}, whose job it is to +rewrite the invoked pattern into some other pattern, +in an environment where @var{args} are bound to @var{actual-args}. + +Additionally, arrange to display @var{doc} along with +the docstring of @code{pcase}. +By convention, @var{doc} should use @code{EXPVAL} +to stand for the result of +evaluating @var{expression} (first arg to @code{pcase}). +@end defmac + +@noindent +Typically, @var{body} rewrites the invoked pattern +to use more basic patterns. +Although all patterns eventually reduce to core patterns, +@code{body} need not use core patterns straight away. +The following example defines two patterns, named +@code{less-than} and @code{integer-less-than}. + +@example +@group +(pcase-defmacro less-than (n) + "Matches if EXPVAL is a number less than N." + `(pred (> ,n))) +@end group + +@group +(pcase-defmacro integer-less-than (n) + "Matches if EXPVAL is an integer less than N." + `(and (pred integerp) + (less-than ,n))) +@end group +@end example + +@noindent +Note that the docstrings mention @var{args} +(in this case, only one: @code{n}) in the usual way, +and also mention @code{EXPVAL} by convention. +The first rewrite (i.e., @var{body} for @code{less-than}) +uses one core pattern: @code{pred}. +The second uses two core patterns: @code{and} and @code{pred}, +as well as the newly-defined pattern @code{less-than}. +Both use a single backquote construct (@pxref{Backquote}). + +@node Backquote Patterns +@subsection Backquote-Style Patterns +@cindex backquote-style patterns +@cindex matching, structural +@cindex structural matching + +This subsection describes @dfn{backquote-style patterns}, +a set of builtin patterns that eases structural matching. +For background, @xref{Pattern-Matching Conditional}. + +@dfn{Backquote-style patterns} are a powerful set of +@code{pcase} pattern extensions (created using @code{pcase-defmacro}) +that make it easy to match @var{expval} against +specifications of its @emph{structure}. + +For example, to match @var{expval} that must be a list of two +elements whose first element is a specific string and the second +element is any value, you can write a core pattern: + +@example +@group +(and (pred listp) + ls +@end group +@group + (guard (= 2 (length ls))) + (guard (string= "first" (car ls))) + (let second-elem (cadr ls))) +@end group +@end example + +@noindent +or you can write the equivalent backquote-style pattern: + +@example +`("first" ,second-elem) +@end example + +@noindent +The backquote-style pattern is more concise, +resembles the structure of @var{expval}, +and avoids binding @code{ls}. + +A backquote-style pattern has the form @code{`@var{qpat}} where +@var{qpat} can have the following forms: + +@table @code + +@item (@var{qpat1} . @var{qpat2}) +Matches if @var{expval} is a cons cell whose @code{car} +matches @var{qpat1} and whose @code{cdr} matches @var{qpat2}. +This readily generalizes to lists as in +@w{@code{(@var{qpat1} @var{qpat2} @dots{})}}. + +@item [@var{qpat1} @var{qpat2} @dots{} @var{qpatm}] +Matches if @var{expval} is a vector of length @var{m} whose +@code{0}..@code{(@var{m}-1)}th elements match @var{qpat1}, +@var{qpat2} @dots{} @var{qpatm}, respectively. + +@item @var{symbol} +@itemx @var{keyword} +@itemx @var{integer} +@itemx @var{string} +Matches if the corresponding element of @var{expval} is +@code{equal} to the specified literal object. +Note that, aside from @var{symbol}, this is the same set of +self-quoting literal objects that are acceptable as a core pattern. + +@item ,@var{pattern} +Matches if the corresponding element of @var{expval} +matches @var{pattern}. +Note that @var{pattern} is any kind that @code{pcase} supports. +(In the example above, @code{second-elem} is a @var{symbol} +core pattern; it therefore matches anything, +and let-binds @code{second-elem}.) +@end table + +The @dfn{corresponding element} is the portion of @var{expval} +that is in the same structural position as the structural position +of @var{qpat} in the backquote-style pattern. +(In the example above, the corresponding element of +@code{second-elem} is the second element of @var{expval}.) + +Here is an example of using @code{pcase} to implement a simple +interpreter for a little expression language +(note that this requires lexical binding for the +lambda expression in the @code{fn} clause to properly +capture @code{body} and @code{arg} (@pxref{Lexical Binding}): + +@example +@group +(defun evaluate (form env) + (pcase form + (`(add ,x ,y) (+ (evaluate x env) + (evaluate y env))) +@end group +@group + (`(call ,fun ,arg) (funcall (evaluate fun env) + (evaluate arg env))) + (`(fn ,arg ,body) (lambda (val) + (evaluate body (cons (cons arg val) + env)))) +@end group +@group + ((pred numberp) form) + ((pred symbolp) (cdr (assq form env))) + (_ (error "Syntax error: %S" form)))) +@end group +@end example + +@noindent +The first three clauses use backquote-style patterns. +@code{`(add ,x ,y)} is a pattern that checks that @code{form} +is a three-element list starting with the literal symbol @code{add}, +then extracts the second and third elements and binds them +to symbols @code{x} and @code{y}, respectively. +The clause body evaluates @code{x} and @code{y} and adds the results. +Similarly, the @code{call} clause implements a function call, +and the @code{fn} clause implements an anonymous function definition. + +The remaining clauses use core patterns. +@code{(pred numberp)} matches if @code{form} is a number. +On match, the body evaluates it. +@code{(pred symbolp)} matches if @code{form} is a symbol. +On match, the body looks up the symbol in @code{env} and +returns its association. +Finally, @code{_} is the catch-all pattern that +matches anything, so it's suitable for reporting syntax errors. + +Here are some sample programs in this small language, including their +evaluation results: + +@example +(evaluate '(add 1 2) nil) @result{} 3 +(evaluate '(add x y) '((x . 1) (y . 2))) @result{} 3 +(evaluate '(call (fn x (add 1 x)) 2) nil) @result{} 3 +(evaluate '(sub 1 2) nil) @result{} error +@end example + @node Iteration @section Iteration @cindex iteration diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index 6b59e31917..6c3182b0c7 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -475,14 +475,11 @@ Control Structures * Sequencing:: Evaluation in textual order. * Conditionals:: @code{if}, @code{cond}, @code{when}, @code{unless}. * Combining Conditions:: @code{and}, @code{or}, @code{not}. +* Pattern-Matching Conditional:: How to use @code{pcase} and friends. * Iteration:: @code{while} loops. * Generators:: Generic sequences and coroutines. * Nonlocal Exits:: Jumping out of a sequence. -Conditionals - -* Pattern matching case statement:: How to use @code{pcase}. - Nonlocal Exits * Catch and Throw:: Nonlocal exits for the program's own purposes. diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 38e434de37..fa7b1de8b4 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -110,56 +110,41 @@ (defmacro pcase (exp &rest cases) "Evaluate EXP to get EXPVAL; try passing control to one of CASES. CASES is a list of elements of the form (PATTERN CODE...). - -A structural PATTERN describes a template that identifies a class -of values. For example, the pattern \\=`(,foo ,bar) matches any -two element list, binding its elements to symbols named `foo' and -`bar' -- in much the same way that `cl-destructuring-bind' would. - -A significant difference from `cl-destructuring-bind' is that, if -a pattern match fails, the next case is tried until either a -successful match is found or there are no more cases. The CODE -expression corresponding to the matching pattern determines the -return value. If there is no match the returned value is nil. - -Another difference is that pattern elements may be quoted, -meaning they must match exactly: The pattern \\='(foo bar) -matches only against two element lists containing the symbols -`foo' and `bar' in that order. (As a short-hand, atoms always -match themselves, such as numbers or strings, and need not be -quoted.) - -Lastly, a pattern can be logical, such as (pred numberp), that -matches any number-like element; or the symbol `_', that matches -anything. Also, when patterns are backquoted, a comma may be -used to introduce logical patterns inside backquoted patterns. - -The complete list of standard patterns is as follows: - - _ matches anything. - SYMBOL matches anything and binds it to SYMBOL. - If a SYMBOL is used twice in the same pattern - the second occurrence becomes an `eq'uality test. - (or PAT...) matches if any of the patterns matches. - (and PAT...) matches if all the patterns match. - \\='VAL matches if the object is `equal' to VAL. - ATOM is a shorthand for \\='ATOM. - ATOM can be a keyword, an integer, or a string. - (pred FUN) matches if FUN applied to the object returns non-nil. - (guard BOOLEXP) matches if BOOLEXP evaluates to non-nil. - (let PAT EXP) matches if EXP matches PAT. - (app FUN PAT) matches if FUN applied to the object matches PAT. +For the first CASE whose PATTERN \"matches\" EXPVAL, +evaluate its CODE..., and return the value of the last form. +If no CASE has a PATTERN that matches, return nil. + +Each PATTERN expands, in essence, to a predicate to call +on EXPVAL. When the return value of that call is non-nil, +PATTERN matches. PATTERN can take one of the forms: + + _ matches anything. + \\='VAL matches if EXPVAL is `equal' to VAL. + KEYWORD shorthand for \\='KEYWORD + INTEGER shorthand for \\='INTEGER + STRING shorthand for \\='STRING + SYMBOL matches anything and binds it to SYMBOL. + If a SYMBOL is used twice in the same pattern + the second occurrence becomes an `eq'uality test. + (pred FUN) matches if FUN called on EXPVAL returns non-nil. + (app FUN PAT) matches if FUN called on EXPVAL matches PAT. + (guard BOOLEXP) matches if BOOLEXP evaluates to non-nil. + (let PAT EXPR) matches if EXPR matches PAT. + (and PAT...) matches if all the patterns match. + (or PAT...) matches if any of the patterns matches. + +FUN in `pred' and `app' can take one of the forms: + SYMBOL or (lambda ARGS BODY) + call it with one argument + (F ARG1 .. ARGn) + call F with ARG1..ARGn and EXPVAL as n+1'th argument + +FUN, BOOLEXP, EXPR, and subsequent PAT can refer to variables +bound earlier in the pattern by a SYMBOL pattern. Additional patterns can be defined using `pcase-defmacro'. -The FUN argument in the `app' pattern may have the following forms: - SYMBOL or (lambda ARGS BODY) in which case it's called with one argument. - (F ARG1 .. ARGn) in which case F gets called with an n+1'th argument - which is the value being matched. -So a FUN of the form SYMBOL is equivalent to (FUN). -FUN can refer to variables bound earlier in the pattern. - -See Info node `(elisp) Pattern matching case statement' in the +See Info node `(elisp) Pattern-Matching Conditional' in the Emacs Lisp manual for more information and examples." (declare (indent 1) (debug (form &rest (pcase-PAT body)))) ;; We want to use a weak hash table as a cache, but the key will unavoidably @@ -926,14 +911,29 @@ Otherwise, it defers to REST which is a list of branches of the form sexp)) (pcase-defmacro \` (qpat) - "Backquote-style pcase patterns. + "Backquote-style pcase patterns: \\=`QPAT QPAT can take the following forms: (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr. [QPAT1 QPAT2..QPATn] matches a vector of length n and QPAT1..QPATn match its 0..(n-1)th elements, respectively. - ,PAT matches if the pcase pattern PAT matches. - ATOM matches if the object is `equal' to ATOM. - ATOM can be a symbol, an integer, or a string." + ,PAT matches if the `pcase' pattern PAT matches. + SYMBOL matches if EXPVAL is `equal' to SYMBOL. + KEYWORD likewise for KEYWORD. + INTEGER likewise for INTEGER. + STRING likewise for STRING. + +The list or vector QPAT is a template. The predicate formed +by a backquote-style pattern is a combination of those +formed by any sub-patterns, wrapped in a top-level condition: +EXPVAL must be \"congruent\" with the template. For example: + + \\=`(technical ,forum) + +The predicate is the logical-AND of: + - Is EXPVAL a list of two elements? + - Is the first element the symbol `technical'? + - True! (The second element can be anything, and for the sake + of the body forms, its value is bound to the symbol `forum'.)" (declare (debug (pcase-QPAT))) (cond ((eq (car-safe qpat) '\,) (cadr qpat)) commit 4d7e54acff0869d42bfb5b95014f7e6b988666d5 Author: Thien-Thi Nguyen Date: Mon May 21 17:16:31 2018 +0200 Use EXPVAL in docstrings of patterns defined using pcase-defmacro Suggested by Drew Adams (Bug#31311). * lisp/emacs-lisp/cl-macs.el (cl-struct): ...here. * lisp/emacs-lisp/eieio.el (eieio): Likewise. * lisp/emacs-lisp/radix-tree.el (radix-tree-leaf): Likewise. * lisp/emacs-lisp/rx.el (rx): Likewise. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 971f4f926b..9c47ceae18 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2887,10 +2887,10 @@ non-nil value, that slot cannot be set via `setf'. ;;;###autoload (pcase-defmacro cl-struct (type &rest fields) - "Pcase patterns to match cl-structs. -Elements of FIELDS can be of the form (NAME PAT) in which case the contents of -field NAME is matched against PAT, or they can be of the form NAME which -is a shorthand for (NAME NAME)." + "Pcase patterns that match cl-struct EXPVAL of type TYPE. +Elements of FIELDS can be of the form (NAME PAT) in which case the +contents of field NAME is matched against PAT, or they can be of +the form NAME which is a shorthand for (NAME NAME)." (declare (debug (sexp &rest [&or (sexp pcase-PAT) sexp]))) `(and (pred (pcase--flip cl-typep ',type)) ,@(mapcar diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 78275acd9c..b95f7486f7 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -346,10 +346,10 @@ variable name of the same name as the slot." index)))) (pcase-defmacro eieio (&rest fields) - "Pcase patterns to match EIEIO objects. -Elements of FIELDS can be of the form (NAME PAT) in which case the contents of -field NAME is matched against PAT, or they can be of the form NAME which -is a shorthand for (NAME NAME)." + "Pcase patterns that match EIEIO object EXPVAL. +Elements of FIELDS can be of the form (NAME PAT) in which case the +contents of field NAME is matched against PAT, or they can be of + the form NAME which is a shorthand for (NAME NAME)." (declare (debug (&rest [&or (sexp pcase-PAT) sexp]))) (let ((is (make-symbol "table"))) ;; FIXME: This generates a horrendous mess of redundant let bindings. diff --git a/lisp/emacs-lisp/radix-tree.el b/lisp/emacs-lisp/radix-tree.el index 8946560d3b..d76bf024d0 100644 --- a/lisp/emacs-lisp/radix-tree.el +++ b/lisp/emacs-lisp/radix-tree.el @@ -196,6 +196,8 @@ If not found, return nil." (eval-and-compile (pcase-defmacro radix-tree-leaf (vpat) + "Build a `pcase' pattern that matches radix-tree leaf EXPVAL. +VPAT is a `pcase' pattern to extract the value." ;; FIXME: We'd like to use a negative pattern (not consp), but pcase ;; doesn't support it. Using `atom' works but generates sub-optimal code. `(or `(t . ,,vpat) (and (pred atom) ,vpat)))) diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index c4f6d4f70e..302ee23db6 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -1177,7 +1177,7 @@ enclosed in `(and ...)'. (pcase-defmacro rx (&rest regexps) "Build a `pcase' pattern matching `rx' regexps. The REGEXPS are interpreted as by `rx'. The pattern matches if -the regular expression so constructed matches the object, as if +the regular expression so constructed matches EXPVAL, as if by `string-match'. In addition to the usual `rx' constructs, REGEXPS can contain the commit 7e8227ed68357dd05cb7a4ce931e5cafe6c9dd5a Author: Thien-Thi Nguyen Date: Mon May 21 17:11:55 2018 +0200 Introduce EXPVAL for pcase, pcase-defmacro docstrings Suggested by Drew Adams (Bug#31311). * lisp/emacs-lisp/pcase.el (pcase): Use EXPVAL in docstring to stand for the result of evaluating EXP. (pcase-defmacro): Add (fn ...) form in docstring that includes [DOC], and the EXPVAL convention. diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 6e8f08e699..38e434de37 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -108,7 +108,7 @@ ;;;###autoload (defmacro pcase (exp &rest cases) - "Evaluate EXP and attempt to match it against structural patterns. + "Evaluate EXP to get EXPVAL; try passing control to one of CASES. CASES is a list of elements of the form (PATTERN CODE...). A structural PATTERN describes a template that identifies a class @@ -427,7 +427,11 @@ any kind of error." (defmacro pcase-defmacro (name args &rest body) "Define a new kind of pcase PATTERN, by macro expansion. Patterns of the form (NAME ...) will be expanded according -to this macro." +to this macro. + +By convention, DOC should use \"EXPVAL\" to stand +for the result of evaluating EXP (first arg to `pcase'). +\n(fn NAME ARGS [DOC] &rest BODY...)" (declare (indent 2) (debug defun) (doc-string 3)) ;; Add the function via `fsym', so that an autoload cookie placed ;; on a pcase-defmacro will cause the macro to be loaded on demand. commit e6de5b3d51558ef861df68bcda2c4e91afe2d9ef Author: Thien-Thi Nguyen Date: Mon May 21 16:57:49 2018 +0200 Ensure pcase doc shows `QPAT first among extensions * lisp/emacs-lisp/pcase.el (pcase--make-docstring): Split extensions display into two phases, collection and display, separated by a reordering step that ensures backquote is the first. diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index ce148c9e1a..6e8f08e699 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -199,15 +199,30 @@ Emacs Lisp manual for more information and examples." (require 'help-fns) (with-temp-buffer (insert (or (cdr ud) main)) - (mapatoms - (lambda (symbol) - (let ((me (get symbol 'pcase-macroexpander))) - (when me - (insert "\n\n-- ") - (let* ((doc (documentation me 'raw))) - (setq doc (help-fns--signature symbol doc me - (indirect-function me) nil)) - (insert "\n" (or doc "Not documented."))))))) + ;; Presentation Note: For conceptual continuity, we guarantee + ;; that backquote doc immediately follows main pcase doc. + ;; (The order of the other extensions is unimportant.) + (let (more) + ;; Collect all the extensions. + (mapatoms (lambda (symbol) + (let ((me (get symbol 'pcase-macroexpander))) + (when me + (push (cons symbol me) + more))))) + ;; Ensure backquote is first. + (let ((x (assq '\` more))) + (setq more (cons x (delq x more)))) + ;; Do the output. + (while more + (let* ((pair (pop more)) + (symbol (car pair)) + (me (cdr pair)) + (doc (documentation me 'raw))) + (insert "\n\n-- ") + (setq doc (help-fns--signature symbol doc me + (indirect-function me) + nil)) + (insert "\n" (or doc "Not documented."))))) (let ((combined-doc (buffer-string))) (if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc)))))