commit d8a6d2e4810a4072cabbf76170dc4bf708f27d10 (HEAD, refs/remotes/origin/master) Author: Mattias Engdegård Date: Thu Jun 11 00:06:24 2020 +0200 ; * lisp/faces.el (readable-foreground-color): Fix editing mistake. diff --git a/lisp/faces.el b/lisp/faces.el index 5ecc256f07..8c3e464cb8 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1790,7 +1790,8 @@ The returned value is a string representing black or white, depending on which one provides better contrast with COLOR." ;; We use #ffffff instead of "white", because the latter is sometimes ;; less than white. That way, we get the best contrast possible. - (if (color-dark-p (mapcar (lambda (c) (/ c 65535.0)) color)) + (if (color-dark-p (mapcar (lambda (c) (/ c 65535.0)) + (color-values color))) "#ffffff" "black")) (defun color-dark-p (rgb) commit 68ae6faa7f1b4c348740667f98fbf1d1ce5a7979 Author: Mattias Engdegård Date: Wed Jun 10 19:18:58 2020 +0200 Improved light/dark colour predicate (bug#41544) Add a predicate, color-dark-p, for deciding whether a colour is more readable with black or white as contrast. It has experimentally been shown to be more accurate and robust than the various methods currently employed. The new predicate compares the relative luminance of the colour to an empirically determined cut-off value, and it seems to get it right in almost all cases, with no value leading to outright bad results. * lisp/faces.el (readable-foreground-color): Use color-dark-p. (color-dark-p): New function. * lisp/facemenu.el (list-colors-print): Use readable-foreground-color, improving readability of list-colors-display. * lisp/textmodes/css-mode.el (css--contrasty-color): Remove. (css--fontify-region): Use readable-foreground-color. diff --git a/lisp/facemenu.el b/lisp/facemenu.el index b10d874b21..419b76101b 100644 --- a/lisp/facemenu.el +++ b/lisp/facemenu.el @@ -621,12 +621,11 @@ color. The function should accept a single argument, the color name." (downcase b)))))) (setq color (list color))) (let* ((opoint (point)) - (color-values (color-values (car color))) - (light-p (>= (apply 'max color-values) - (* (car (color-values "white")) .5)))) + (fg (readable-foreground-color (car color)))) (insert (car color)) (indent-to 22) - (put-text-property opoint (point) 'face `(:background ,(car color))) + (put-text-property opoint (point) 'face `(:background ,(car color) + :foreground ,fg)) (put-text-property (prog1 (point) (insert " ") @@ -639,7 +638,7 @@ color. The function should accept a single argument, the color name." (insert (propertize (apply 'format "#%02x%02x%02x" (mapcar (lambda (c) (ash c -8)) - color-values)) + (color-values (car color)))) 'mouse-face 'highlight 'help-echo (let ((hsv (apply 'color-rgb-to-hsv @@ -651,7 +650,7 @@ color. The function should accept a single argument, the color name." opoint (point) 'follow-link t 'mouse-face (list :background (car color) - :foreground (if light-p "black" "white")) + :foreground fg) 'color-name (car color) 'action callback-fn))) (insert "\n")) diff --git a/lisp/faces.el b/lisp/faces.el index f4a9dedd79..5ecc256f07 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1785,16 +1785,35 @@ with the color they represent as background color." (defined-colors frame))) (defun readable-foreground-color (color) - "Return a readable foreground color for background COLOR." - (let* ((rgb (color-values color)) - (max (apply #'max rgb)) - (black (car (color-values "black"))) - (white (car (color-values "white")))) - ;; Select black or white depending on which one is less similar to - ;; the brightest component. - (if (> (abs (- max black)) (abs (- max white))) - "black" - "white"))) + "Return a readable foreground color for background COLOR. +The returned value is a string representing black or white, depending +on which one provides better contrast with COLOR." + ;; We use #ffffff instead of "white", because the latter is sometimes + ;; less than white. That way, we get the best contrast possible. + (if (color-dark-p (mapcar (lambda (c) (/ c 65535.0)) color)) + "#ffffff" "black")) + +(defun color-dark-p (rgb) + "Whether RGB is more readable against white than black. +RGB is a 3-element list (R G B), each component in the range [0,1]. +This predicate can be used both for determining a suitable (black or white) +contrast colour with RGB as background and as foreground." + (unless (<= 0 (apply #'min rgb) (apply #'max rgb) 1) + (error "RGB components %S not in [0,1]" rgb)) + ;; Compute the relative luminance after gamma-correcting (assuming sRGB), + ;; and compare to a cut-off value determined experimentally. + ;; See https://en.wikipedia.org/wiki/Relative_luminance for details. + (let* ((sr (nth 0 rgb)) + (sg (nth 1 rgb)) + (sb (nth 2 rgb)) + ;; Gamma-correct the RGB components to linear values. + ;; Use the power 2.2 as an approximation to sRGB gamma; + ;; it should be good enough for the purpose of this function. + (r (expt sr 2.2)) + (g (expt sg 2.2)) + (b (expt sb 2.2)) + (y (+ (* r 0.2126) (* g 0.7152) (* b 0.0722)))) + (< y (eval-when-compile (expt 0.6 2.2))))) (declare-function xw-color-defined-p "xfns.c" (color &optional frame)) diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 0035c5e7b0..2cd99787e8 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -1149,17 +1149,6 @@ returns, point will be at the end of the recognized color." ;; Evaluate to the color if the name is found. ((css--named-color start-point match)))) -(defun css--contrasty-color (name) - "Return a color that contrasts with NAME. -NAME is of any form accepted by `color-distance'. -The returned color will be usable by Emacs and will contrast -with NAME; in particular so that if NAME is used as a background -color, the returned color can be used as the foreground and still -be readable." - ;; See bug#25525 for a discussion of this. - (if (> (color-distance name "black") 292485) - "black" "white")) - (defcustom css-fontify-colors t "Whether CSS colors should be fontified using the color as the background. When non-`nil', a text representing CSS color will be fontified @@ -1199,7 +1188,8 @@ START and END are buffer positions." (add-text-properties start (point) (list 'face (list :background color - :foreground (css--contrasty-color color) + :foreground (readable-foreground-color + color) :box '(:line-width -1)))))))))))) extended-region)) commit b19259c8412ee2e715c4bd145711e23729411fd0 Author: Michael Albinus Date: Wed Jun 10 19:36:53 2020 +0200 Futher tramp-crypt implementation and documentation * doc/misc/tramp.texi (Top, Configuration): Insert section `Keeping files encrypted' in menu. (Keeping files encrypted): New node. * lisp/net/tramp-crypt.el (tramp-crypt-file-name-handler-alist): Add `tramp-set-file-uid-gid'. (tramp-crypt-maybe-open-connection): Simplify. (tramp-crypt-do-encrypt-or-decrypt-file): Use `binary' coding system. (tramp-crypt-handle-set-file-uid-gid): New defun. * test/lisp/net/tramp-tests.el (tramp-test09-insert-file-contents): Adapt test. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index d1688deb1b..176d3a5b1e 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -141,6 +141,7 @@ Configuring @value{tramp} for use * Remote shell setup:: Remote shell setup hints. * Android shell setup:: Android shell setup hints. * Auto-save and Backup:: Auto-save and Backup. +* Keeping files encrypted:: Protect remote files by encryption. * Windows setup hints:: Issues with Cygwin ssh. Using @value{tramp} @@ -667,6 +668,7 @@ might be used in your init file: * Remote shell setup:: Remote shell setup hints. * Android shell setup:: Android shell setup hints. * Auto-save and Backup:: Auto-save and Backup. +* Keeping files encrypted:: Protect remote files by encryption. * Windows setup hints:: Issues with Cygwin ssh. @end menu @@ -2648,6 +2650,114 @@ auto-saved files to the same directory as the original file. Alternatively, set the user option @code{tramp-auto-save-directory} to direct all auto saves to that location. + +@node Keeping files encrypted +@section Protect remote files by encryption +@cindex Encrypt remote directories + +Sometimes, it is desirable to protect files located on remote +directories, like cloud storages. In order to do this, you might +instruct @value{tramp} to encrypt all files copied to a given remote +directory, and to decrypt such files when accessing. This includes +both file contents and file names. + +@value{tramp} does this transparently. Although both files and file +names are encrypted on the remote side, they are accessible inside +Emacs as they wouldn't be transformed as such. + +@cindex @command{encfs} +@cindex @command{encfsctl} +Internally, @value{tramp} uses the @command{encfs} package. +Therefore, this feature is available only if this package is installed +on the local host. @value{tramp} does not keep and @samp{encfs +mountpoint} permanently. Instead, it encrypts / decrypts files and +file names on the fly, using @command{encfsctl}. + +@deffn Command tramp-crypt-add-directory name +This command marks the existing remote directory @var{name} for +encryption. Files in that directory and all subdirectories will be +encrypted before copying to, and decrypted after copying from that +directory. File and directory names will be also encrypted. +@end deffn + +@defopt tramp-crypt-encfs-option +If a remote directory is marked for encryption, it is initialized via +@command{encfs} the very first time a file in this directory is +accessed. This user option controls, which default @command{encfs} +configuration option will be selected, it can be @t{"--standard"} +or @t{"--paranoia"}. See the @samp{encfs(1)} man page for details. + +However, @value{tramp} must adapt these configuration sets. The +@code{chainedNameIV} configuration option must be disabled; otherwise +@value{tramp} couldn't handle file name encryption transparently. +@end defopt + +A password protected @option{encfs} configuration file is created the +very first time you access an encrypted remote directory. It is kept +in your @code{user-emacs-directory} with the url-encoded directory +name as part of the basename, and @file{encfs6.xml} as suffix. If +you, for example, mark the remote directory +@file{@trampfn{nextcloud,user@@host,/path/to/dir}} for encryption, the +configuration file is saved as +@file{tramp-%2Fnextcloud%3Auser%40host%3A%2Fpath%2Fto%2Fdir%2F.encfs6.xml} +in @code{user-emacs-directory}. Do not loose this file and the +corresponding password; otherwise there is no way to decrypt your +encrypted files. + +@defopt tramp-crypt-save-encfs-config-remote +If this user option is non-nil (the default), the @option{encfs} +configuration file @file{.encfs6.xml} is also kept in the encrypted +remote directory. It depends on you, whether you regard the password +protection of this file as sufficient. The advantage would be, that +such a remote directory could be accessed by different Emacs sessions, +different users, without presharing the configuration file between the +users. +@end defopt + +The command @command{encfsctl}, the workhorse for encryption / +decryption, needs the configuration file password every call. +Therefore, it is recommend to cache this password in Emacs. This can +be done using @code{auth-sources}, @ref{Using an authentication file}. +An entry needs the url-encoded directory name as machine, your local +user name as user, and the password. The port is optional, if given +it must be the string @t{"crypt"}. The example above would require +the following entry in the authentication file (@t{"yourname"} is the +result of @code{(user-login-name)}): + +@example +machine %2Fnextcloud%3Auser%40host%3A%2Fpath%2Fto%2Fdir%2F \ + login yourname port crypt password geheim +@end example + +If you use a remote file name with a quoted localname part, this +localname and the corresponding file will not be encrypted / +decrypted. If you have an encrypted remote directory +@file{@trampfn{nextcloud,user@@host,/path/to/dir}}, the command + +@example +@kbd{C-x d @trampfn{nextcloud,user@@host,/path/to/dir}} +@end example + +@noindent +will show the directory listing with the plain file names, and the +command + +@example +@kbd{C-x d @trampfn{nextcloud,user@@host,/:/path/to/dir}} +@end example + +@noindent +will show the directory listing with the encrypted file names, and +visiting a file will show its encrypted contents. However, it is +highly discouraged to mix encrypted and not encrypted files in the +same directory. + +@deffn Command tramp-crypt-add-directory name +If a remote directory shall not include encrypted files anymore, it +must be indicated by this command. +@end deffn + + @node Windows setup hints @section Issues with Cygwin ssh @cindex cygwin, issues @@ -2681,10 +2791,10 @@ Wiki} it is explained how to use the helper program @cindex @option{scpx} method with cygwin When using the @option{scpx} access method, Emacs may call -@command{scp} with MS Windows file naming, such as @code{c:/foo}. But +@command{scp} with MS Windows file naming, such as @file{c:/foo}. But the version of @command{scp} that is installed with Cygwin does not know about MS Windows file naming, which causes it to incorrectly look -for a host named @code{c}. +for a host named @samp{c}. A workaround: write a wrapper script for @option{scp} to convert Windows file names to Cygwin file names. @@ -4158,8 +4268,8 @@ Host * @end group @end example -Check @command{man ssh_config} whether these options are supported on -your proxy host. +Check the @samp{ssh_config(5)} man page whether these options are +supported on your proxy host. @item diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index d9ba2e49f7..664f441347 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -44,11 +44,11 @@ ;; 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, +;; is also kept in the crypted remote directory. It depends on you, ;; whether you regard the password protection of this file as ;; sufficient. -;; If you apply an operation with a quoted localname part, this +;; If you use a remote file name 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 @@ -213,7 +213,7 @@ If NAME doesn't belong to a crypted remote directory, retun nil." (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. + (tramp-set-file-uid-gid . tramp-crypt-handle-set-file-uid-gid) ;; (unhandled-file-name-directory . ignore) (vc-registered . ignore) (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) @@ -334,7 +334,6 @@ connection if a previous connection has died for some reason." (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"))) @@ -427,9 +426,9 @@ If OP ist `decrypt', the basename of INFILE must be an encrypted file name." (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)) + (if (eq op 'decrypt) 'binary coding-system-for-read)) (coding-system-for-write - (if (eq op 'encrypt) 'raw-text coding-system-for-write))) + (if (eq op 'encrypt) 'binary coding-system-for-write))) (tramp-crypt-send-command crypt-vec "cat" (and (eq op 'encrypt) "--reverse") (file-name-directory infile) @@ -759,6 +758,14 @@ absolute file names." (tramp-compat-set-file-times (tramp-crypt-encrypt-file-name filename) time flag)))) +(defun tramp-crypt-handle-set-file-uid-gid (filename &optional uid gid) + "Like `tramp-set-file-uid-gid' for Tramp files." + (with-parsed-tramp-file-name filename nil + (tramp-flush-file-properties v localname) + (let (tramp-crypt-enabled) + (tramp-set-file-uid-gid + (tramp-crypt-encrypt-file-name filename) uid gid)))) + (add-hook 'tramp-unload-hook (lambda () (unload-feature 'tramp-crypt 'force))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index d578c359d7..578da4171c 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2294,16 +2294,25 @@ This checks also `file-name-as-directory', `file-name-directory', (unwind-protect (with-temp-buffer (write-region "foo" nil tmp-name) - (insert-file-contents tmp-name) - (should (string-equal (buffer-string) "foo")) - (insert-file-contents tmp-name) - (should (string-equal (buffer-string) "foofoo")) + (let ((point (point))) + (insert-file-contents tmp-name) + (should (string-equal (buffer-string) "foo")) + (should (= point (point)))) + (goto-char (1+ (point))) + (let ((point (point))) + (insert-file-contents tmp-name) + (should (string-equal (buffer-string) "ffoooo")) + (should (= point (point)))) ;; Insert partly. - (insert-file-contents tmp-name nil 1 3) - (should (string-equal (buffer-string) "oofoofoo")) + (let ((point (point))) + (insert-file-contents tmp-name nil 1 3) + (should (string-equal (buffer-string) "foofoooo")) + (should (= point (point)))) ;; Replace. - (insert-file-contents tmp-name nil nil nil 'replace) - (should (string-equal (buffer-string) "foo")) + (let ((point (point))) + (insert-file-contents tmp-name nil nil nil 'replace) + (should (string-equal (buffer-string) "foo")) + (should (= point (point)))) ;; Error case. (delete-file tmp-name) (should-error commit ee8b2742d7f6d03daea37f1bac48c2746f7ca789 Author: Philipp Stephani Date: Wed Jun 10 15:49:57 2020 +0200 ; * test/lisp/emacs-lisp/generator-tests.el: Checkdoc fixes diff --git a/test/lisp/emacs-lisp/generator-tests.el b/test/lisp/emacs-lisp/generator-tests.el index 0d325f1485..bcfab20163 100644 --- a/test/lisp/emacs-lisp/generator-tests.el +++ b/test/lisp/emacs-lisp/generator-tests.el @@ -26,6 +26,8 @@ (require 'ert) (require 'cl-lib) +;;; Code: + (defun generator-list-subrs () (cl-loop for x being the symbols when (and (fboundp x) @@ -38,8 +40,7 @@ `cps-testcase' defines an ERT testcase called NAME that evaluates BODY twice: once using ordinary `eval' and once using lambda-generators. The test ensures that the two forms produce -identical output. -" +identical output." `(progn (ert-deftest ,name () (should @@ -302,3 +303,5 @@ identical output. (lambda (it) (- it)) (1+ it))))))) -2))) + +;;; generator-tests.el ends here commit 00f4b7215c63b02171d0a5c48d3da802a202463e Author: Philipp Stephani Date: Wed Jun 10 15:46:12 2020 +0200 Slightly improve commit 73be4d1ed5b190bd93e9bad6aebe43d0dea0d7d3. * lisp/emacs-lisp/cl-macs.el (cl-lambda-list, cl-lambda-list1) (cl-macro-list, cl-macro-list1): Use exactly the same specification as for &optional (sans the third optional list element). diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 45e814e859..a3e72c4b00 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -199,7 +199,7 @@ The name is made by appending a number to PREFIX, default \"T\"." [&optional ["&key" [cl-&key-arg &rest cl-&key-arg] &optional "&allow-other-keys"]] [&optional ["&aux" &rest - &or (cl-lambda-arg &optional def-form) cl-lambda-arg]] + &or (cl-lambda-arg &optional def-form) arg]] . [&or arg nil]))) (def-edebug-spec cl-&optional-arg @@ -219,7 +219,7 @@ The name is made by appending a number to PREFIX, default \"T\"." [&optional ["&key" cl-&key-arg &rest cl-&key-arg &optional "&allow-other-keys"]] [&optional ["&aux" &rest - &or (cl-lambda-arg &optional def-form) cl-lambda-arg]] + &or (cl-lambda-arg &optional def-form) arg]] . [&or arg nil]))) (def-edebug-spec cl-type-spec sexp) @@ -402,7 +402,7 @@ and BODY is implicitly surrounded by (cl-block NAME ...). arg]] &optional "&allow-other-keys"]] [&optional ["&aux" &rest - &or (cl-lambda-arg &optional def-form) cl-lambda-arg]] + &or (cl-macro-arg &optional def-form) arg]] [&optional "&environment" arg] ))) @@ -421,7 +421,7 @@ and BODY is implicitly surrounded by (cl-block NAME ...). arg]] &optional "&allow-other-keys"]] [&optional ["&aux" &rest - &or (cl-lambda-arg &optional def-form) cl-lambda-arg]] + &or (cl-macro-arg &optional def-form) arg]] . [&or arg nil]))) ;;;###autoload commit 73be4d1ed5b190bd93e9bad6aebe43d0dea0d7d3 Author: Philipp Stephani Date: Wed Jun 10 15:34:41 2020 +0200 Allow destructuring in &aux sections when using edebug (Bug#40431) * lisp/emacs-lisp/cl-macs.el (cl-lambda-list, cl-lambda-list1) (cl-macro-list, cl-macro-list1): Allow arbitrary 'cl-lambda' arguments in the &aux section. * test/lisp/emacs-lisp/cl-macs-tests.el (cl-macs-aux-edebug): New regression test. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 3317c58002..45e814e859 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -199,7 +199,7 @@ The name is made by appending a number to PREFIX, default \"T\"." [&optional ["&key" [cl-&key-arg &rest cl-&key-arg] &optional "&allow-other-keys"]] [&optional ["&aux" &rest - &or (symbolp &optional def-form) symbolp]] + &or (cl-lambda-arg &optional def-form) cl-lambda-arg]] . [&or arg nil]))) (def-edebug-spec cl-&optional-arg @@ -219,7 +219,7 @@ The name is made by appending a number to PREFIX, default \"T\"." [&optional ["&key" cl-&key-arg &rest cl-&key-arg &optional "&allow-other-keys"]] [&optional ["&aux" &rest - &or (symbolp &optional def-form) symbolp]] + &or (cl-lambda-arg &optional def-form) cl-lambda-arg]] . [&or arg nil]))) (def-edebug-spec cl-type-spec sexp) @@ -402,7 +402,7 @@ and BODY is implicitly surrounded by (cl-block NAME ...). arg]] &optional "&allow-other-keys"]] [&optional ["&aux" &rest - &or (symbolp &optional def-form) symbolp]] + &or (cl-lambda-arg &optional def-form) cl-lambda-arg]] [&optional "&environment" arg] ))) @@ -421,7 +421,7 @@ and BODY is implicitly surrounded by (cl-block NAME ...). arg]] &optional "&allow-other-keys"]] [&optional ["&aux" &rest - &or (symbolp &optional def-form) symbolp]] + &or (cl-lambda-arg &optional def-form) cl-lambda-arg]] . [&or arg nil]))) ;;;###autoload diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index 24bbad0cc6..29ae95e277 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -601,4 +601,13 @@ collection clause." collect y into result1 finally return (equal (nreverse result) result1)))) +(ert-deftest cl-macs-aux-edebug () + "Check that Bug#40431 is fixed." + (with-temp-buffer + (prin1 '(cl-defun cl-macs-aux-edebug-test-fun (&aux ((a . b) '(1 . 2))) + (list a b)) + (current-buffer)) + ;; Just make sure the function can be instrumented. + (edebug-defun))) + ;;; cl-macs-tests.el ends here