commit 46304c474c433a98ad55198e1fbdb0b1136645c1 (HEAD, refs/remotes/origin/master) Author: Michael Albinus Date: Mon Jun 8 10:18:35 2020 +0200 Add autoload problem in tramp-crypt.el. * lisp/net/tramp-crypt.el (tramp-crypt-encfs-config): Add ;;;###tramp-autoload cookie. (tramp-crypt-directories): Move it up. (tramp-crypt-file-name-p): Move it up. Add ;;;###tramp-autoload cookie. Make it a defsubst. * test/lisp/net/tramp-tests.el (tramp-crypt): Do not require. diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 1df38c3121..220a4add91 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -114,6 +114,7 @@ initializing a new crypted remote directory." "Non-nil when encryption support is available.") (setq tramp-crypt-enabled (executable-find tramp-crypt-encfs-program)) +;;;###tramp-autoload (defconst tramp-crypt-encfs-config ".encfs6.xml" "Encfs configuration file name.") @@ -123,6 +124,25 @@ initializing a new crypted remote directory." :version "28.1" :type 'booleanp) +;;;###tramp-autoload +(defvar tramp-crypt-directories nil + "List of crypted remote directories.") + +;; It must be a `defsubst' in order to push the whole code into +;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading. +;;;###tramp-autoload +(defsubst tramp-crypt-file-name-p (name) + "Return the crypted remote directory NAME belongs to. +If NAME doesn't belong to a crypted remote directory, retun nil." + (catch 'crypt-file-name-p + (and tramp-crypt-enabled (stringp name) + (not (tramp-compat-file-name-quoted-p name)) + (not (string-suffix-p tramp-crypt-encfs-config name)) + (dolist (dir tramp-crypt-directories) + (and (string-prefix-p + dir (file-name-as-directory (expand-file-name name))) + (throw 'crypt-file-name-p dir)))))) + ;; New handlers should be added here. ;;;###tramp-autoload @@ -249,22 +269,6 @@ arguments to pass to the OPERATION." ;; File name conversions. -;;;###tramp-autoload -(defvar tramp-crypt-directories nil - "List of crypted remote directories.") - -(defun tramp-crypt-file-name-p (name) - "Return the crypted remote directory NAME belongs to. -If NAME doesn't belong to a crypted remote directory, retun nil." - (catch 'crypt-file-name-p - (and tramp-crypt-enabled (stringp name) - (not (tramp-compat-file-name-quoted-p name)) - (not (string-suffix-p tramp-crypt-encfs-config name)) - (dolist (dir tramp-crypt-directories) - (and (string-prefix-p - dir (file-name-as-directory (expand-file-name name))) - (throw 'crypt-file-name-p dir)))))) - (defun tramp-crypt-config-file-name (vec) "Return the encfs config file name for VEC." (expand-file-name diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 25faf4e0fb..7faa409f2f 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -5595,8 +5595,6 @@ This does not support some special file names." (string-equal "docker" (file-remote-p tramp-test-temporary-file-directory 'method))) -(require 'tramp-crypt) - (defun tramp--test-crypt-p () "Check, whether the remote directory is crypted" (tramp-crypt-file-name-p tramp-test-temporary-file-directory)) commit 80abaea1d9c6f1e53fe88befe16de3b219cdd919 Author: Stefan Kangas Date: Sun Jun 7 19:57:45 2020 +0200 Use lexical-binding in lunar.el and add tests * lisp/calendar/lunar.el: Use lexical-binding. (lunar-phases, diary-lunar-phases): Silence byte-compiler. * test/lisp/calendar/lunar-tests.el: New file. diff --git a/lisp/calendar/lunar.el b/lisp/calendar/lunar.el index 3d5a0a236b..1c0f4da0f4 100644 --- a/lisp/calendar/lunar.el +++ b/lisp/calendar/lunar.el @@ -1,4 +1,4 @@ -;;; lunar.el --- calendar functions for phases of the moon +;;; lunar.el --- calendar functions for phases of the moon -*- lexical-binding:t -*- ;; Copyright (C) 1992-1993, 1995, 1997, 2001-2020 Free Software ;; Foundation, Inc. @@ -255,6 +255,8 @@ use instead of point." If called with an optional prefix argument ARG, prompts for month and year. This function is suitable for execution in an init file." (interactive "P") + (with-suppressed-warnings ((lexical date)) + (defvar date)) (save-excursion (let* ((date (if arg (calendar-read-date t) (calendar-current-date))) @@ -262,18 +264,17 @@ This function is suitable for execution in an init file." (displayed-year (calendar-extract-year date))) (calendar-lunar-phases)))) -;; The function below is designed to be used in sexp diary entries, -;; and may be present in users' diary files, so suppress the warning -;; about this prefix-less dynamic variable. It's called from -;; `diary-list-sexp-entries', which binds the variable. -(with-suppressed-warnings ((lexical date)) - (defvar date)) - ;;;###diary-autoload (defun diary-lunar-phases (&optional mark) "Moon phases diary entry. An optional parameter MARK specifies a face or single-character string to use when highlighting the day in the calendar." + ;; This function is designed to be used in sexp diary entries, and + ;; may be present in users' diary files, so suppress the warning + ;; about this prefix-less dynamic variable. It's called from + ;; `diary-list-sexp-entries', which binds the variable. + (with-suppressed-warnings ((lexical date)) + (defvar date)) (let* ((index (lunar-index date)) (phase (lunar-phase index))) (while (calendar-date-compare phase (list date)) diff --git a/test/lisp/calendar/lunar-tests.el b/test/lisp/calendar/lunar-tests.el new file mode 100644 index 0000000000..8d8a988e50 --- /dev/null +++ b/test/lisp/calendar/lunar-tests.el @@ -0,0 +1,70 @@ +;;; lunar-tests.el --- tests for calendar/lunar.el -*- lexical-binding:t -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; Author: Stefan Kangas + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert) +(require 'lunar) + +(defmacro with-lunar-test (&rest body) + `(let ((calendar-latitude 40.1) + (calendar-longitude -88.2) + (calendar-location-name "Urbana, IL") + (calendar-time-zone -360) + (calendar-standard-time-zone-name "CST") + (calendar-time-display-form '(12-hours ":" minutes am-pm))) + ,@body)) + +(ert-deftest lunar-test-phase () + (with-lunar-test + (should (equal (lunar-phase 1) + '((1 7 1900) "11:40pm" 1 ""))))) + +(ert-deftest lunar-test-eclipse-check () + (with-lunar-test + (should (equal (eclipse-check 1 1) "** Eclipse **")))) + +(ert-deftest lunar-test-phase-list () + (with-lunar-test + (should (equal (lunar-phase-list 3 1871) + '(((3 20 1871) "11:03pm" 0 "") + ((3 29 1871) "1:46am" 1 "** Eclipse **") + ((4 5 1871) "9:20am" 2 "") + ((4 12 1871) "12:57am" 3 "** Eclipse possible **") + ((4 19 1871) "2:06pm" 0 "") + ((4 27 1871) "6:49pm" 1 "") + ((5 4 1871) "5:57pm" 2 "") + ((5 11 1871) "9:29am" 3 "") + ((5 19 1871) "5:46am" 0 "") + ((5 27 1871) "8:02am" 1 "")))))) + +(ert-deftest lunar-test-new-moon-time () + (with-lunar-test + (should (= (round (lunar-new-moon-time 1)) + 2451580)))) + +(ert-deftest lunar-test-new-moon-on-or-after () + (with-lunar-test + (should (= (round (lunar-new-moon-on-or-after (calendar-absolute-from-gregorian '(5 5 1818)))) + 664525)))) + +(provide 'lunar-tests) +;;; lunar-tests.el ends here commit 53fba73ff2599d2e5f06927d474311dc987a4c4d Author: Andrea Corallo Date: Sun Jun 7 15:09:38 2020 +0200 * lisp/emacs-lisp/byte-opt.el (side-effect-free-fns): Add `make-byte-code'. `make-byte-code' wraps `vector' doing some sanity check on the input arguments. `vector' is in side-effect-and-error-free-fns so add `make-byte-code' to side-effect-free-fns. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 62b82e4f32..12bde8faf3 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1219,8 +1219,8 @@ length line-beginning-position line-end-position local-variable-if-set-p local-variable-p locale-info log log10 logand logb logcount logior lognot logxor lsh - make-list make-string make-symbol marker-buffer max member memq min - minibuffer-selected-window minibuffer-window + make-byte-code make-list make-string make-symbol marker-buffer max + member memq min minibuffer-selected-window minibuffer-window mod multibyte-char-to-unibyte next-window nth nthcdr number-to-string parse-colon-path plist-get plist-member prefix-numeric-value previous-window prin1-to-string propertize commit e42e98ec0b90c36c43ac7ff99a2548bc8b746197 Author: Glenn Morris Date: Sun Jun 7 10:37:29 2020 -0700 * test/lisp/net/tramp-tests.el: tramp-crypt-file-name-p not autoloaded. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 7faa409f2f..25faf4e0fb 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -5595,6 +5595,8 @@ This does not support some special file names." (string-equal "docker" (file-remote-p tramp-test-temporary-file-directory 'method))) +(require 'tramp-crypt) + (defun tramp--test-crypt-p () "Check, whether the remote directory is crypted" (tramp-crypt-file-name-p tramp-test-temporary-file-directory)) commit fa6d56529f9ebaedaf62ecbf8887ffecca7dce12 Merge: 6cb557e7a5 35661ef943 Author: Glenn Morris Date: Sun Jun 7 09:03:59 2020 -0700 Merge from origin/emacs-27 35661ef943 (origin/emacs-27) Fix typo in "(elisp) Type Keywords" 1af0e95fec Gnus nnir-summary-line-format has no effect dd366b5d3b Improve documentation of 'window-text-pixel-size' fbd49f969e * src/xdisp.c (Fwindow_text_pixel_size): Doc fix. (Bug#41... d8593fd19f Minor improvements to EDE and EIEIO manuals 3916e63f9e Have Fido mode also imitate Ido mode in ignore-case options cc35b197c7 Update package-menu-quick-help bf09106256 Improve documentation of 'sort-subr' 73749efa13 Update Ukrainian transliteration 30a7ee505a Fix Arabic shaping when eww/shr fill the text to be rendered 7d323f07c0 Silence some byte-compiler warnings in tests cf473e742f * test/lisp/battery-tests.el: New file. b07e3b1d97 Improve format-spec documentation (bug#41571) # Conflicts: # test/lisp/emacs-lisp/package-tests.el commit 35661ef943d261f6c43e93e475ddd8516f4a4b62 Author: Basil L. Contovounesios Date: Sun Jun 7 16:46:12 2020 +0100 Fix typo in "(elisp) Type Keywords" * doc/lispref/customize.texi (Type Keywords): Fix typo of 'choice' composite type. (Bug#41749) diff --git a/doc/lispref/customize.texi b/doc/lispref/customize.texi index 172809b29d..2a72276bc5 100644 --- a/doc/lispref/customize.texi +++ b/doc/lispref/customize.texi @@ -1156,7 +1156,7 @@ in that value. The usual reason to specify a documentation string for a type is to provide more information about the meanings of alternatives inside a -@code{:choice} type or the parts of some other composite type. +@code{choice} type or the parts of some other composite type. @item :help-echo @var{motion-doc} @kindex help-echo@r{, customization keyword} commit 6cb557e7a58d7f1c2e9afceeba45d0ced2aff214 Author: Alan Mackenzie Date: Sun Jun 7 15:14:15 2020 +0000 * lisp/progmodes/js.el (js-mode): Remove second call to c-init-language-vars This spurious second call fouled up already set configuration variables. Fixes bug #41649. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 5ec3e94275..04b449ecd2 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -4591,7 +4591,6 @@ This function is intended for use in `after-change-functions'." (setq imenu-create-index-function #'js--imenu-create-index) ;; for filling, pretend we're cc-mode - (c-init-language-vars js-mode) (setq-local comment-line-break-function #'c-indent-new-comment-line) (setq-local comment-multi-line t) (setq-local electric-indent-chars commit a6b0e7202d5ea747d99731e1228badcead80eee6 Author: Michael Albinus Date: Sun Jun 7 16:57:32 2020 +0200 Add file encryption to Tramp * lisp/net/tramp-crypt.el: New file. * lisp/net/tramp.el (tramp-run-real-handler): Add `tramp-crypt-file-name-handler'. (tramp-register-file-name-handlers): Call `tramp-register-crypt-file-name-handler'. (tramp-handle-insert-file-contents, tramp-local-host-p): Check for `tramp-crypt-enabled' * test/lisp/net/tramp-tests.el (tramp--test-crypt-p): New defun. (tramp-test24-file-acl, tramp-test25-file-selinux) (tramp-test28-process-file, tramp-test29-start-file-process) (tramp-test30-make-process, tramp-test31-interrupt-process) (tramp-test32-shell-command) (tramp-test32-shell-command-dont-erase-buffer) (tramp-test33-environment-variables) (tramp-test33-environment-variables-and-port-numbers) (tramp-test34-explicit-shell-file-name, tramp-test35-exec-path) (tramp-test35-remote-path, tramp-test36-vc-registered) (tramp--test-check-files, tramp-test43-asynchronous-requests): Use it. diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el new file mode 100644 index 0000000000..1df38c3121 --- /dev/null +++ b/lisp/net/tramp-crypt.el @@ -0,0 +1,730 @@ +;;; tramp-crypt.el --- Tramp crypt utilities -*- lexical-binding:t -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; Author: Michael Albinus +;; Keywords: comm, processes +;; Package: tramp + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; Access functions for crypted remote files. It uses encfs to +;; encrypt/ decrypt the files on a remote directory. A remote +;; directory, which shall include crypted files, must be declared in +;; `tramp-crypt-directories' via command `tramp-crypt-add-directory'. +;; All files in that directory, including all subdirectories, are +;; stored there encrypted. This includes file names and directory +;; names. + +;; This package is just responsible for the encryption part. Copying +;; of the crypted files is still the responsibility of the remote file +;; name handlers. + +;; A password protected encfs configuration file is created the very +;; first time you access a crypted remote directory. It is kept in +;; your user directory "~/.emacs.d/" with the url-encoded directory +;; name as part of the basename, and ".encfs6.xml" as suffix. Do not +;; loose this file and the corresponding password; otherwise there is +;; no way to decrypt your crypted files. + +;; If the user option `tramp-crypt-save-encfs-config-remote' is +;; non-nil (the default), the encfs configuration file ".encfs6.xml" +;; is also be kept in the crypted remote directory. It depends, +;; whether you regard the password protection of this file as +;; sufficient. + +;; If you apply an operation with a quoted localname part, this +;; localname and the corresponding file will not be encrypted/ +;; decrypted. For example, if you have a crypted remote directory +;; "/nextcloud:user@host:/crypted_dir", the command +;; +;; C-x d /nextcloud:user@host:/crypted_dir +;; +;; will show the directory listing with the plain file names, and the +;; command +;; +;; C-x d /nextcloud:user@host:/:/crypted_dir +;; +;; will show the directory with the encrypted file names, and visiting +;; a file will show its crypted contents. However, it is highly +;; discouraged to mix crypted and not crypted files in the same +;; directory. + +;; If a remote directory shall not include crypted files anymore, it +;; must be indicated by the command `tramp-crypt-remove-directory'. +;; Existing crypted files will be transformed into their unencrypted +;; file names and contents. + +;;; Code: + +(eval-when-compile (require 'cl-lib)) +(require 'tramp) + +(autoload 'prop-match-beginning "text-property-search") +(autoload 'prop-match-end "text-property-search") +(autoload 'text-property-search-forward "text-property-search") + +(defconst tramp-crypt-method "crypt" + "Method name for crypted remote directories.") + +(defcustom tramp-crypt-encfs-program "encfs" + "Name of the encfs program." + :group 'tramp + :version "28.1" + :type 'string) + +(defcustom tramp-crypt-encfsctl-program "encfsctl" + "Name of the encfsctl program." + :group 'tramp + :version "28.1" + :type 'string) + +(defcustom tramp-crypt-encfs-option "--standard" + "Configuration option for encfs. +This could be either \"--standard\" or \"--paranoia\". The file +name IV chaining mode mode will always be disabled when +initializing a new crypted remote directory." + :group 'tramp + :version "28.1" + :type '(choice (const "--standard") + (const "--paranoia"))) + +;; We check only for encfs, assuming that encfsctl will be available +;; as well. The autoloaded value is nil, the check will run when +;; tramp-crypt.el is loaded by `tramp-crypt-add-directory'. It is a +;; common technique to let-bind this variable to nil in order to +;; suppress the file name operation of this package. +;;;###tramp-autoload +(defvar tramp-crypt-enabled nil + "Non-nil when encryption support is available.") +(setq tramp-crypt-enabled (executable-find tramp-crypt-encfs-program)) + +(defconst tramp-crypt-encfs-config ".encfs6.xml" + "Encfs configuration file name.") + +(defcustom tramp-crypt-save-encfs-config-remote t + "Whether to keep the encfs configuration file in the crypted remote directory." + :group 'tramp + :version "28.1" + :type 'booleanp) + + +;; New handlers should be added here. +;;;###tramp-autoload +(defconst tramp-crypt-file-name-handler-alist + '(;; (access-file . tramp-crypt-handle-access-file) + ;; (add-name-to-file . tramp-crypt-handle-not-implemented) + ;; `byte-compiler-base-file-name' performed by default handler. + (copy-directory . tramp-handle-copy-directory) + (copy-file . tramp-crypt-handle-copy-file) + (delete-directory . tramp-crypt-handle-delete-directory) + (delete-file . tramp-crypt-handle-delete-file) + ;; `diff-latest-backup-file' performed by default handler. + ;; `directory-file-name' performed by default handler. + (directory-files . tramp-crypt-handle-directory-files) + (directory-files-and-attributes + . tramp-handle-directory-files-and-attributes) + (dired-compress-file . ignore) + ;; (dired-uncache . tramp-crypt-handle-dired-uncache) + (exec-path . ignore) + ;; `expand-file-name' performed by default handler. + (file-accessible-directory-p . tramp-handle-file-accessible-directory-p) + (file-acl . ignore) + (file-attributes . tramp-crypt-handle-file-attributes) + (file-directory-p . tramp-handle-file-directory-p) + (file-equal-p . tramp-handle-file-equal-p) + (file-executable-p . tramp-crypt-handle-file-executable-p) + (file-exists-p . tramp-handle-file-exists-p) + (file-in-directory-p . tramp-handle-file-in-directory-p) + (file-local-copy . tramp-handle-file-local-copy) + (file-modes . tramp-handle-file-modes) + ;; (file-name-all-completions . tramp-crypt-handle-file-name-all-completions) + ;; `file-name-as-directory' performed by default handler. + ;; (file-name-case-insensitive-p . ignore) + ;; (file-name-completion . tramp-handle-file-name-completion) + ;; `file-name-directory' performed by default handler. + ;; `file-name-nondirectory' performed by default handler. + ;; `file-name-sans-versions' performed by default handler. + (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) + (file-notify-add-watch . ignore) + (file-notify-rm-watch . ignore) + (file-notify-valid-p . ignore) + ;; (file-ownership-preserved-p . ignore) + (file-readable-p . tramp-crypt-handle-file-readable-p) + (file-regular-p . tramp-handle-file-regular-p) + ;; `file-remote-p' performed by default handler. + (file-selinux-context . ignore) + (file-symlink-p . tramp-handle-file-symlink-p) + (file-system-info . tramp-crypt-handle-file-system-info) + ;; (file-truename . tramp-crypt-handle-file-truename) + ;; (file-writable-p . ignore) + (find-backup-file-name . ignore) + ;; `get-file-buffer' performed by default handler. + (insert-directory . tramp-crypt-handle-insert-directory) + ;; `insert-file-contents' performed by default handler. + ;; (load . tramp-crypt-handle-load) + (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) + (make-directory . tramp-crypt-handle-make-directory) + ;; (make-directory-internal . tramp-crypt-handle-not-implemented) + ;; (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) + (make-process . ignore) + (make-symbolic-link . tramp-handle-make-symbolic-link) + (process-file . ignore) + (rename-file . tramp-crypt-handle-rename-file) + (set-file-acl . ignore) + (set-file-modes . tramp-crypt-handle-set-file-modes) + (set-file-selinux-context . ignore) + ;; (set-file-times . tramp-crypt-handle-not-implemented) + ;; (set-visited-file-modtime . tramp-handle-set-visited-file-modtime) + (shell-command . ignore) + (start-file-process . ignore) + ;; `substitute-in-file-name' performed by default handler. + ;; (temporary-file-directory . tramp-crypt-handle-temporary-file-directory) + ;; `tramp-set-file-uid-gid' performed by default handler. + ;; (unhandled-file-name-directory . ignore) + (vc-registered . ignore) + ;; (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) + (write-region . tramp-handle-write-region)) + "Alist of handler functions for crypt method. +Operations not mentioned here will be handled by the default Emacs primitives.") + +(defsubst tramp-crypt-file-name-for-operation (operation &rest args) + "Like `tramp-file-name-for-operation', but for crypted remote files." + (cl-letf (((symbol-function #'tramp-tramp-file-p) + #'tramp-crypt-file-name-p)) + (apply #'tramp-file-name-for-operation operation args))) + +(defun tramp-crypt-run-real-handler (operation args) + "Invoke normal file name handler for OPERATION. +First arg specifies the OPERATION, second arg ARGS is a list of +arguments to pass to the OPERATION." + (let* ((inhibit-file-name-handlers + `(tramp-crypt-file-name-handler + . + ,(and (eq inhibit-file-name-operation operation) + inhibit-file-name-handlers))) + (inhibit-file-name-operation operation)) + (apply operation args))) + +;;;###tramp-autoload +(defun tramp-crypt-file-name-handler (operation &rest args) + "Invoke the crypted remote file related OPERATION. +First arg specifies the OPERATION, second arg ARGS is a list of +arguments to pass to the OPERATION." + (if-let ((filename (apply #'tramp-file-name-for-operation operation args)) + (fn (and (tramp-crypt-file-name-p filename) + (assoc operation tramp-crypt-file-name-handler-alist)))) + (save-match-data (apply (cdr fn) args)) + (tramp-crypt-run-real-handler operation args))) + +;;;###tramp-autoload +(progn (defun tramp-register-crypt-file-name-handler () + "Add crypt file name handler to `file-name-handler-alist'." + (when (and tramp-crypt-enabled tramp-crypt-directories) + (add-to-list 'file-name-handler-alist + (cons tramp-file-name-regexp #'tramp-crypt-file-name-handler)) + (put #'tramp-crypt-file-name-handler 'safe-magic t)))) + +(tramp-register-file-name-handlers) + +;; Mark `operations' the handler is responsible for. +(put #'tramp-crypt-file-name-handler 'operations + (mapcar #'car tramp-crypt-file-name-handler-alist)) + + +;; File name conversions. + +;;;###tramp-autoload +(defvar tramp-crypt-directories nil + "List of crypted remote directories.") + +(defun tramp-crypt-file-name-p (name) + "Return the crypted remote directory NAME belongs to. +If NAME doesn't belong to a crypted remote directory, retun nil." + (catch 'crypt-file-name-p + (and tramp-crypt-enabled (stringp name) + (not (tramp-compat-file-name-quoted-p name)) + (not (string-suffix-p tramp-crypt-encfs-config name)) + (dolist (dir tramp-crypt-directories) + (and (string-prefix-p + dir (file-name-as-directory (expand-file-name name))) + (throw 'crypt-file-name-p dir)))))) + +(defun tramp-crypt-config-file-name (vec) + "Return the encfs config file name for VEC." + (expand-file-name + (concat "tramp-" (tramp-file-name-host vec) tramp-crypt-encfs-config) + user-emacs-directory)) + +(defun tramp-crypt-maybe-open-connection (vec) + "Maybe open a connection VEC. +Does not do anything if a connection is already open, but re-opens the +connection if a previous connection has died for some reason." + ;; For password handling, we need a process bound to the connection + ;; buffer. Therefore, we create a dummy process. Maybe there is a + ;; better solution? + (unless (get-buffer-process (tramp-get-connection-buffer vec)) + (let ((p (make-network-process + :name (tramp-get-connection-name vec) + :buffer (tramp-get-connection-buffer vec) + :server t :host 'local :service t :noquery t))) + (process-put p 'vector vec) + (set-process-query-on-exit-flag p nil))) + + ;; The following operations must be performed w/o + ;; `tramp-crypt-file-name-handler'. + (let* (tramp-crypt-enabled + ;; Don't check for a proper method. + (non-essential t) + (remote-config + (expand-file-name + tramp-crypt-encfs-config (tramp-crypt-get-remote-dir vec))) + (local-config (tramp-crypt-config-file-name vec))) + ;; There is no local encfs6 config file. + (when (not (file-exists-p local-config)) + (if (and tramp-crypt-save-encfs-config-remote + (file-exists-p remote-config)) + ;; Copy remote encfs6 config file if possible. + (copy-file remote-config local-config 'ok 'keep) + + ;; Create local encfs6 config file otherwise. + (let* ((default-directory (tramp-compat-temporary-file-directory)) + (tmpdir1 (file-name-as-directory + (tramp-compat-make-temp-file " .crypt" 'dir-flag))) + (tmpdir2 (file-name-as-directory + (tramp-compat-make-temp-file " .nocrypt" 'dir-flag)))) + ;; Enable `auth-source', unless "emacs -Q" has been called. + (tramp-set-connection-property + vec "first-password-request" tramp-cache-read-persistent-data) + (with-temp-buffer + (insert + (tramp-read-passwd + (tramp-get-connection-process vec) + (format + "New EncFS Password for %s " (tramp-crypt-get-remote-dir vec)))) + (when + (zerop + (tramp-call-process-region + vec (point-min) (point-max) + tramp-crypt-encfs-program nil (tramp-get-connection-buffer vec) + nil tramp-crypt-encfs-option "--extpass=cat" tmpdir1 tmpdir2)) + ;; Save the password. + (ignore-errors + (and (functionp tramp-password-save-function) + (funcall tramp-password-save-function))))) + + ;; Write local config file. Suppress file name IV chaining mode. + (with-temp-file local-config + (insert-file-contents + (expand-file-name tramp-crypt-encfs-config tmpdir1)) + (goto-char (point-min)) + (when (search-forward + "1" nil 'noerror) + (replace-match "0"))) + + ;; Unmount encfs. Delete temporary directories. + (tramp-call-process + vec tramp-crypt-encfs-program nil nil nil + "--unmount" tmpdir1 tmpdir2) + (delete-directory tmpdir1 'recursive) + (delete-directory tmpdir2) + + ;; Copy local encfs6 config file to remote. + (when tramp-crypt-save-encfs-config-remote + (copy-file local-config remote-config 'ok 'keep))))))) + +(defun tramp-crypt-send-command (vec &rest args) + "Send encfsctl command to connection VEC. +ARGS are the arguments." + (tramp-crypt-maybe-open-connection vec) + (with-current-buffer (tramp-get-connection-buffer vec) + (erase-buffer)) + (with-temp-buffer + (let* (;; Don't check for a proper method. + (non-essential t) + (default-directory (tramp-compat-temporary-file-directory)) + ;; We cannot add it to `process-environment', because + ;; `tramp-call-process-region' doesn't use it. + (encfs-config + (format "ENCFS6_CONFIG=%s" (tramp-crypt-config-file-name vec))) + (args (delq nil args))) + ;; Enable `auth-source', unless "emacs -Q" has been called. + (tramp-set-connection-property + vec "first-password-request" tramp-cache-read-persistent-data) + (insert + (tramp-read-passwd + (tramp-get-connection-process vec) + (format "EncFS Password for %s " (tramp-crypt-get-remote-dir vec)))) + (when (zerop + (apply + #'tramp-call-process-region vec (point-min) (point-max) + "env" nil (tramp-get-connection-buffer vec) + nil encfs-config tramp-crypt-encfsctl-program + (car args) "--extpass=cat" (cdr args))) + ;; Save the password. + (ignore-errors + (and (functionp tramp-password-save-function) + (funcall tramp-password-save-function))))))) + +(defun tramp-crypt-do-encrypt-or-decrypt-file-name (op name) + "Return encrypted/ decrypted NAME if NAME belongs to a crypted directory. +OP must be `encrypt' or `decrypt'. +Otherwise, return NAME." + (if-let ((tramp-crypt-enabled t) + (dir (tramp-crypt-file-name-p name)) + ;; It must be absolute for the cache. + (localname (substring name (1- (length dir)))) + (crypt-vec (tramp-crypt-dissect-file-name dir))) + ;; Preserve trailing "/". + (funcall + (if (directory-name-p name) #'file-name-as-directory #'identity) + (concat + dir + (unless (string-equal localname "/") + (with-tramp-file-property + crypt-vec localname (concat (symbol-name op) "-file-name") + (tramp-crypt-send-command + crypt-vec (if (eq op 'encrypt) "encode" "decode") + (tramp-compat-temporary-file-directory) localname) + (with-current-buffer (tramp-get-connection-buffer crypt-vec) + (goto-char (point-min)) + (buffer-substring (point-min) (point-at-eol))))))) + ;; Nothing to do. + name)) + +(defsubst tramp-crypt-encrypt-file-name (name) + "Return encrypted NAME if NAME belongs to a crypted directory. +Otherwise, return NAME." + (tramp-crypt-do-encrypt-or-decrypt-file-name 'encrypt name)) + +(defsubst tramp-crypt-decrypt-file-name (name) + "Return decrypted NAME if NAME belongs to a crypted directory. +Otherwise, return NAME." + (tramp-crypt-do-encrypt-or-decrypt-file-name 'decrypt name)) + +(defun tramp-crypt-do-encrypt-or-decrypt-file (op root infile outfile) + "Encrypt/ decrypt file INFILE to OUTFILE according to crypted directory ROOT. +Both files must be local files. OP must be `encrypt' or `decrypt'. +If OP ist `decrypt', the basename of INFILE must be an encrypted file name." + (when-let ((tramp-crypt-enabled t) + (dir (tramp-crypt-file-name-p root)) + (crypt-vec (tramp-crypt-dissect-file-name dir))) + (let ((coding-system-for-read + (if (eq op 'decrypt) 'raw-text coding-system-for-read)) + (coding-system-for-write + (if (eq op 'encrypt) 'raw-text coding-system-for-write))) + (tramp-crypt-send-command + crypt-vec "cat" (and (eq op 'encrypt) "--reverse") + (file-name-directory infile) (file-name-nondirectory infile)) + (with-current-buffer (tramp-get-connection-buffer crypt-vec) + (write-region nil nil outfile))))) + +(defsubst tramp-crypt-encrypt-file (root infile outfile) + "Encrypt file INFILE to OUTFILE according to crypted directory ROOT. +See `tramp-crypt-do-encrypt-or-decrypt-file'." + (tramp-crypt-do-encrypt-or-decrypt-file 'encrypt root infile outfile)) + +(defsubst tramp-crypt-decrypt-file (root infile outfile) + "Decrypt file INFILE to OUTFILE according to crypted directory ROOT. +See `tramp-crypt-do-encrypt-or-decrypt-file'." + (tramp-crypt-do-encrypt-or-decrypt-file 'decrypt root infile outfile)) + +;;;###tramp-autoload +(defun tramp-crypt-add-directory (name) + "Mark remote directory NAME for encryption. +Files in that directory and all subdirectories will be encrypted +bofore copying to, and decrypted after copying from that +directory. File names will be also encrypted." + (interactive "DRemote directory name: ") + (unless tramp-crypt-enabled + (tramp-user-error nil "Feature is not enabled.")) + (unless (and (tramp-tramp-file-p name) (file-directory-p name)) + (tramp-user-error nil "%s must be an existing remote directory." name)) + (setq name (file-name-as-directory name)) + (unless (member name tramp-crypt-directories) + (setq tramp-crypt-directories `(,name . ,tramp-crypt-directories))) + (tramp-register-file-name-handlers)) + +;; `auth-source' requires a user. +(defun tramp-crypt-dissect-file-name (name) + "Return a `tramp-file-name' structure for NAME. +The structure consists of the `tramp-crypt-method' method, the +local user name, the hexlified directory NAME as host, and the +localname." + (save-match-data + (if-let ((dir (tramp-crypt-file-name-p name))) + (make-tramp-file-name + :method tramp-crypt-method :user (user-login-name) + :host (url-hexify-string dir)) + (tramp-user-error nil "Not a crypted remote directory: \"%s\"" name)))) + +(defun tramp-crypt-get-remote-dir (vec) + "Return the name of the crypted remote directory to be used for encfs." + (url-unhex-string (tramp-file-name-host vec))) + + +;; File name primitives. + +(defun tramp-crypt-do-copy-or-rename-file + (op filename newname &optional ok-if-already-exists keep-date + preserve-uid-gid preserve-extended-attributes) + "Copy or rename a remote file. +OP must be `copy' or `rename' and indicates the operation to perform. +FILENAME specifies the file to copy or rename, NEWNAME is the name of +the new file (for copy) or the new name of the file (for rename). +OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already. +KEEP-DATE means to make sure that NEWNAME has the same timestamp +as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep +the uid and gid if both files are on the same host. +PRESERVE-EXTENDED-ATTRIBUTES is ignored. + +This function is invoked by `tramp-crypt-handle-copy-file' and +`tramp-crypt-handle-rename-file'. It is an error if OP is +neither of `copy' and `rename'. FILENAME and NEWNAME must be +absolute file names." + (unless (memq op '(copy rename)) + (error "Unknown operation `%s', must be `copy' or `rename'" op)) + + (setq filename (file-truename filename)) + (if (file-directory-p filename) + (progn + (copy-directory filename newname keep-date t) + (when (eq op 'rename) (delete-directory filename 'recursive))) + + (let ((t1 (tramp-crypt-file-name-p filename)) + (t2 (tramp-crypt-file-name-p newname)) + (encrypt-filename (tramp-crypt-encrypt-file-name filename)) + (encrypt-newname (tramp-crypt-encrypt-file-name newname)) + (msg-operation (if (eq op 'copy) "Copying" "Renaming"))) + + (with-parsed-tramp-file-name (if t1 filename newname) nil + (unless (file-exists-p filename) + (tramp-error + v tramp-file-missing + "%s file" msg-operation "No such file or directory" filename)) + (when (and (not ok-if-already-exists) (file-exists-p newname)) + (tramp-error v 'file-already-exists newname)) + (when (and (file-directory-p newname) + (not (directory-name-p newname))) + (tramp-error v 'file-error "File is a directory %s" newname)) + + (with-tramp-progress-reporter + v 0 (format "%s %s to %s" msg-operation filename newname) + (if (and t1 t2 (string-equal t1 t2)) + ;; Both files are on the same crypted remote directory. + (let (tramp-crypt-enabled) + (if (eq op 'copy) + (copy-file + encrypt-filename encrypt-newname ok-if-already-exists + keep-date preserve-uid-gid preserve-extended-attributes) + (rename-file + encrypt-filename encrypt-newname ok-if-already-exists))) + + (let* ((tmpdir (tramp-compat-make-temp-file filename 'dir)) + (tmpfile1 + (expand-file-name + (file-name-nondirectory encrypt-filename) tmpdir)) + (tmpfile2 + (expand-file-name + (file-name-nondirectory encrypt-newname) tmpdir)) + tramp-crypt-enabled) + (cond + ;; Source file is on a crypted remote directory. + (t1 + (if (eq op 'copy) + (copy-file + encrypt-filename tmpfile1 t keep-date preserve-uid-gid + preserve-extended-attributes) + (rename-file encrypt-filename tmpfile1 t)) + (tramp-crypt-decrypt-file t1 tmpfile1 tmpfile2) + (rename-file tmpfile2 newname ok-if-already-exists)) + ;; Target file is on a crypted remote directory. + (t2 + (if (eq op 'copy) + (copy-file + filename tmpfile1 t keep-date preserve-uid-gid + preserve-extended-attributes) + (rename-file filename tmpfile1 t)) + (tramp-crypt-encrypt-file t2 tmpfile1 tmpfile2) + (rename-file tmpfile2 encrypt-newname ok-if-already-exists))) + (delete-directory tmpdir 'recursive))) + + (when (and t1 (eq op 'rename)) + (with-parsed-tramp-file-name filename v1 + (tramp-flush-file-properties v1 v1-localname))) + + (when t2 + (with-parsed-tramp-file-name newname v2 + (tramp-flush-file-properties v2 v2-localname)))))))) + +(defun tramp-crypt-handle-copy-file + (filename newname &optional ok-if-already-exists keep-date + preserve-uid-gid preserve-extended-attributes) + "Like `copy-file' for Tramp files." + (setq filename (expand-file-name filename) + newname (expand-file-name newname)) + ;; At least one file a Tramp file? + (if (or (tramp-tramp-file-p filename) + (tramp-tramp-file-p newname)) + (tramp-crypt-do-copy-or-rename-file + 'copy filename newname ok-if-already-exists keep-date + preserve-uid-gid preserve-extended-attributes) + (tramp-run-real-handler + #'copy-file + (list filename newname ok-if-already-exists keep-date + preserve-uid-gid preserve-extended-attributes)))) + +(defun tramp-crypt-handle-delete-directory + (directory &optional recursive trash) + "Like `delete-directory' for Tramp files." + (with-parsed-tramp-file-name (expand-file-name directory) nil + (tramp-flush-directory-properties v localname) + (let (tramp-crypt-enabled) + (delete-directory + (tramp-crypt-encrypt-file-name directory) recursive trash)))) + +(defun tramp-crypt-handle-delete-file (filename &optional trash) + "Like `delete-file' for Tramp files." + (with-parsed-tramp-file-name (expand-file-name filename) nil + (tramp-flush-file-properties v localname) + (tramp-crypt-run-real-handler + #'delete-file (list (tramp-crypt-encrypt-file-name filename) trash)))) + +(defun tramp-crypt-handle-directory-files (directory &optional full match nosort) + "Like `directory-files' for Tramp files." + (unless (file-exists-p directory) + (tramp-error + (tramp-dissect-file-name directory) tramp-file-missing + "No such file or directory" directory)) + (when (file-directory-p directory) + (setq directory (file-name-as-directory (expand-file-name directory))) + (let* (tramp-crypt-enabled + (result + (directory-files (tramp-crypt-encrypt-file-name directory) 'full))) + (setq result + (mapcar (lambda (x) (tramp-crypt-decrypt-file-name x)) result)) + (when match + (setq result + (delq + nil + (mapcar + (lambda (x) + (when (string-match-p match (substring x (length directory))) + x)) + result)))) + (unless full + (setq result + (mapcar + (lambda (x) + (replace-regexp-in-string + (concat "^" (regexp-quote directory)) "" x)) + result))) + (if nosort result (sort result #'string<))))) + +(defun tramp-crypt-handle-file-attributes (filename &optional id-format) + "Like `file-attributes' for Tramp files." + (tramp-crypt-run-real-handler + #'file-attributes (list (tramp-crypt-encrypt-file-name filename) id-format))) + +(defun tramp-crypt-handle-file-executable-p (filename) + "Like `file-executable-p' for Tramp files." + (tramp-crypt-run-real-handler + #'file-executable-p (list (tramp-crypt-encrypt-file-name filename)))) + +(defun tramp-crypt-handle-file-readable-p (filename) + "Like `file-readable-p' for Tramp files." + (tramp-crypt-run-real-handler + #'file-readable-p (list (tramp-crypt-encrypt-file-name filename)))) + +(defun tramp-crypt-handle-file-system-info (filename) + "Like `file-system-info' for Tramp files." + (tramp-crypt-run-real-handler + #'file-system-info (list (tramp-crypt-encrypt-file-name filename)))) + +(defun tramp-crypt-handle-insert-directory + (filename switches &optional wildcard full-directory-p) + "Like `insert-directory' for Tramp files." + (let (tramp-crypt-enabled) + (tramp-handle-insert-directory + (tramp-crypt-encrypt-file-name filename) + switches wildcard full-directory-p) + (let* ((filename (file-name-as-directory filename)) + (enc (tramp-crypt-encrypt-file-name filename)) + match string) + (goto-char (point-min)) + (while (setq match (text-property-search-forward 'dired-filename t t)) + (setq string + (buffer-substring + (prop-match-beginning match) (prop-match-end match)) + string (if (file-name-absolute-p string) + (tramp-crypt-decrypt-file-name string) + (substring + (tramp-crypt-decrypt-file-name (concat enc string)) + (length filename)))) + (delete-region (prop-match-beginning match) (prop-match-end match)) + (insert (propertize string 'dired-filename t)))))) + +(defun tramp-crypt-handle-make-directory (dir &optional parents) + "Like `make-directory' for Tramp files." + (with-parsed-tramp-file-name (expand-file-name dir) nil + (when (and (null parents) (file-exists-p dir)) + (tramp-error v 'file-already-exists "Directory already exists %s" dir)) + (tramp-crypt-run-real-handler + #'make-directory (list (tramp-crypt-encrypt-file-name dir) parents)) + ;; When PARENTS is non-nil, DIR could be a chain of non-existent + ;; directories a/b/c/... Instead of checking, we simply flush the + ;; whole cache. + (tramp-flush-directory-properties + v (if parents "/" (file-name-directory localname))))) + +(defun tramp-crypt-handle-rename-file + (filename newname &optional ok-if-already-exists) + "Like `rename-file' for Tramp files." + (setq filename (expand-file-name filename) + newname (expand-file-name newname)) + ;; At least one file a Tramp file? + (if (or (tramp-tramp-file-p filename) + (tramp-tramp-file-p newname)) + (tramp-crypt-do-copy-or-rename-file + 'rename filename newname ok-if-already-exists + 'keep-date 'preserve-uid-gid) + (tramp-run-real-handler + #'rename-file (list filename newname ok-if-already-exists)))) + +(defun tramp-crypt-handle-set-file-modes (filename mode &optional flag) + "Like `set-file-modes' for Tramp files." + (with-parsed-tramp-file-name filename nil + (tramp-flush-file-properties v localname) + (tramp-crypt-run-real-handler + #'set-file-modes + (list (tramp-crypt-encrypt-file-name filename) mode flag)))) + +(add-hook 'tramp-unload-hook + (lambda () + (unload-feature 'tramp-crypt 'force))) + +(provide 'tramp-crypt) + +;;; TODO: + +;; * I suggest having a feature where the user can specify to always +;; use encryption for certain host names. So if you specify a host +;; name which is on that list (of names, or perhaps regexps?), tramp +;; would modify the request so as to do the encryption. (Richard Stallman) + +;;; tramp-crypt.el ends here diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index ee263ebe93..f1db6a7be2 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -745,7 +745,7 @@ to be set, depending on VALUE." tramp-postfix-host-format (tramp-build-postfix-host-format) tramp-postfix-host-regexp (tramp-build-postfix-host-regexp) tramp-remote-file-name-spec-regexp - (tramp-build-remote-file-name-spec-regexp) + (tramp-build-remote-file-name-spec-regexp) tramp-file-name-structure (tramp-build-file-name-structure) tramp-file-name-regexp (tramp-build-file-name-regexp) tramp-completion-file-name-regexp @@ -2182,6 +2182,7 @@ arguments to pass to the OPERATION." tramp-vc-file-name-handler tramp-completion-file-name-handler tramp-archive-file-name-handler + tramp-crypt-file-name-handler cygwin-mount-name-hook-function cygwin-mount-map-drive-hook-function . @@ -2484,13 +2485,16 @@ remote file names." (tramp-unload-file-name-handlers) ;; Add the handlers. We do not add anything to the `operations' - ;; property of `tramp-file-name-handler' and - ;; `tramp-archive-file-name-handler', this shall be done by the + ;; property of `tramp-file-name-handler', + ;; `tramp-archive-file-name-handler' and + ;; `tramp-crypt-file-name-handler', this shall be done by the ;; respective foreign handlers. (add-to-list 'file-name-handler-alist (cons tramp-file-name-regexp #'tramp-file-name-handler)) (put #'tramp-file-name-handler 'safe-magic t) + (tramp-register-crypt-file-name-handler) + (add-to-list 'file-name-handler-alist (cons tramp-completion-file-name-regexp #'tramp-completion-file-name-handler)) @@ -3497,6 +3501,9 @@ User is always nil." ;; copy this part. This works only for the shell file ;; name handlers. (when (and (or beg end) + ;; Direct actions aren't possible for + ;; crypted directories. + (null tramp-crypt-enabled) (tramp-get-method-parameter v 'tramp-login-program)) (setq remote-copy (tramp-make-tramp-temp-file v)) @@ -4649,6 +4656,8 @@ This handles also chrooted environments, which are not regarded as local." ;; handlers. `tramp-local-host-p' is also called for "smb" and ;; alike, where it must fail. (tramp-get-method-parameter vec 'tramp-login-program) + ;; Direct actions aren't possible for crypted directories. + (null tramp-crypt-enabled) ;; The local temp directory must be writable for the other user. (file-writable-p (tramp-make-tramp-file-name diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 1f56baad7c..7faa409f2f 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3815,6 +3815,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." "Check that `file-acl' and `set-file-acl' work proper." (skip-unless (tramp--test-enabled)) (skip-unless (file-acl tramp-test-temporary-file-directory)) + (skip-unless (null (tramp--test-crypt-p))) ;; `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)) @@ -3893,6 +3894,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (skip-unless (not (equal (file-selinux-context tramp-test-temporary-file-directory) '(nil nil nil nil)))) + (skip-unless (null (tramp--test-crypt-p))) ;; `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)) @@ -4196,6 +4198,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) + (skip-unless (null (tramp--test-crypt-p))) (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let* ((tmp-name (tramp--test-make-temp-name nil quoted)) @@ -4274,6 +4277,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) + (skip-unless (null (tramp--test-crypt-p))) (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((default-directory tramp-test-temporary-file-directory) @@ -4347,6 +4351,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) + (skip-unless (null (tramp--test-crypt-p))) ;; `make-process' supports file name handlers since Emacs 27. (skip-unless (tramp--test-emacs27-p)) @@ -4517,6 +4522,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) + (skip-unless (null (tramp--test-crypt-p))) ;; Since Emacs 26.1. (skip-unless (boundp 'interrupt-process-functions)) @@ -4577,6 +4583,7 @@ INPUT, if non-nil, is a string sent to the process." ;; remote processes in Emacs. That doesn't work for tramp-adb.el. (skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p)) (tramp--test-sh-p))) + (skip-unless (null (tramp--test-crypt-p))) (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((tmp-name (tramp--test-make-temp-name nil quoted)) @@ -4668,6 +4675,7 @@ INPUT, if non-nil, is a string sent to the process." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) + (skip-unless (null (tramp--test-crypt-p))) ;; Prior Emacs 27, `shell-command-dont-erase-buffer' wasn't working properly. (skip-unless (tramp--test-emacs27-p)) @@ -4880,6 +4888,7 @@ INPUT, if non-nil, is a string sent to the process." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) + (skip-unless (null (tramp--test-crypt-p))) (dolist (this-shell-command-to-string '(;; Synchronously. @@ -4966,6 +4975,7 @@ INPUT, if non-nil, is a string sent to the process." ;; We test it only for the mock-up connection; otherwise there might ;; be problems with the used ports. (skip-unless (and (eq tramp-syntax 'default) (tramp--test-mock-p))) + (skip-unless (null (tramp--test-crypt-p))) ;; We force a reconnect, in order to have a clean environment. (dolist (dir `(,tramp-test-temporary-file-directory @@ -5070,6 +5080,7 @@ INPUT, if non-nil, is a string sent to the process." ;; remote processes in Emacs. That doesn't work for tramp-adb.el. (skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p)) (tramp--test-sh-p))) + (skip-unless (null (tramp--test-crypt-p))) ;; Since Emacs 26.1. (skip-unless (and (fboundp 'connection-local-set-profile-variables) (fboundp 'connection-local-set-profiles))) @@ -5126,6 +5137,7 @@ INPUT, if non-nil, is a string sent to the process." "Check `exec-path' and `executable-find'." (skip-unless (tramp--test-enabled)) (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) + (skip-unless (null (tramp--test-crypt-p))) ;; Since Emacs 27.1. (skip-unless (fboundp 'exec-path)) @@ -5169,6 +5181,7 @@ INPUT, if non-nil, is a string sent to the process." "Check loooong `tramp-remote-path'." (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) + (skip-unless (null (tramp--test-crypt-p))) ;; Since Emacs 27.1. (skip-unless (fboundp 'exec-path)) @@ -5233,6 +5246,7 @@ INPUT, if non-nil, is a string sent to the process." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) + (skip-unless (null (tramp--test-crypt-p))) (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) ;; We must use `file-truename' for the temporary directory, in @@ -5581,6 +5595,10 @@ This does not support some special file names." (string-equal "docker" (file-remote-p tramp-test-temporary-file-directory 'method))) +(defun tramp--test-crypt-p () + "Check, whether the remote directory is crypted" + (tramp-crypt-file-name-p tramp-test-temporary-file-directory)) + (defun tramp--test-ftp-p () "Check, whether an FTP-like method is used. This does not support globbing characters in file names (yet)." @@ -5817,6 +5835,7 @@ This requires restrictions of file name syntax." ;; We do not run on macOS due to encoding problems. See ;; Bug#36940. (when (and (tramp--test-expensive-test) (tramp--test-sh-p) + (null (tramp--test-crypt-p)) (not (eq system-type 'darwin))) (dolist (elt files) (let ((envvar (concat "VAR_" (upcase (md5 elt)))) @@ -6149,6 +6168,7 @@ process sentinels. They shall not disturb each other." ;; remote processes in Emacs. That doesn't work for tramp-adb.el. (skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p)) (tramp--test-sh-p))) + (skip-unless (null (tramp--test-crypt-p))) (with-timeout (tramp--test-asynchronous-requests-timeout (tramp--test-timeout-handler)) commit 54e840a8b44712eff63929c01a916531051c3e0b Author: Michael Albinus Date: Sun Jun 7 16:56:59 2020 +0200 Tramp code cleanup * lisp/net/tramp-cache.el (tramp-get-connection-property): Cleanup. * lisp/net/tramp-cmds.el (tramp-cleanup-all-connections): Delete also connection processes. * lisp/net/tramp-sh.el (tramp-set-remote-path): Cache 4096 even if PIPE_BUF doesn't exist. diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 02400f9deb..970e2eea0a 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -142,7 +142,7 @@ Return DEFAULT if not set." (cached (and (hash-table-p hash) (gethash property hash))) (cached-at (and (consp cached) (format-time-string "%T" (car cached)))) (value default) - use-cache) + cache-used) (when ;; We take the value only if there is any, and ;; `remote-file-name-inhibit-cache' indicates that it is @@ -157,11 +157,11 @@ Return DEFAULT if not set." (time-less-p remote-file-name-inhibit-cache (car cached))))) (setq value (cdr cached) - use-cache t)) + cache-used t)) - (tramp-message key 8 "%s %s %s; inhibit: %s; cache used: %s; cached at: %s" - file property value - remote-file-name-inhibit-cache use-cache cached-at) + (tramp-message + key 8 "%s %s %s; inhibit: %s; cache used: %s; cached at: %s" + file property value remote-file-name-inhibit-cache cache-used cached-at) (when (>= tramp-verbose 10) (let* ((var (intern (concat "tramp-cache-get-count-" property))) (val (or (numberp (bound-and-true-p var)) @@ -320,15 +320,15 @@ the connection, return DEFAULT." (gethash property hash tramp-cache-undefined) tramp-cache-undefined)) (value default) - use-cache) + cache-used) (when (and (not (eq cached tramp-cache-undefined)) ;; If the key is an auxiliary process object, check ;; whether the process is still alive. (not (and (processp key) (not (process-live-p key))))) (setq value cached - use-cache t)) - (tramp-message key 7 "%s %s; cache used: %s" property value use-cache) + cache-used t)) + (tramp-message key 7 "%s %s; cache used: %s" property value cache-used) value)) ;;;###tramp-autoload diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index 1742da8630..2805f6648c 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -184,8 +184,9 @@ This includes password cache, file cache, connection cache, buffers." ;; Cancel timers. (cancel-function-timers 'tramp-timeout-session) - ;; Remove buffers. + ;; Remove processes and buffers. (dolist (name (tramp-list-tramp-buffers)) + (when (processp (get-buffer-process name)) (delete-process name)) (when (bufferp (get-buffer name)) (kill-buffer name))) ;; The end. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 523663cafb..a3ce436e42 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -4049,10 +4049,9 @@ variable PATH." (format "PATH=%s; export PATH" (string-join (tramp-get-remote-path vec) ":"))) (pipe-buf - (or (with-tramp-connection-property vec "pipe-buf" - (tramp-send-command-and-read - vec "getconf PIPE_BUF / 2>/dev/null || echo nil" 'noerror)) - 4096)) + (with-tramp-connection-property vec "pipe-buf" + (tramp-send-command-and-read + vec "getconf PIPE_BUF / 2>/dev/null || echo 4096" 'noerror))) tmpfile) (tramp-message vec 5 "Setting $PATH environment variable") (if (< (length command) pipe-buf) commit 1af0e95fec0d9c63b92ea081d6ca15ecd82d1ade Author: Tassilo Horn Date: Sun Jun 7 10:01:41 2020 +0200 Gnus nnir-summary-line-format has no effect * lisp/gnus/nnir.el (nnir-mode): Update summary format specs if nnir-summary-line-format is set and different from gnus-summary-line-format. (nnir-open-server): Run nnir-mode in gnus-summary-generate-hook instead of gnus-summary-prepared-hook. diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 823bc2b423..f1e31a0cd1 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -662,7 +662,7 @@ A non-nil `specs' arg must be an alist with `nnir-query-spec' and (let ((backend (car (gnus-server-to-method server)))) (if backend (nnoo-change-server backend server definitions) - (add-hook 'gnus-summary-prepared-hook 'nnir-mode) + (add-hook 'gnus-summary-generate-hook 'nnir-mode) (nnoo-change-server 'nnir server definitions)))) (deffoo nnir-request-group (group &optional server dont-check _info) @@ -1849,8 +1849,11 @@ is also searched." (defun nnir-mode () (when (eq (car (gnus-find-method-for-group gnus-newsgroup-name)) 'nnir) - (setq gnus-summary-line-format - (or nnir-summary-line-format gnus-summary-line-format)) + (when (and nnir-summary-line-format + (not (string= nnir-summary-line-format + gnus-summary-line-format))) + (setq gnus-summary-line-format nnir-summary-line-format) + (gnus-update-format-specifications nil 'summary)) (when (bound-and-true-p gnus-registry-enabled) (remove-hook 'gnus-summary-article-delete-hook 'gnus-registry-action t) (remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action t) commit dd366b5d3bc528b0e3520516f67baa523ffae956 Author: Eli Zaretskii Date: Sat Jun 6 20:10:37 2020 +0300 Improve documentation of 'window-text-pixel-size' * doc/lispref/display.texi (Size of Displayed Text): Clarify the description of 'window-text-pixel-size'. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 588e2217b9..707a1a8dc0 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -2023,36 +2023,45 @@ it contains. @defun window-text-pixel-size &optional window from to x-limit y-limit mode-and-header-line This function returns the size of the text of @var{window}'s buffer in -pixels. @var{window} must be a live window and defaults to the selected -one. The return value is a cons of the maximum pixel-width of any text -line and the maximum pixel-height of all text lines. - -The optional argument @var{from}, if non-@code{nil}, specifies the first -text position to consider and defaults to the minimum accessible -position of the buffer. If @var{from} is @code{t}, it uses the minimum -accessible position that is not a newline character. The optional -argument @var{to}, if non-@code{nil}, specifies the last text position -to consider and defaults to the maximum accessible position of the -buffer. If @var{to} is @code{t}, it uses the maximum accessible -position that is not a newline character. +pixels. @var{window} must be a live window and defaults to the +selected one. The return value is a cons of the maximum pixel-width +of any text line and the maximum pixel-height of all text lines. This +function exists to allow Lisp programs to adjust the dimensions of +@var{window} to the buffer text it needs to display. + +The optional argument @var{from}, if non-@code{nil}, specifies the +first text position to consider, and defaults to the minimum +accessible position of the buffer. If @var{from} is @code{t}, it +stands for the minimum accessible position that is not a newline +character. The optional argument @var{to}, if non-@code{nil}, +specifies the last text position to consider, and defaults to the +maximum accessible position of the buffer. If @var{to} is @code{t}, +it stands for the maximum accessible position that is not a newline +character. The optional argument @var{x-limit}, if non-@code{nil}, specifies the -maximum pixel-width that can be returned. @var{x-limit} @code{nil} or -omitted, means to use the pixel-width of @var{window}'s body -(@pxref{Window Sizes}); this is useful when the caller does not intend -to change the width of @var{window}. Otherwise, the caller should -specify here the maximum width @var{window}'s body may assume. Text -whose x-coordinate is beyond @var{x-limit} is ignored. Since +maximum X coordinate beyond which text should be ignored; it is +therefore also the largest value of pixel-width that the function can +return. If @var{x-limit} @code{nil} or omitted, it means to use the +pixel-width of @var{window}'s body (@pxref{Window Sizes}); this +default means that text of truncated lines wider than the window will +be ignored. This default is useful when the caller does not intend to +change the width of @var{window}. Otherwise, the caller should +specify here the maximum width @var{window}'s body may assume; in +particular, if truncated lines are expected and their text needs to be +accounted for, @var{x-limit} should be set to a large value. Since calculating the width of long lines can take some time, it's always a good idea to make this argument as small as needed; in particular, if the buffer might contain long lines that will be truncated anyway. The optional argument @var{y-limit}, if non-@code{nil}, specifies the -maximum pixel-height that can be returned. Text lines whose -y-coordinate is beyond @var{y-limit} are ignored. Since calculating the -pixel-height of a large buffer can take some time, it makes sense to -specify this argument; in particular, if the caller does not know the -size of the buffer. +maximum Y coordinate beyond which text is to be ignored; it is +therefore also the maximum pixel-height that the function can return. +If @var{y-limit} is nil or omitted, it means to considers all the +lines of text till the buffer position specified by @var{to}. Since +calculating the pixel-height of a large buffer can take some time, it +makes sense to specify this argument; in particular, if the caller +does not know the size of the buffer. The optional argument @var{mode-and-header-line} @code{nil} or omitted means to not include the height of the mode- or header-line of commit fbd49f969eac74a3f34d5505618280ee61be25b7 Author: Eli Zaretskii Date: Sat Jun 6 19:53:08 2020 +0300 * src/xdisp.c (Fwindow_text_pixel_size): Doc fix. (Bug#41737) diff --git a/src/xdisp.c b/src/xdisp.c index 684b4679d8..a280b48de9 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -10401,33 +10401,43 @@ in_display_vector_p (struct it *it) DEFUN ("window-text-pixel-size", Fwindow_text_pixel_size, Swindow_text_pixel_size, 0, 6, 0, doc: /* Return the size of the text of WINDOW's buffer in pixels. WINDOW must be a live window and defaults to the selected one. The -return value is a cons of the maximum pixel-width of any text line and -the maximum pixel-height of all text lines. +return value is a cons of the maximum pixel-width of any text line +and the pixel-height of all the text lines in the accessible portion +of buffer text. + +This function exists to allow Lisp programs to adjust the dimensions +of WINDOW to the buffer text it needs to display. The optional argument FROM, if non-nil, specifies the first text -position and defaults to the minimum accessible position of the buffer. -If FROM is t, use the minimum accessible position that starts a -non-empty line. TO, if non-nil, specifies the last text position and -defaults to the maximum accessible position of the buffer. If TO is t, -use the maximum accessible position that ends a non-empty line. - -The optional argument X-LIMIT, if non-nil, specifies the maximum text -width that can be returned. X-LIMIT nil or omitted, means to use the -pixel-width of WINDOW's body; use this if you want to know how high -WINDOW should be become in order to fit all of its buffer's text with -the width of WINDOW unaltered. Use the maximum width WINDOW may assume -if you intend to change WINDOW's width. In any case, text whose -x-coordinate is beyond X-LIMIT is ignored. Since calculating the width -of long lines can take some time, it's always a good idea to make this -argument as small as possible; in particular, if the buffer contains -long lines that shall be truncated anyway. - -The optional argument Y-LIMIT, if non-nil, specifies the maximum text -height (excluding the height of the mode- or header-line, if any) that -can be returned. Text lines whose y-coordinate is beyond Y-LIMIT are -ignored. Since calculating the text height of a large buffer can take -some time, it makes sense to specify this argument if the size of the -buffer is large or unknown. +position to consider, and defaults to the minimum accessible position +of the buffer. If FROM is t, it stands for the minimum accessible +position that starts a non-empty line. TO, if non-nil, specifies the +last text position and defaults to the maximum accessible position of +the buffer. If TO is t, it stands for the maximum accessible position +that ends a non-empty line. + +The optional argument X-LIMIT, if non-nil, specifies the maximum X +coordinate beyond which the text should be ignored. It is therefore +also the maximum width that the function can return. X-LIMIT nil or +omitted means to use the pixel-width of WINDOW's body. This default +means text of truncated lines wider than the window will be ignored; +specify a large value for X-LIMIT if lines are truncated and you need +to account for the truncated text. Use nil for X-LIMIT if you want to +know how high WINDOW should become in order to fit all of its buffer's +text with the width of WINDOW unaltered. Use the maximum width WINDOW +may assume if you intend to change WINDOW's width. Since calculating +the width of long lines can take some time, it's always a good idea to +make this argument as small as possible; in particular, if the buffer +contains long lines that shall be truncated anyway. + +The optional argument Y-LIMIT, if non-nil, specifies the maximum Y +coordinate beyond which the text is to be ignored; it is therefore +also the maxcomp height that the function can return (excluding the +height of the mode- or header-line, if any). Y-LIMIT nil or omitted +means consider all of the accessible portion of buffer text up to the +position specified by TO. Since calculating the text height of a +large buffer can take some time, it makes sense to specify this +argument if the size of the buffer is large or unknown. Optional argument MODE-AND-HEADER-LINE nil or omitted means do not include the height of the mode- or header-line of WINDOW in the return commit d8593fd19ffdb1fa62f0b0c4b971cfdb325fbe1d Author: Basil L. Contovounesios Date: Wed Jun 3 17:31:44 2020 +0100 Minor improvements to EDE and EIEIO manuals For discussion, see the following threads: https://lists.gnu.org/archive/html/emacs-devel/2020-05/msg00630.html https://lists.gnu.org/archive/html/emacs-devel/2020-06/msg00099.html * doc/misc/ede.texi (ede-generic-project): Clean up example. * doc/misc/eieio.texi (Accessing Slots): Document slot-value as a generalized variable and set-slot-value as obsolete. (Predicates): Fix typo. (Introspection): Document eieio-class-slots in place of the obsolete object-slots. diff --git a/doc/misc/ede.texi b/doc/misc/ede.texi index 584b0d7ee5..412176986c 100644 --- a/doc/misc/ede.texi +++ b/doc/misc/ede.texi @@ -955,18 +955,16 @@ The example for Makefiles looks like this: ;;; MAKEFILE (defclass ede-generic-makefile-project (ede-generic-project) - ((buildfile :initform "Makefile") - ) + ((buildfile :initform "Makefile")) "Generic Project for makefiles.") (defmethod ede-generic-setup-configuration ((proj ede-generic-makefile-project) config) - "Setup a configuration for Make." + "Set up a configuration for Make." (oset config build-command "make -k") - (oset config debug-command "gdb ") - ) + (oset config debug-command "gdb ")) (ede-generic-new-autoloader "generic-makefile" "Make" - "Makefile" 'ede-generic-makefile-project) + "Makefile" 'ede-generic-makefile-project) @end example This example project will detect any directory with the file diff --git a/doc/misc/eieio.texi b/doc/misc/eieio.texi index 3943c544c7..aceaff051e 100644 --- a/doc/misc/eieio.texi +++ b/doc/misc/eieio.texi @@ -734,14 +734,21 @@ slot values, and use the previously mentioned set/ref routines. @anchor{slot-value} This function retrieves the value of @var{slot} from @var{object}. Unlike @code{oref}, the symbol for @var{slot} must be quoted. + +This is a generalized variable that can be used with @code{setf} to +modify the value stored in @var{slot}. @xref{Generalized +Variables,,,elisp,GNU Emacs Lisp Reference Manual}. @end defun @defun set-slot-value object slot value @anchor{set-slot-value} -This is not a CLOS function, but is the setter for @code{slot-value} -used by the @code{setf} macro. This -function sets the value of @var{slot} from @var{object}. Unlike +This function sets the value of @var{slot} from @var{object}. Unlike @code{oset}, the symbol for @var{slot} must be quoted. + +This is not a CLOS function, but is the obsolete setter for +@code{slot-value} used by the @code{setf} macro. It is therefore +recommended to use @w{@code{(setf (slot-value @var{object} @var{slot}) +@var{value})}} instead. @end defun @defun slot-makeunbound object slot @@ -1062,7 +1069,7 @@ Return a string of the form @samp{#} for @var{obj}. This should look like Lisp symbols from other parts of Emacs such as buffers and processes, and is shorter and cleaner than printing the object's record. It is more useful to use @code{object-print} to get -and object's print form, as this allows the object to add extra display +an object's print form, as this allows the object to add extra display information into the symbol. @end defun @@ -1217,7 +1224,7 @@ objects on top of records, and thus everything is technically visible, some functions have been provided. None of these functions are a part of CLOS. -@defun object-slots obj +@defun eieio-class-slots obj Return the list of public slots for @var{obj}. @end defun commit 3916e63f9e98269930c4935dd5b3b88c4d940a62 Author: João Távora Date: Fri Jun 5 23:36:55 2020 +0100 Have Fido mode also imitate Ido mode in ignore-case options Suggested by Sean Whitton . * lisp/icomplete.el (icomplete--fido-mode-setup): Set ignore-case options. diff --git a/lisp/icomplete.el b/lisp/icomplete.el index c12f3901f0..60ef0247ba 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -330,7 +330,10 @@ if that doesn't produce a completion match." icomplete-hide-common-prefix nil completion-styles '(flex) completion-flex-nospace nil - completion-category-defaults nil))) + completion-category-defaults nil + completion-ignore-case t + read-buffer-completion-ignore-case t + read-file-name-completion-ignore-case t))) ;;;###autoload (define-minor-mode fido-mode commit cc35b197c7720e0687c6a994df9a4cf767298712 Author: Basil L. Contovounesios Date: Fri Jun 5 14:02:41 2020 +0100 Update package-menu-quick-help * lisp/emacs-lisp/package.el (package--quick-help-keys): Filtering is now bound to the prefix '/', not the key 'f' (bug#41721). Advertise only the standard 'g' binding now that both it and 'r' are bound to revert-buffer (bug#35504). (package--prettify-quick-help-key): Avoid modifying string literals. (package-menu-filter): Reintroduce as obsolete alias of package-menu-filter-by-keyword for backward compatibility (bug#36981). diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 7af40247f3..7d6be3cf4e 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -3279,7 +3279,7 @@ If optional arg BUTTON is non-nil, describe its associated package." '(("install," "delete," "unmark," ("execute" . 1)) ("next," "previous") ("Hide-package," "(-toggle-hidden") - ("refresh-contents," "g-redisplay," "filter," "help"))) + ("g-refresh-contents," "/-filter," "help"))) (defun package--prettify-quick-help-key (desc) "Prettify DESC to be displayed as a help menu." @@ -3287,7 +3287,7 @@ If optional arg BUTTON is non-nil, describe its associated package." (if (listp (cdr desc)) (mapconcat #'package--prettify-quick-help-key desc " ") (let ((place (cdr desc)) - (out (car desc))) + (out (copy-sequence (car desc)))) (add-text-properties place (1+ place) '(face (bold font-lock-warning-face)) out) @@ -3719,6 +3719,9 @@ Statuses available include \"incompat\", \"available\", (list keyword) keyword))) +(define-obsolete-function-alias + 'package-menu-filter #'package-menu-filter-by-keyword "27.1") + (defun package-menu-filter-by-name (name) "Filter the \"*Packages*\" buffer by NAME. Show only those items whose name matches the regular expression commit bf09106256f9212d3162a4335c18fd2ef876066d Author: Eli Zaretskii Date: Fri Jun 5 11:30:03 2020 +0300 Improve documentation of 'sort-subr' * doc/lispref/text.texi (Sorting): Clarify the meaning and use of PREDICATE argument to 'sort-subr'. (Bug#41706) diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index a14867e1d1..0bbb0aa8dc 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -2028,8 +2028,15 @@ non-@code{nil} value. @end enumerate The argument @var{predicate} is the function to use to compare keys. -If keys are numbers, it defaults to @code{<}; otherwise it defaults to -@code{string<}. +It is called with two arguments, the keys to compare, and should +return non-@code{nil} if the first key should come before the second +in the sorting order. What exactly are the key arguments depends on +what @var{startkeyfun} and @var{endkeyfun} return. If @var{predicate} +is omitted or @code{nil}, it defaults to @code{<} if the keys are +numbers, to @code{compare-buffer-substrings} if the keys are cons +cells (whose @code{car} and @code{cdr} are start and end buffer +positions of the key), and to @code{string<} otherwise (with keys +assumed to be strings). As an example of @code{sort-subr}, here is the complete function definition for @code{sort-lines}: commit 73749efa131dea3ac39f46d08f1ed98bf04830af Author: Andrii Kolomoiets Date: Wed Jun 3 14:14:57 2020 +0300 Update Ukrainian transliteration * lisp/language/cyril-util.el (standard-display-cyrillic-translit): Add missing letter "ґ"; tweak letter "г". (Bug#41683) diff --git a/lisp/language/cyril-util.el b/lisp/language/cyril-util.el index e7a1267590..a3a6f3fdd9 100644 --- a/lisp/language/cyril-util.el +++ b/lisp/language/cyril-util.el @@ -152,6 +152,7 @@ If the argument is nil, we return the display table to its standard state." (aset standard-display-table ?љ [?l ?j]) (aset standard-display-table ?њ [?n ?j]) (aset standard-display-table ?џ [?d ?z]) + (aset standard-display-table ?ґ [?g]) (aset standard-display-table ?Є [?Y ?e]) (aset standard-display-table ?Ї [?Y ?i]) @@ -166,6 +167,7 @@ If the argument is nil, we return the display table to its standard state." (aset standard-display-table ?Љ [?L ?j]) (aset standard-display-table ?Њ [?N ?j]) (aset standard-display-table ?Џ [?D ?j]) + (aset standard-display-table ?Ґ [?G]) (when (equal cyrillic-language "Bulgarian") (aset standard-display-table ?щ [?s ?h ?t]) @@ -182,7 +184,9 @@ If the argument is nil, we return the display table to its standard state." (aset standard-display-table ?й [?i]) (aset standard-display-table ?Й [?Y]) (aset standard-display-table ?ю [?i ?u]) - (aset standard-display-table ?я [?i ?a])))) + (aset standard-display-table ?я [?i ?a]) + (aset standard-display-table ?г [?h]) + (aset standard-display-table ?Г [?H])))) ;; (provide 'cyril-util) commit 30a7ee505aca3cc285699bae1630a28185519d99 Author: Eli Zaretskii Date: Fri Jun 5 10:56:01 2020 +0300 Fix Arabic shaping when eww/shr fill the text to be rendered * src/hbfont.c (hbfont_shape): Don't use DIRECTION if the current buffer has bidi reordering disabled. (Bug#41005) diff --git a/src/hbfont.c b/src/hbfont.c index 576c5fe7f6..4b3f64ef50 100644 --- a/src/hbfont.c +++ b/src/hbfont.c @@ -26,6 +26,7 @@ along with GNU Emacs. If not, see . */ #include "composite.h" #include "font.h" #include "dispextern.h" +#include "buffer.h" #ifdef HAVE_NTGUI @@ -438,7 +439,11 @@ hbfont_shape (Lisp_Object lgstring, Lisp_Object direction) /* If the caller didn't provide a meaningful DIRECTION, let HarfBuzz guess it. */ - if (!NILP (direction)) + if (!NILP (direction) + /* If they bind bidi-display-reordering to nil, the DIRECTION + they provide is meaningless, and we should let HarfBuzz guess + the real direction. */ + && !NILP (BVAR (current_buffer, bidi_display_reordering))) { hb_direction_t dir = HB_DIRECTION_LTR; if (EQ (direction, QL2R)) commit 7d323f07c0b540547c4aab38069972a918eff9d3 Author: Basil L. Contovounesios Date: Tue Jun 2 23:14:23 2020 +0100 Silence some byte-compiler warnings in tests * test/lisp/emacs-lisp/cl-generic-tests.el: * test/lisp/progmodes/elisp-mode-tests.el: Declare functions referred to within macroexpansions. (xref-elisp-overloadable-no-default) (xref-elisp-overloadable-co-located-default) (xref-elisp-overloadable-separate-default): Prefix unused arguments with underscore. * test/lisp/international/ccl-tests.el: * test/lisp/wdired-tests.el: * test/lisp/emacs-lisp/package-tests.el: Declare functions used. (package-test-update-archives, package-test-signed): Use revert-buffer in place of its obsolete alias package-menu-refresh. * test/lisp/eshell/eshell-tests.el: * test/lisp/mail/footnote-tests.el: * test/src/buffer-tests.el: Require dependencies used. * test/lisp/image/exif-tests.el: Remove unneeded (require 'seq). (test-exit-direct-ascii-value): Actually perform the test. * test/lisp/progmodes/sql-tests.el (sql-test-add-existing-product): Fix typo. * test/lisp/simple-tests.el (with-shell-command-dont-erase-buffer): * test/src/data-tests.el (test-bool-vector-bv-from-hex-string) (test-bool-vector-apply-mock-op): Remove unused local variables. diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el index d9f1cb9ec4..51c9884ddc 100644 --- a/test/lisp/emacs-lisp/cl-generic-tests.el +++ b/test/lisp/emacs-lisp/cl-generic-tests.el @@ -23,9 +23,15 @@ ;;; Code: -(eval-when-compile (require 'ert)) ;Don't indirectly require cl-lib at run-time. (require 'cl-generic) +;; Don't indirectly require `cl-lib' at run-time. +(eval-when-compile (require 'ert)) +(declare-function ert--should-signal-hook "ert") +(declare-function ert--signal-should-execution "ert") +(declare-function ert-fail "ert") +(declare-function ert-set-test "ert") + (fmakunbound 'cl--generic-1) (cl-defgeneric cl--generic-1 (x y)) (cl-defgeneric (setf cl--generic-1) (v y z) "My generic doc.") diff --git a/test/lisp/emacs-lisp/package-tests.el b/test/lisp/emacs-lisp/package-tests.el index 7d354d6ecd..4fcaf0e84c 100644 --- a/test/lisp/emacs-lisp/package-tests.el +++ b/test/lisp/emacs-lisp/package-tests.el @@ -267,6 +267,9 @@ Must called from within a `tar-mode' buffer." (should (package-installed-p 'simple-single)) (should (package-installed-p 'simple-depend)))) +(declare-function macro-problem-func "macro-problem" ()) +(declare-function macro-problem-10-and-90 "macro-problem" ()) + (ert-deftest package-test-macro-compilation () "Install a package which includes a dependency." (with-package-test (:basedir "package-resources") @@ -391,7 +394,7 @@ Must called from within a `tar-mode' buffer." "Test updating package archives." (with-package-test () (let ((buf (package-list-packages))) - (package-menu-refresh) + (revert-buffer) (search-forward-regexp "^ +simple-single") (package-menu-mark-install) (package-menu-execute) @@ -399,7 +402,7 @@ Must called from within a `tar-mode' buffer." (let ((package-test-data-dir (expand-file-name "package-resources/newer-versions" package-test-file-dir))) (setq package-archives `(("gnu" . ,package-test-data-dir))) - (package-menu-refresh) + (revert-buffer) ;; New version should be available and old version should be installed (goto-char (point-min)) @@ -411,7 +414,7 @@ Must called from within a `tar-mode' buffer." (package-menu-mark-upgrades) (package-menu-execute) - (package-menu-refresh) + (revert-buffer) (should (package-installed-p 'simple-single '(1 4))))))) (ert-deftest package-test-update-archives-async () @@ -541,6 +544,8 @@ Must called from within a `tar-mode' buffer." (let ((process-environment (cons (concat "HOME=" homedir) process-environment))) + (require 'epg-config) + (defvar epg-config--program-alist) (epg-find-configuration 'OpenPGP nil ;; By default we require gpg2 2.1+ due to some @@ -573,7 +578,7 @@ Must called from within a `tar-mode' buffer." (should (progn (package-install 'signed-bad) 'noerror))) ;; Check if the installed package status is updated. (let ((buf (package-list-packages))) - (package-menu-refresh) + (revert-buffer) (should (re-search-forward "^\\s-+signed-good\\s-+\\(\\S-+\\)\\s-+\\(\\S-+\\)\\s-" nil t)) diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el index 026818ab06..7069430944 100644 --- a/test/lisp/eshell/eshell-tests.el +++ b/test/lisp/eshell/eshell-tests.el @@ -26,6 +26,7 @@ ;;; Code: (require 'ert) +(require 'esh-mode) (require 'eshell) (defmacro with-temp-eshell (&rest body) diff --git a/test/lisp/image/exif-tests.el b/test/lisp/image/exif-tests.el index 8a2231106f..9e5da46b50 100644 --- a/test/lisp/image/exif-tests.el +++ b/test/lisp/image/exif-tests.el @@ -21,7 +21,6 @@ (require 'ert) (require 'exif) -(require 'seq) (defun test-image-file (name) (expand-file-name @@ -49,7 +48,7 @@ (should (equal (exif-elem exif 'artist) "z")))) (ert-deftest test-exit-direct-ascii-value () - (equal (exif--direct-ascii-value 28005 2 t) (string ?e ?m 0)) - (equal (exif--direct-ascii-value 28005 2 nil) (string ?m ?e 0))) + (should (equal (exif--direct-ascii-value 28005 2 t) (string ?e ?m 0))) + (should (equal (exif--direct-ascii-value 28005 2 nil) (string ?m ?e 0)))) ;;; exif-tests.el ends here diff --git a/test/lisp/international/ccl-tests.el b/test/lisp/international/ccl-tests.el index 3581cd784f..c8a5512d6f 100644 --- a/test/lisp/international/ccl-tests.el +++ b/test/lisp/international/ccl-tests.el @@ -94,6 +94,9 @@ At EOF: (ccl-dump prog-pgg-code) (should (equal (buffer-string) prog-pgg-dump)))) +(defvar pgg-parse-crc24) +(declare-function pgg-parse-crc24-string "pgg-parse" (string)) + (ert-deftest pgg-parse-crc24 () ;; Compiler (require 'pgg) diff --git a/test/lisp/mail/footnote-tests.el b/test/lisp/mail/footnote-tests.el index 458964c306..79f4807239 100644 --- a/test/lisp/mail/footnote-tests.el +++ b/test/lisp/mail/footnote-tests.el @@ -18,12 +18,10 @@ ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . -;;; Commentary: - -;; - ;;; Code: +(require 'footnote) + (ert-deftest footnote-tests-same-place () (with-temp-buffer (footnote-mode 1) diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el index b793f7389b..2ba0065686 100644 --- a/test/lisp/progmodes/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el @@ -598,16 +598,17 @@ to (xref-elisp-test-descr-to-target xref)." ;; Define some mode-local overloadable/overridden functions for xref to find (require 'mode-local) +(declare-function xref-elisp-overloadable-no-methods-default "elisp-mode-tests") +(declare-function xref-elisp-overloadable-no-default-default "elisp-mode-tests") + (define-overloadable-function xref-elisp-overloadable-no-methods () "doc string overloadable no-methods") (define-overloadable-function xref-elisp-overloadable-no-default () "doc string overloadable no-default") -;; FIXME: byte compiler complains about unused lexical arguments -;; generated by this macro. (define-mode-local-override xref-elisp-overloadable-no-default c-mode - (start end &optional nonterminal depth returnonerror) + (_start _end &optional _nonterminal _depth _returnonerror) "doc string overloadable no-default c-mode." "result overloadable no-default c-mode.") @@ -616,7 +617,7 @@ to (xref-elisp-test-descr-to-target xref)." "result overloadable co-located-default.") (define-mode-local-override xref-elisp-overloadable-co-located-default c-mode - (start end &optional nonterminal depth returnonerror) + (_start _end &optional _nonterminal _depth _returnonerror) "doc string overloadable co-located-default c-mode." "result overloadable co-located-default c-mode.") @@ -628,7 +629,7 @@ to (xref-elisp-test-descr-to-target xref)." "result overloadable separate-default.") (define-mode-local-override xref-elisp-overloadable-separate-default c-mode - (start end &optional nonterminal depth returnonerror) + (_start _end &optional _nonterminal _depth _returnonerror) "doc string overloadable separate-default c-mode." "result overloadable separate-default c-mode.") diff --git a/test/lisp/progmodes/sql-tests.el b/test/lisp/progmodes/sql-tests.el index d6f89341be..65ed76bfb5 100644 --- a/test/lisp/progmodes/sql-tests.el +++ b/test/lisp/progmodes/sql-tests.el @@ -193,7 +193,7 @@ Perform ACTION and validate results" "Add a product that already exists." (sql-test-product-feature-harness - (should-error (sql-add-feature 'a "Aaa")) + (should-error (sql-add-product 'a "Aaa")) (should (equal (pp-to-string (assoc 'a sql-product-alist)) "(a :X 1 :Y 2 :Z sql-test-feature-value-a)\n")))) diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el index 03f7260f55..c8b913b3f1 100644 --- a/test/lisp/simple-tests.el +++ b/test/lisp/simple-tests.el @@ -716,8 +716,7 @@ See Bug#21722." (defmacro with-shell-command-dont-erase-buffer (str output-buffer-is-current &rest body) (declare (debug (sexp form body)) (indent 2)) - (let ((expected (make-symbol "expected")) - (command (make-symbol "command")) + (let ((command (make-symbol "command")) (caller-buf (make-symbol "caller-buf")) (output-buf (make-symbol "output-buf"))) `(let* ((,caller-buf (generate-new-buffer "caller-buf")) diff --git a/test/lisp/wdired-tests.el b/test/lisp/wdired-tests.el index baa547758e..5b01c54cf2 100644 --- a/test/lisp/wdired-tests.el +++ b/test/lisp/wdired-tests.el @@ -129,6 +129,8 @@ wdired-mode." (delete-directory test-dir t))))) (defvar server-socket-dir) +(declare-function dired-smart-shell-command "dired-x" + (command &optional output-buffer error-buffer)) (ert-deftest wdired-test-bug34915 () "Test editing when dired-listing-switches includes -F. diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el index 1c356698f6..60d29dd3a1 100644 --- a/test/src/buffer-tests.el +++ b/test/src/buffer-tests.el @@ -20,6 +20,7 @@ ;;; Code: (require 'ert) +(require 'seq) (eval-when-compile (require 'cl-lib)) (ert-deftest overlay-modification-hooks-message-other-buf () diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 3cebb3dfa5..ed09203907 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -174,7 +174,7 @@ most-positive-fixnum, which is just less than a power of 2.") sum 1)) (defun test-bool-vector-bv-from-hex-string (desc) - (let (bv nchars nibbles) + (let (bv nibbles) (dolist (c (string-to-list desc)) (push (string-to-number (char-to-string c) @@ -244,9 +244,9 @@ comparing the subr with a much slower lisp implementation." (defun test-bool-vector-apply-mock-op (mock a b c) "Compute (slowly) the correct result of a bool-vector set operation." - (let (changed nv) + (let (changed) (cl-assert (eql (length b) (length c))) - (if a (setf nv a) + (unless a (setf a (make-bool-vector (length b) nil)) (setf changed t)) commit cf473e742fdd0cce75f8e43a62307612b929461d Author: Basil L. Contovounesios Date: Tue Jun 2 21:05:28 2020 +0100 * test/lisp/battery-tests.el: New file. diff --git a/test/lisp/battery-tests.el b/test/lisp/battery-tests.el new file mode 100644 index 0000000000..052ae49a80 --- /dev/null +++ b/test/lisp/battery-tests.el @@ -0,0 +1,58 @@ +;;; battery-tests.el --- tests for battery.el -*- lexical-binding: t -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'battery) + +(ert-deftest battery-linux-proc-apm-regexp () + "Test `battery-linux-proc-apm-regexp'." + (let ((str "1.16 1.2 0x07 0x01 0xff 0x80 -1% -1 ?")) + (should (string-match battery-linux-proc-apm-regexp str)) + (should (equal (match-string 0 str) str)) + (should (equal (match-string 1 str) "1.16")) + (should (equal (match-string 2 str) "1.2")) + (should (equal (match-string 3 str) "07")) + (should (equal (match-string 4 str) "01")) + (should (equal (match-string 5 str) "ff")) + (should (equal (match-string 6 str) "80")) + (should (equal (match-string 7 str) "-1")) + (should (equal (match-string 8 str) "-1")) + (should (equal (match-string 9 str) "?"))) + (let ((str "1.16 1.2 0x03 0x00 0x00 0x01 99% 1792 min")) + (should (string-match battery-linux-proc-apm-regexp str)) + (should (equal (match-string 0 str) str)) + (should (equal (match-string 1 str) "1.16")) + (should (equal (match-string 2 str) "1.2")) + (should (equal (match-string 3 str) "03")) + (should (equal (match-string 4 str) "00")) + (should (equal (match-string 5 str) "00")) + (should (equal (match-string 6 str) "01")) + (should (equal (match-string 7 str) "99")) + (should (equal (match-string 8 str) "1792")) + (should (equal (match-string 9 str) "min")))) + +(ert-deftest battery-format () + "Test `battery-format'." + (should (equal (battery-format "" ()) "")) + (should (equal (battery-format "" '((?b . "-"))) "")) + (should (equal (battery-format "%a%b%p%%" '((?b . "-") (?p . "99"))) + "-99%"))) + +;;; battery-tests.el ends here commit b07e3b1d97e73c5cf0cd60edf4838b555530bbf0 Author: Basil L. Contovounesios Date: Thu May 28 00:53:42 2020 +0100 Improve format-spec documentation (bug#41571) * doc/lispref/text.texi (Interpolated Strings): Move from here... * doc/lispref/strings.texi (Custom Format Strings): ...to here, renaming the node and clarifying the documentation. (Formatting Strings): End node with sentence referring to the next one. * lisp/format-spec.el (format-spec): Clarify docstring. diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 70c3b3cf4b..4a7bda57c4 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -28,6 +28,7 @@ keyboard character events. * Text Comparison:: Comparing characters or strings. * String Conversion:: Converting to and from characters and strings. * Formatting Strings:: @code{format}: Emacs's analogue of @code{printf}. +* Custom Format Strings:: Formatting custom @code{format} specifications. * Case Conversion:: Case conversion functions. * Case Tables:: Customizing case conversion. @end menu @@ -1122,6 +1123,181 @@ may be problematic; for example, @samp{%d} and @samp{%g} can mishandle NaNs and can lose precision and type, and @samp{#x%x} and @samp{#o%o} can mishandle negative integers. @xref{Input Functions}. +The functions described in this section accept a fixed set of +specification characters. The next section describes a function +@code{format-spec} which can accept custom specification characters, +such as @samp{%a} or @samp{%z}. + +@node Custom Format Strings +@section Custom Format Strings +@cindex custom format string +@cindex custom @samp{%}-sequence in format + +Sometimes it is useful to allow users and Lisp programs alike to +control how certain text is generated via custom format control +strings. For example, a format string could control how to display +someone's forename, surname, and email address. Using the function +@code{format} described in the previous section, the format string +could be something like @w{@code{"%s %s <%s>"}}. This approach +quickly becomes impractical, however, as it can be unclear which +specification character corresponds to which piece of information. + +A more convenient format string for such cases would be something like +@w{@code{"%f %l <%e>"}}, where each specification character carries +more semantic information and can easily be rearranged relative to +other specification characters, making such format strings more easily +customizable by the user. + +The function @code{format-spec} described in this section performs a +similar function to @code{format}, except it operates on format +control strings that use arbitrary specification characters. + +@defun format-spec template spec-alist &optional only-present +This function returns a string produced from the format string +@var{template} according to conversions specified in @var{spec-alist}, +which is an alist (@pxref{Association Lists}) of the form +@w{@code{(@var{letter} . @var{replacement})}}. Each specification +@code{%@var{letter}} in @var{template} will be replaced by +@var{replacement} when formatting the resulting string. + +The characters in @var{template}, other than the format +specifications, are copied directly into the output, including their +text properties, if any. Any text properties of the format +specifications are copied to their replacements. + +Using an alist to specify conversions gives rise to some useful +properties: + +@itemize @bullet +@item +If @var{spec-alist} contains more unique @var{letter} keys than there +are unique specification characters in @var{template}, the unused keys +are simply ignored. +@item +If @var{spec-alist} contains more than one association with the same +@var{letter}, the closest one to the start of the list is used. +@item +If @var{template} contains the same specification character more than +once, then the same @var{replacement} found in @var{spec-alist} is +used as a basis for all of that character's substitutions. +@item +The order of specifications in @var{template} need not correspond to +the order of associations in @var{spec-alist}. +@end itemize + +The optional argument @var{only-present} indicates how to handle +specification characters in @var{template} that are not found in +@var{spec-alist}. If it is @code{nil} or omitted, the function +signals an error. Otherwise, those format specifications and any +occurrences of @samp{%%} in @var{template} are left verbatim in the +output, including their text properties, if any. +@end defun + +The syntax of format specifications accepted by @code{format-spec} is +similar, but not identical, to that accepted by @code{format}. In +both cases, a format specification is a sequence of characters +beginning with @samp{%} and ending with an alphabetic letter such as +@samp{s}. + +Unlike @code{format}, which assigns specific meanings to a fixed set +of specification characters, @code{format-spec} accepts arbitrary +specification characters and treats them all equally. For example: + +@example +@group +(setq my-site-info + (list (cons ?s system-name) + (cons ?t (symbol-name system-type)) + (cons ?c system-configuration) + (cons ?v emacs-version) + (cons ?e invocation-name) + (cons ?p (number-to-string (emacs-pid))) + (cons ?a user-mail-address) + (cons ?n user-full-name))) + +(format-spec "%e %v (%c)" my-site-info) + @result{} "emacs 27.1 (x86_64-pc-linux-gnu)" + +(format-spec "%n <%a>" my-site-info) + @result{} "Emacs Developers " +@end group +@end example + +A format specification can include any number of the following flag +characters immediately after the @samp{%} to modify aspects of the +substitution. + +@table @samp +@item 0 +This flag causes any padding specified by the width to consist of +@samp{0} characters instead of spaces. + +@item - +This flag causes any padding specified by the width to be inserted on +the right rather than the left. + +@item < +This flag causes the substitution to be truncated on the left to the +given width, if specified. + +@item > +This flag causes the substitution to be truncated on the right to the +given width, if specified. + +@item ^ +This flag converts the substituted text to upper case (@pxref{Case +Conversion}). + +@item _ +This flag converts the substituted text to lower case (@pxref{Case +Conversion}). +@end table + +The result of using contradictory flags (for instance, both upper and +lower case) is undefined. + +As is the case with @code{format}, a format specification can include +a width, which is a decimal number that appears after any flags. If a +substitution contains fewer characters than its specified width, it is +padded on the left: + +@example +@group +(format-spec "%8a is padded on the left with spaces" + '((?a . "alpha"))) + @result{} " alpha is padded on the left with spaces" +@end group +@end example + +Here is a more complicated example that combines several +aforementioned features: + +@example +@group +(setq my-battery-info + (list (cons ?p "73") ; Percentage + (cons ?L "Battery") ; Status + (cons ?t "2:23") ; Remaining time + (cons ?c "24330") ; Capacity + (cons ?r "10.6"))) ; Rate of discharge + +(format-spec "%>^-3L : %3p%% (%05t left)" my-battery-info) + @result{} "BAT : 73% (02:23 left)" + +(format-spec "%>^-3L : %3p%% (%05t left)" + (cons (cons ?L "AC") + my-battery-info)) + @result{} "AC : 73% (02:23 left)" +@end group +@end example + +As the examples in this section illustrate, @code{format-spec} is +often used for selectively formatting an assortment of different +pieces of information. This is useful in programs that provide +user-customizable format strings, as the user can choose to format +with a regular syntax and in any desired order only a subset of the +information that the program makes available. + @node Case Conversion @section Case Conversion in Lisp @cindex upper case diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index de436fa9e6..a14867e1d1 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -58,7 +58,6 @@ the character after point. of another buffer. * Decompression:: Dealing with compressed data. * Base 64:: Conversion to or from base 64 encoding. -* Interpolated Strings:: Formatting Customizable Strings. * Checksum/Hash:: Computing cryptographic hashes. * GnuTLS Cryptography:: Cryptographic algorithms imported from GnuTLS. * Parsing HTML/XML:: Parsing HTML and XML. @@ -4662,69 +4661,6 @@ If optional argument @var{base64url} is non-@code{nil}, then padding is optional, and the URL variant of base 64 encoding is used. @end defun - -@node Interpolated Strings -@section Formatting Customizable Strings - -It is, in some circumstances, useful to present users with a string to -be customized that can then be expanded programmatically. For -instance, @code{erc-header-line-format} is @code{"%n on %t (%m,%l) -%o"}, and each of those characters after the percent signs are -expanded when the header line is computed. To do this, the -@code{format-spec} function is used: - -@defun format-spec format specification &optional only-present -@var{format} is the format specification string as in the example -above. @var{specification} is an alist that has elements where the -@code{car} is a character and the @code{cdr} is the substitution. - -If @var{only-present} is @code{nil}, errors will be signaled if a -format character has been used that's not present in -@var{specification}. If it's non-@code{nil}, that format -specification is left verbatim in the result. -@end defun - -Here's a trivial example: - -@example -(format-spec "su - %u %l" - `((?u . ,(user-login-name)) - (?l . "ls"))) - @result{} "su - foo ls" -@end example - -In addition to allowing padding/limiting to a certain length, the -following modifiers can be used: - -@table @asis -@item @samp{0} -Pad with zeros instead of the default spaces. - -@item @samp{-} -Pad to the right. - -@item @samp{^} -Use upper case. - -@item @samp{_} -Use lower case. - -@item @samp{<} -If the length needs to be limited, remove characters from the left. - -@item @samp{>} -Same as previous, but remove characters from the right. -@end table - -If contradictory modifiers are used (for instance, both upper and -lower case), then what happens is undefined. - -As an example, @samp{"%<010b"} means ``insert the @samp{b} expansion, -but pad with leading zeros if it's less than ten characters, and if -it's more than ten characters, shorten by removing characters from the -left.'' - - @node Checksum/Hash @section Checksum/Hash @cindex MD5 checksum diff --git a/lisp/format-spec.el b/lisp/format-spec.el index f418cea425..9278bd74c4 100644 --- a/lisp/format-spec.el +++ b/lisp/format-spec.el @@ -29,35 +29,46 @@ (defun format-spec (format specification &optional only-present) "Return a string based on FORMAT and SPECIFICATION. -FORMAT is a string containing `format'-like specs like \"su - %u %k\", -while SPECIFICATION is an alist mapping from format spec characters -to values. +FORMAT is a string containing `format'-like specs like \"su - %u %k\". +SPECIFICATION is an alist mapping format specification characters +to their substitutions. For instance: (format-spec \"su - %u %l\" - `((?u . ,(user-login-name)) + \\=`((?u . ,(user-login-name)) (?l . \"ls\"))) -Each format spec can have modifiers, where \"%<010b\" means \"if -the expansion is shorter than ten characters, zero-pad it, and if -it's longer, chop off characters from the left side\". +Each %-spec may contain optional flag and width modifiers, as +follows: -The following modifiers are allowed: + %character -* 0: Use zero-padding. -* -: Pad to the right. -* ^: Upper-case the expansion. -* _: Lower-case the expansion. -* <: Limit the length by removing chars from the left. -* >: Limit the length by removing chars from the right. +The following flags are allowed: -Any text properties on a %-spec itself are propagated to the text -that it generates. +* 0: Pad to the width, if given, with zeros instead of spaces. +* -: Pad to the width, if given, on the right instead of the left. +* <: Truncate to the width, if given, on the left. +* >: Truncate to the width, if given, on the right. +* ^: Convert to upper case. +* _: Convert to lower case. -If ONLY-PRESENT, format spec characters not present in -SPECIFICATION are ignored, and the \"%\" characters are left -where they are, including \"%%\" strings." +The width modifier behaves like the corresponding one in `format' +when applied to %s. + +For example, \"%<010b\" means \"substitute into the output the +value associated with ?b in SPECIFICATION, either padding it with +leading zeros or truncating leading characters until it's ten +characters wide\". + +Any text properties of FORMAT are copied to the result, with any +text properties of a %-spec itself copied to its substitution. + +ONLY-PRESENT indicates how to handle %-spec characters not +present in SPECIFICATION. If it is nil or omitted, emit an +error; otherwise leave those %-specs and any occurrences of +\"%%\" in FORMAT verbatim in the result, including their text +properties, if any." (with-temp-buffer (insert format) (goto-char (point-min))