commit 6c0f1c26d296132e37b2508a00efc73f3df95b0c (HEAD, refs/remotes/origin/master) Author: Stefan Monnier Date: Wed Sep 30 05:43:07 2020 +0200 Don't have C-x = bug out in a "C" locale with non-ASCII chars * lisp/simple.el (what-cursor-position): Ensure that we always have a coding system here, even if the locale is "C" (bug#40702). diff --git a/lisp/simple.el b/lisp/simple.el index 6bc41961eb..fef22c2fa6 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1533,7 +1533,11 @@ in *Help* buffer. See also the command `describe-char'." encoded encoding-msg display-prop under-display) (if (or (not coding) (eq (coding-system-type coding) t)) - (setq coding (default-value 'buffer-file-coding-system))) + (setq coding (or (default-value 'buffer-file-coding-system) + ;; A nil value of `buffer-file-coding-system' + ;; means "no conversion" which means each byte + ;; is a char and vice versa. + 'binary))) (if (eq (char-charset char) 'eight-bit) (setq encoding-msg (format "(%d, #o%o, #x%x%s, raw-byte)" char char char char-name-fmt)) commit fcdcdea324f32f63a25e4869e2e7c62293407421 Author: Lars Ingebrigtsen Date: Wed Sep 30 05:05:04 2020 +0200 Fix whitespace regexp in gnus-base64-repad * lisp/gnus/gnus-util.el (gnus-base64-repad): Fix the whitespace regexp. diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index e98af10e1a..0e15ebce6c 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -1368,7 +1368,7 @@ CRLF (RFC 5321 SMTP)." ;; input (3.1, 3.3) ;; - if line-length is set, error on input exceeding the limit (3.1) ;; - reject characters outside base encoding (3.3, also section 12) - (let ((splitstr (split-string str "\\s-+" t))) + (let ((splitstr (split-string str "[\n\r \t]+" t))) (when (and reject-newlines (> (length splitstr) 1)) (error "Invalid Base64 string")) (dolist (substr splitstr) commit 1993c4e300a455d4c40703e117ae0dd578c4eeed Author: Lars Ingebrigtsen Date: Wed Sep 30 05:03:35 2020 +0200 Fix gnus-base64-repad test failures diff --git a/test/lisp/gnus/gnus-util-tests.el b/test/lisp/gnus/gnus-util-tests.el index ed33be46a3..ec58032e84 100644 --- a/test/lisp/gnus/gnus-util-tests.el +++ b/test/lisp/gnus/gnus-util-tests.el @@ -151,10 +151,8 @@ (should (equal "Zg==" (gnus-base64-repad "Zg"))) (should (equal "Zg==" (gnus-base64-repad "Zg===="))) - (should-error (gnus-base64-repad " ") - :type 'error) - (should-error (gnus-base64-repad "Zg== ") - :type 'error) + (should (equal (gnus-base64-repad " ") "")) + (should (equal (gnus-base64-repad "Zg== ") "Zg==")) (should-error (gnus-base64-repad "Z?\x00g==") :type 'error) ;; line-length @@ -166,8 +164,7 @@ (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9vYmFy" t))) (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9v\r\nYmFy" nil))) (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9v\r\nYmFy\n" nil))) - (should-error (gnus-base64-repad "Zm9v\r\n YmFy\r\n" nil) - :type 'error) + (should (equal (gnus-base64-repad "Zm9v\r\n YmFy\r\n" nil) "Zm9vYmFy")) (should-error (gnus-base64-repad "Zm9v\r\nYmFy" nil 3) :type 'error)) commit 52afb2b1041e2ebbefbe77e8689b141cfc3df5a0 Author: Stefan Monnier Date: Tue Sep 29 22:28:23 2020 -0400 * lisp/emacs-lisp/cl-macs.el (hash-table): Define the type's typep test diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index c38019d4a7..19cdbd7aeb 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3152,6 +3152,7 @@ Of course, we really can't know that for sure, so it's just a heuristic." (buffer . bufferp) (character . natnump) (char-table . char-table-p) + (hash-table . hash-table-p) (cons . consp) (fixnum . integerp) (float . floatp) commit a90bfc5f3be67f7075247c19468321b25780206d Author: Lars Ingebrigtsen Date: Wed Sep 30 04:06:28 2020 +0200 Fix isearch-group-* colours on low-colour displays * lisp/isearch.el (isearch-group-1): On low-colour displays, just use the normal isearch colour (bug#43702). (isearch-group-2 etc): Ditto. diff --git a/lisp/isearch.el b/lisp/isearch.el index 0053c4dd8a..4e964b325c 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -3665,91 +3665,91 @@ since they have special meaning in a regexp." (defvar isearch-submatches-overlays nil) (defface isearch-group-1 - '((((class color) (background light)) + '((((class color) (min-colors 88) (background light)) (:background "#ff00ff" :foreground "lightskyblue1")) - (((class color) (background dark)) + (((class color) (min-colors 88) (background dark)) (:background "palevioletred3" :foreground "brown4")) - (t (:inverse-video t))) + (t (:inherit isearch))) "Face for highlighting Isearch sub-group matches (first sub-group)." :group 'isearch :version "28.1") (defface isearch-group-2 - '((((class color) (background light)) + '((((class color) (min-colors 88) (background light)) (:background "#d000d0" :foreground "lightskyblue1")) - (((class color) (background dark)) + (((class color) (min-colors 88) (background dark)) (:background "#be698f" :foreground "black")) - (t (:inverse-video t))) + (t (:inherit isearch))) "Face for highlighting Isearch sub-group matches (second sub-group)." :group 'isearch :version "28.1") (defface isearch-group-3 - '((((class color) (background light)) + '((((class color) (min-colors 88) (background light)) (:background "#a000a0" :foreground "lightskyblue1")) - (((class color) (background dark)) + (((class color) (min-colors 88) (background dark)) (:background "#a06080" :foreground "brown4")) - (t (:inverse-video t))) + (t (:inherit isearch))) "Face for highlighting Isearch sub-group matches (third sub-group)." :group 'isearch :version "28.1") (defface isearch-group-4 - '((((class color) (background light)) + '((((class color) (min-colors 88) (background light)) (:background "#800080" :foreground "lightskyblue1")) - (((class color) (background dark)) + (((class color) (min-colors 88) (background dark)) (:background "#905070" :foreground "brown4")) - (t (:inverse-video t))) + (t (:inherit isearch))) "Face for highlighting Isearch sub-group matches (fourth sub-group)." :group 'isearch :version "28.1") (defface isearch-group-5 - '((((class color) (background light)) + '((((class color) (min-colors 88) (background light)) (:background "#600060" :foreground "lightskyblue1")) - (((class color) (background dark)) + (((class color) (min-colors 88) (background dark)) (:background "#804060" :foreground "black")) - (t (:inverse-video t))) + (t (:inherit isearch))) "Face for highlighting Isearch sub-group matches (fifth sub-group)." :group 'isearch :version "28.1") (defface isearch-group-6 - '((((class color) (background light)) + '((((class color) (min-colors 88) (background light)) (:background "#500050" :foreground "lightskyblue1")) - (((class color) (background dark)) + (((class color) (min-colors 88) (background dark)) (:background "#703050" :foreground "white")) - (t (:inverse-video t))) + (t (:inherit isearch))) "Face for highlighting Isearch sub-group matches (sixth sub-group)." :group 'isearch :version "28.1") (defface isearch-group-7 - '((((class color) (background light)) + '((((class color) (min-colors 88) (background light)) (:background "#400040" :foreground "lightskyblue1")) - (((class color) (background dark)) + (((class color) (min-colors 88) (background dark)) (:background "#602050" :foreground "white")) - (t (:inverse-video t))) + (t (:inherit isearch))) "Face for highlighting Isearch sub-group matches (seventh sub-group)." :group 'isearch :version "28.1") (defface isearch-group-8 - '((((class color) (background light)) + '((((class color) (min-colors 88) (background light)) (:background "#300030" :foreground "lightskyblue1")) - (((class color) (background dark)) + (((class color) (min-colors 88) (background dark)) (:background "#501050" :foreground "white")) - (t (:inverse-video t))) + (t (:inherit isearch))) "Face for highlighting Isearch sub-group matches (eighth sub-group)." :group 'isearch :version "28.1") (defface isearch-group-9 - '((((class color) (background light)) + '((((class color) (min-colors 88) (background light)) (:background "#200020" :foreground "lightskyblue1")) - (((class color) (background dark)) + (((class color) (min-colors 88) (background dark)) (:background "#400040" :foreground "white")) - (t (:inverse-video t))) + (t (:inherit isearch))) "Face for highlighting Isearch sub-group matches (ninth sub-group)." :group 'isearch :version "28.1") commit fda8c53309d00de85da644e6149d10eb8d85b790 Author: Lars Ingebrigtsen Date: Wed Sep 30 03:52:18 2020 +0200 define-generic-mode doc string fix * lisp/emacs-lisp/generic.el (define-generic-mode): Say what a generic mode is (bug#43713). diff --git a/lisp/emacs-lisp/generic.el b/lisp/emacs-lisp/generic.el index 06ef580056..a9328a6903 100644 --- a/lisp/emacs-lisp/generic.el +++ b/lisp/emacs-lisp/generic.el @@ -116,6 +116,10 @@ instead (which see).") function-list &optional docstring) "Create a new generic mode MODE. +A \"generic\" mode is a simple major mode with basic support for +comment syntax and Font Lock mode, but otherwise do not have a +any special keystrokes or functionality available. + MODE is the name of the command for the generic mode; don't quote it. The optional DOCSTRING is the documentation for the mode command. If you do not supply it, `define-generic-mode' uses a default commit e608477da2ff300bbc7796bd3c1a42394d1f1148 Author: Lars Ingebrigtsen Date: Wed Sep 30 03:47:47 2020 +0200 Give better error feedback on wrong password in .gpg files * lisp/epa-file.el (epa-file--find-file-not-found-function): Do a user-error when there's a wrong password (bug#43704). (epa--wrong-password-p): New function. (epa-file-insert-file-contents): Use it, and stash the error away for later signalling. * lisp/emacs-lisp/subr-x.el (if-let): Autoload. diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 9f96ac50d1..e6abb39ddc 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -156,6 +156,7 @@ are non-nil, then the result is non-nil." ,@(or body `(,res)))) `(let* () ,@(or body '(t)))))) +;;;###autoload (defmacro if-let (spec then &rest else) "Bind variables according to SPEC and evaluate THEN or ELSE. Evaluate each binding in turn, as in `let*', stopping if a diff --git a/lisp/epa-file.el b/lisp/epa-file.el index bb027b9abf..7fd4178474 100644 --- a/lisp/epa-file.el +++ b/lisp/epa-file.el @@ -26,6 +26,7 @@ (require 'epa) (require 'epa-hook) +(eval-when-compile (require 'subr-x)) ;;; Options @@ -115,8 +116,17 @@ encryption is used." (let ((error epa-file-error)) (save-window-excursion (kill-buffer)) - (signal 'file-missing - (cons "Opening input file" (cdr error))))) + (if (nth 3 error) + (user-error "Wrong passphrase: %s" (nth 3 error)) + (signal 'file-missing + (cons "Opening input file" (cdr error)))))) + +(defun epa--wrong-password-p (context) + (let ((error-string (epg-context-error-output context))) + (and (string-match + "decryption failed: \\(Bad session key\\|No secret key\\)" + error-string) + (match-string 1 error-string)))) (defvar last-coding-system-used) (defun epa-file-insert-file-contents (file &optional visit beg end replace) @@ -159,7 +169,12 @@ encryption is used." (nth 3 error))) (let ((exists (file-exists-p local-file))) (when exists - (epa-display-error context) + (if-let ((wrong-password (epa--wrong-password-p context))) + ;; Don't display the *error* buffer if we just + ;; have a wrong password; let the later error + ;; handler notify the user. + (setq error (append error (list wrong-password))) + (epa-display-error context)) ;; When the .gpg file isn't an encrypted file (e.g., ;; it's a keyring.gpg file instead), then gpg will ;; say "Unexpected exit" as the error message. In commit 818270286222bd90b9b0c27e703252c655adfb21 Author: Thomas Fitzsimmons Date: Tue Sep 29 17:33:21 2020 -0400 soap-client: Bump version to 3.2.0 * lisp/net/soap-client.el: Bump version to 3.2.0. diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el index b5674294f1..f07d214e12 100644 --- a/lisp/net/soap-client.el +++ b/lisp/net/soap-client.el @@ -5,7 +5,7 @@ ;; Author: Alexandru Harsanyi ;; Author: Thomas Fitzsimmons ;; Created: December, 2009 -;; Version: 3.1.5 +;; Version: 3.2.0 ;; Keywords: soap, web-services, comm, hypermedia ;; Package: soap-client ;; Homepage: https://github.com/alex-hhh/emacs-soap-client commit 2742bdb6f437702ba11d11319d76cb4693732455 Author: Thomas Fitzsimmons Date: Tue Sep 29 17:30:04 2020 -0400 soap-client: Remove FIXME comment * lisp/net/soap-client.el (soap-encode-attributes): Remove cl-defmethod FIXME comment; continue supporting Emacs 24.1. diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el index 8b5ac613b3..b5674294f1 100644 --- a/lisp/net/soap-client.el +++ b/lisp/net/soap-client.el @@ -2996,8 +2996,6 @@ reference multiRef parts which are external to RESPONSE-NODE." ;;;; SOAP type encoding -;; FIXME: Use `cl-defmethod' (but this requires Emacs-25). - (defun soap-encode-attributes (value type) "Encode XML attributes for VALUE according to TYPE. This is a generic function which determines the attribute encoder commit e7670a3ce02dfb4bfe7e94aa02f7171ec0598ef5 Author: Thomas Fitzsimmons Date: Tue Sep 29 17:15:40 2020 -0400 soap-client: Update soap-decode-date-time * lisp/net/soap-client.el (soap-decode-date-time): Add support for Emacs versions that support fractional seconds. Make DATATYPE optional. Remove FIXME comment. Co-authored-by: Paul Eggert diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el index 81bbc336dc..8b5ac613b3 100644 --- a/lisp/net/soap-client.el +++ b/lisp/net/soap-client.el @@ -551,30 +551,77 @@ This is a specialization of `soap-encode-value' for (soap-validate-xs-basic-type value-string type) (insert value-string))))) -;; Inspired by rng-xsd-convert-date-time. -(defun soap-decode-date-time (date-time-string datatype) +(defun soap-decode-date-time (date-time-string &optional datatype) "Decode DATE-TIME-STRING as DATATYPE. DATE-TIME-STRING should be in ISO 8601 basic or extended format. -DATATYPE is one of dateTime, time, date, gYearMonth, gYear, -gMonthDay, gDay or gMonth. - -Return a list in a format (SEC MINUTE HOUR DAY MONTH YEAR -SEC-FRACTION DATATYPE ZONE). This format is meant to be similar -to that returned by `decode-time' (and compatible with -`encode-time'). The differences are the SEC (seconds) -field is always an integer, the DOW (day-of-week) field -is replaced with SEC-FRACTION, a float representing the -fractional seconds, and the DST (daylight savings time) field is -replaced with DATATYPE, a symbol representing the XSD primitive -datatype. This symbol can be used to determine which fields -apply and which don't when it's not already clear from context. -For example a datatype of `time' means the year, month and day +DATATYPE can be omitted, or one of the symbols dateTime, time, +date, gYearMonth, gYear, gMonthDay, gDay, or gMonth. If Emacs is +a version that supports fractional seconds, DATATYPE can also be +dateTime-subsecond, or time-subsecond. On older versions of +Emacs (prior to 27.1), which do not support fractional seconds, +leaving DATATYPE nil means that subseconds in DATE-TIME-STRING +will be ignored. + +Return a list in a format identical or similar to that returned +by `decode-time'. The returned format is always compatible with +`encode-time'. If DATATYPE is omitted or nil, this function will +return a list that has exactly the same format as that returned +by `decode-time'. + +Note that on versions of Emacs that predate support for +fractional seconds, `encode-time' will not notice the SUBSECOND +field so it must be handled specially. + +The formats returned by this function are as follows, where _ +means \"should be ignored\": + + DATATYPE | Return format +------------+---------------------------------------------------------------- + nil | (SECOND MINUTE HOUR DAY MONTH YEAR DOW DST UTCOFF) + dateTime | (SECOND MINUTE HOUR DAY MONTH YEAR SUBSECOND dateTime UTCOFF) + time | (SECOND MINUTE HOUR _ _ _ SUBSECOND time _) + date | (_ _ _ DAY MONTH YEAR _ date _) + gYearMonth | (_ _ _ _ MONTH YEAR _ gYearMonth _) + gYear | (_ _ _ _ _ YEAR _ gYear _) + gMonthDay | (_ _ _ DAY MONTH _ _ gMonthDay _) + gDay | (_ _ _ DAY _ _ _ gDay _) + gMonth | (_ _ _ _ MONTH _ _ gMonth _) + +When DATATYPE is dateTime or time, the DOW (day-of-week) field is +replaced with SUBSECOND, a float representing the fractional +seconds, and the DST (daylight savings time) field is replaced +with DATATYPE, a symbol representing the XSD primitive datatype. +This symbol can be used to determine which fields apply and which +do not, when it is not already clear from context. For example a +datatype of `time' means the year, month, day and time zone fields should be ignored. -This function will throw an error if DATE-TIME-STRING represents -a leap second, since the XML Schema 1.1 standard explicitly -disallows them." - (let* ((datetime-regexp (cadr (get datatype 'rng-xsd-convert))) +New code that depends on Emacs 27.1 or newer anyway, and that +wants dateTime or time but with the first argument with subsecond +resolution, i.e., (TICKS . HZ), can set DATATYPE to +dateTime-subsecond or time-subsecond respectively. This function +throws an error if dateTime-subsecond or time-subsecond is +specified when Emacs does not support subsecond resolution. + +This function throws an error if DATE-TIME-STRING represents a +leap second, since the XML Schema 1.1 standard does not support +representing leap seconds." + (let* ((new-decode-time (condition-case nil + (not (null + (with-no-warnings (decode-time nil nil t)))) + (wrong-number-of-arguments))) + (new-decode-time-second nil) + (no-support "This Emacs version does not support %s") + (datetime-regexp-type + (cl-case datatype + ((dateTime-subsecond time-subsecond) + (if new-decode-time + (intern (replace-regexp-in-string + "-subsecond" "" (symbol-name datatype))) + (error (format no-support (symbol-name datatype))))) + ((nil) 'dateTime) + (otherwise datatype))) + (datetime-regexp (cadr (get datetime-regexp-type 'rng-xsd-convert))) (year-sign (progn (string-match datetime-regexp date-time-string) (match-string 1 date-time-string))) @@ -585,6 +632,7 @@ disallows them." (minute (match-string 6 date-time-string)) (second (match-string 7 date-time-string)) (second-fraction (match-string 8 date-time-string)) + (time-zone nil) (has-time-zone (match-string 9 date-time-string)) (time-zone-sign (match-string 10 date-time-string)) (time-zone-hour (match-string 11 date-time-string)) @@ -605,11 +653,28 @@ disallows them." (if hour (string-to-number hour) 0)) (setq minute (if minute (string-to-number minute) 0)) + (when new-decode-time + (setq new-decode-time-second + (if second + (if second-fraction + (let* ((second-fraction-significand + (replace-regexp-in-string "\\." "" second-fraction)) + (hertz + (expt 10 (length second-fraction-significand))) + (ticks (+ (* hertz (string-to-number second)) + (string-to-number + second-fraction-significand)))) + (cons ticks hertz)) + (cons second 1))))) (setq second (if second (string-to-number second) 0)) (setq second-fraction (if second-fraction - (float (string-to-number second-fraction)) + (progn + (when (and (not datatype) (not new-decode-time)) + (message + "soap-decode-date-time: Discarding fractional seconds")) + (float (string-to-number second-fraction))) 0.0)) (setq has-time-zone (and has-time-zone t)) (setq time-zone-sign @@ -618,6 +683,14 @@ disallows them." (if time-zone-hour (string-to-number time-zone-hour) 0)) (setq time-zone-minute (if time-zone-minute (string-to-number time-zone-minute) 0)) + (setq time-zone (if has-time-zone + (* (rng-xsd-time-to-seconds + time-zone-hour + time-zone-minute + 0) + time-zone-sign) + ;; UTC. + 0)) (unless (and ;; XSD does not allow year 0. (> year 0) @@ -635,18 +708,22 @@ disallows them." (>= time-zone-minute 0) (<= time-zone-minute 59)) (error "Invalid or unsupported time: %s" date-time-string)) - ;; Return a value in a format similar to that returned by decode-time, and - ;; suitable for (apply #'encode-time ...). - ;; FIXME: Nobody uses this idiosyncratic value. Perhaps stop returning it? - (list second minute hour day month year second-fraction datatype - (if has-time-zone - (* (rng-xsd-time-to-seconds - time-zone-hour - time-zone-minute - 0) - time-zone-sign) - ;; UTC. - 0)))) + ;; Return a value in a format identical or similar to that + ;; returned by decode-time, and always suitable for (apply + ;; #'encode-time ...). + (if datatype + (list (if (memq datatype '(dateTime-subsecond time-subsecond)) + new-decode-time-second + second) + minute hour day month year second-fraction datatype time-zone) + (let ((time + (apply + #'encode-time (list + (if new-decode-time new-decode-time-second second) + minute hour day month year nil nil time-zone)))) + (if new-decode-time + (with-no-warnings (decode-time time nil t)) + (decode-time time)))))) (defun soap-decode-xs-basic-type (type node) "Use TYPE, a `soap-xs-basic-type', to decode the contents of NODE. commit 7e45ed3a9674e9f436c337bed647ce9f60939ee0 Author: Michael Albinus Date: Tue Sep 29 19:43:02 2020 +0200 More strict D-Bus type checking * lisp/net/dbus.el (dbus-register-monitor): Register proper key. (dbus-monitor-handler): Adapt docstring. Use grave text-quoting-style. * src/dbusbind.c (xd_signature, xd_append_arg): More strict tests. (syms_of_dbusbind): Adapt docstring. * test/lisp/net/dbus-tests.el (dbus-test01-basic-types): Extend test. diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index fec9d3c7ab..23ba191e3c 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -2026,7 +2026,7 @@ either a method name, a signal name, or an error name." ;; Create a hash table entry. (setq key (list :monitor bus-private) - key1 (list nil nil nil handler) + key1 (list nil nil nil handler rule) value (gethash key dbus-registered-objects-table)) (unless (member key1 value) (puthash key (cons key1 value) dbus-registered-objects-table)) @@ -2060,8 +2060,11 @@ either a method name, a signal name, or an error name." (defun dbus-monitor-handler (&rest _args) "Default handler for the \"org.freedesktop.DBus.Monitoring.BecomeMonitor\" interface. -It will be applied for all objects created by -`dbus-register-monitor' which don't declare an own handler.." +It will be applied for all objects created by `dbus-register-monitor' +which don't declare an own handler. The printed timestamps do +not reflect the time the D-Bus message has passed the D-Bus +daemon, it is rather the timestamp the corresponding D-Bus event +has been handled by this function." (with-current-buffer (get-buffer-create "*D-Bus Monitor*") (special-mode) ;; Move forward and backward between messages. @@ -2071,6 +2074,7 @@ It will be applied for all objects created by (local-set-key (kbd "RET") #'dbus-monitor-goto-serial) (local-set-key [mouse-2] #'dbus-monitor-goto-serial) (let* ((inhibit-read-only t) + (text-quoting-style 'grave) (point (point)) (eobp (eobp)) (event last-input-event) diff --git a/src/dbusbind.c b/src/dbusbind.c index 09f0317be9..b06077d3b5 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -380,8 +380,9 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) break; case DBUS_TYPE_BOOLEAN: - /* Any non-nil object will be regarded as `t', so we don't apply - further type check. */ + /* There must be an argument. */ + if (EQ (QCboolean, object)) + wrong_type_argument (intern ("booleanp"), object); sprintf (signature, "%c", dtype); break; @@ -405,6 +406,8 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) case DBUS_TYPE_STRING: case DBUS_TYPE_OBJECT_PATH: case DBUS_TYPE_SIGNATURE: + /* We dont check the syntax of object path and signature. This + will be done by libdbus. */ CHECK_STRING (object); sprintf (signature, "%c", dtype); break; @@ -615,6 +618,9 @@ xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter) } case DBUS_TYPE_BOOLEAN: + /* There must be an argument. */ + if (EQ (QCboolean, object)) + wrong_type_argument (intern ("booleanp"), object); { dbus_bool_t val = (NILP (object)) ? FALSE : TRUE; XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true"); @@ -713,6 +719,8 @@ xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter) case DBUS_TYPE_STRING: case DBUS_TYPE_OBJECT_PATH: case DBUS_TYPE_SIGNATURE: + /* We dont check the syntax of object path and signature. + This will be done by libdbus. */ CHECK_STRING (object); { /* We need to send a valid UTF-8 string. We could encode `object' @@ -1927,11 +1935,11 @@ and for calling handlers in case of non-blocking method call returns. In the first case, the key in the hash table is the list (TYPE BUS INTERFACE MEMBER). TYPE is one of the Lisp symbols `:method', -`:signal' or `:property'. BUS is either a Lisp symbol, `:system' or -`:session', or a string denoting the bus address. INTERFACE is a -string which denotes a D-Bus interface, and MEMBER, also a string, is -either a method, a signal or a property INTERFACE is offering. All -arguments but BUS must not be nil. +`:signal', `:property' or `:monitor'. BUS is either a Lisp symbol, +`:system', `:session', `:system-private' or `:session-private', or a +string denoting the bus address. INTERFACE is a string which denotes +a D-Bus interface, and MEMBER, also a string, is either a method, a +signal or a property INTERFACE is offering. All arguments can be nil. The value in the hash table is a list of quadruple lists ((UNAME SERVICE PATH OBJECT [RULE]) ...). SERVICE is the service name as diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el index b853542a1f..74c0dddcf5 100644 --- a/test/lisp/net/dbus-tests.el +++ b/test/lisp/net/dbus-tests.el @@ -99,7 +99,10 @@ "Check basic D-Bus type arguments." (skip-unless dbus--test-enabled-session-bus) - ;; Unknown keyword. + ;; No argument or unknown keyword. + (should-error + (dbus-check-arguments :session dbus--test-service) + :type 'wrong-number-of-arguments) (should-error (dbus-check-arguments :session dbus--test-service :keyword) :type 'wrong-type-argument) @@ -107,6 +110,9 @@ ;; `:string'. (should (dbus-check-arguments :session dbus--test-service "string")) (should (dbus-check-arguments :session dbus--test-service :string "string")) + (should-error + (dbus-check-arguments :session dbus--test-service :string) + :type 'wrong-type-argument) (should-error (dbus-check-arguments :session dbus--test-service :string 0.5) :type 'wrong-type-argument) @@ -115,6 +121,10 @@ (should (dbus-check-arguments :session dbus--test-service :object-path "/object/path")) + (should-error + (dbus-check-arguments :session dbus--test-service :object-path) + :type 'wrong-type-argument) + ;; Raises an error on stdin. (should-error (dbus-check-arguments :session dbus--test-service :object-path "string") :type 'dbus-error) @@ -124,6 +134,10 @@ ;; `:signature'. (should (dbus-check-arguments :session dbus--test-service :signature "as")) + (should-error + (dbus-check-arguments :session dbus--test-service :signature) + :type 'wrong-type-argument) + ;; Raises an error on stdin. (should-error (dbus-check-arguments :session dbus--test-service :signature "string") :type 'dbus-error) @@ -136,16 +150,19 @@ (should (dbus-check-arguments :session dbus--test-service t)) (should (dbus-check-arguments :session dbus--test-service :boolean nil)) (should (dbus-check-arguments :session dbus--test-service :boolean t)) - ;; Will be handled as `nil'. - (should (dbus-check-arguments :session dbus--test-service :boolean)) - ;; Will be handled as `t'. (should (dbus-check-arguments :session dbus--test-service :boolean 'whatever)) + (should-error + (dbus-check-arguments :session dbus--test-service :boolean) + :type 'wrong-type-argument) ;; `:byte'. (should (dbus-check-arguments :session dbus--test-service :byte 0)) ;; Only the least significant byte is taken into account. (should (dbus-check-arguments :session dbus--test-service :byte most-positive-fixnum)) + (should-error + (dbus-check-arguments :session dbus--test-service :byte) + :type 'wrong-type-argument) (should-error (dbus-check-arguments :session dbus--test-service :byte -1) :type 'wrong-type-argument) @@ -160,6 +177,9 @@ (should (dbus-check-arguments :session dbus--test-service :int16 0)) (should (dbus-check-arguments :session dbus--test-service :int16 #x7fff)) (should (dbus-check-arguments :session dbus--test-service :int16 #x-8000)) + (should-error + (dbus-check-arguments :session dbus--test-service :int16) + :type 'wrong-type-argument) (should-error (dbus-check-arguments :session dbus--test-service :int16 #x8000) :type 'args-out-of-range) @@ -176,6 +196,9 @@ ;; `:uint16'. (should (dbus-check-arguments :session dbus--test-service :uint16 0)) (should (dbus-check-arguments :session dbus--test-service :uint16 #xffff)) + (should-error + (dbus-check-arguments :session dbus--test-service :uint16) + :type 'wrong-type-argument) (should-error (dbus-check-arguments :session dbus--test-service :uint16 #x10000) :type 'args-out-of-range) @@ -193,6 +216,9 @@ (should (dbus-check-arguments :session dbus--test-service :int32 0)) (should (dbus-check-arguments :session dbus--test-service :int32 #x7fffffff)) (should (dbus-check-arguments :session dbus--test-service :int32 #x-80000000)) + (should-error + (dbus-check-arguments :session dbus--test-service :int32) + :type 'wrong-type-argument) (should-error (dbus-check-arguments :session dbus--test-service :int32 #x80000000) :type 'args-out-of-range) @@ -210,6 +236,9 @@ (should (dbus-check-arguments :session dbus--test-service 0)) (should (dbus-check-arguments :session dbus--test-service :uint32 0)) (should (dbus-check-arguments :session dbus--test-service :uint32 #xffffffff)) + (should-error + (dbus-check-arguments :session dbus--test-service :uint32) + :type 'wrong-type-argument) (should-error (dbus-check-arguments :session dbus--test-service :uint32 #x100000000) :type 'args-out-of-range) @@ -229,6 +258,9 @@ (dbus-check-arguments :session dbus--test-service :int64 #x7fffffffffffffff)) (should (dbus-check-arguments :session dbus--test-service :int64 #x-8000000000000000)) + (should-error + (dbus-check-arguments :session dbus--test-service :int64) + :type 'wrong-type-argument) (should-error (dbus-check-arguments :session dbus--test-service :int64 #x8000000000000000) :type 'args-out-of-range) @@ -246,6 +278,9 @@ (should (dbus-check-arguments :session dbus--test-service :uint64 0)) (should (dbus-check-arguments :session dbus--test-service :uint64 #xffffffffffffffff)) + (should-error + (dbus-check-arguments :session dbus--test-service :uint64) + :type 'wrong-type-argument) (should-error (dbus-check-arguments :session dbus--test-service :uint64 #x10000000000000000) :type 'args-out-of-range) @@ -267,6 +302,9 @@ ;; Shall both be supported? (should (dbus-check-arguments :session dbus--test-service :double 1.0e+INF)) (should (dbus-check-arguments :session dbus--test-service :double 0.0e+NaN)) + (should-error + (dbus-check-arguments :session dbus--test-service :double) + :type 'wrong-type-argument) (should-error (dbus-check-arguments :session dbus--test-service :double "string") :type 'wrong-type-argument) @@ -278,6 +316,9 @@ ;; D-Bus message). Mainly testing, that values out of `:uint32' ;; type range fail. (should (dbus-check-arguments :session dbus--test-service :unix-fd 0)) + (should-error + (dbus-check-arguments :session dbus--test-service :unix-fd) + :type 'wrong-type-argument) (should-error (dbus-check-arguments :session dbus--test-service :unix-fd -1) :type 'args-out-of-range) @@ -300,7 +341,7 @@ (should (dbus-check-arguments :session dbus--test-service '(:array :string "string1" "string2"))) - ;; Empty array. + ;; Empty array (of strings). (should (dbus-check-arguments :session dbus--test-service '(:array))) (should (dbus-check-arguments :session dbus--test-service '(:array :signature "o"))) @@ -318,7 +359,11 @@ (should (dbus-check-arguments :session dbus--test-service '(:variant (:array "string")))) - ;; More than one element. + ;; No or more than one element. + ;; FIXME. + ;; (should-error + ;; (dbus-check-arguments :session dbus--test-service '(:variant)) + ;; :type 'wrong-type-argument) (should-error (dbus-check-arguments :session dbus--test-service @@ -336,10 +381,13 @@ (dbus-check-arguments :session dbus--test-service '(:array :dict-entry (:string "string" :boolean t)))) - ;; The second element is `nil' (implicitly). FIXME: Is this right? - (should - (dbus-check-arguments - :session dbus--test-service '(:array (:dict-entry :string "string")))) + ;; FIXME: Must be errors. + ;; (should + ;; (dbus-check-arguments + ;; :session dbus--test-service '(:array (:dict-entry)))) + ;; (should + ;; (dbus-check-arguments + ;; :session dbus--test-service '(:array (:dict-entry :string "string")))) ;; Not two elements. (should-error (dbus-check-arguments @@ -357,7 +405,8 @@ (dbus-check-arguments :session dbus--test-service '(:dict-entry :string "string" :boolean t)) :type 'wrong-type-argument) - ;; Different dict entry types can be part of an array. + ;; FIXME:! This doesn't look right. + ;; Different dict entry types can be part of an array ??? (should (dbus-check-arguments :session dbus--test-service @@ -366,6 +415,8 @@ (:dict-entry :string "string2" :object-path "/object/path")))) ;; `:struct'. There is no restriction what could be an element of a struct. + ;; Empty struct. FIXME: Is this right? + ;; (should (dbus-check-arguments :session dbus--test-service '(:struct))) (should (dbus-check-arguments :session dbus--test-service commit 7f2c35d02874129723cc5e89d54cc3ab5bf07a31 Author: Lars Ingebrigtsen Date: Tue Sep 29 16:21:17 2020 +0200 Fix emacsclient -c foo.txt behaviour with many frames * lisp/server.el (server-execute): Pass in whether we opened a new frame or not (bug#43645). (server-switch-buffer): Use this to switch to the requested buffer in the new frame if we have "emacsclient -c foo.txt", and retain the old behaviour if it's "emacsclient foo.txt". diff --git a/lisp/server.el b/lisp/server.el index 436a6ca0c7..a660deab8e 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -1338,7 +1338,13 @@ The following commands are accepted by the client: "When done with this frame, type \\[delete-frame]"))) ((not (null buffers)) (run-hooks 'server-after-make-frame-hook) - (server-switch-buffer (car buffers) nil (cdr (car files))) + (server-switch-buffer + (car buffers) nil (cdr (car files)) + ;; When triggered from "emacsclient -c", we popped up a + ;; new frame. Ensure that we switch to the requested + ;; buffer in that frame, and not in some other frame + ;; where it may be displayed. + (plist-get (process-plist proc) 'frame)) (run-hooks 'server-switch-hook) (unless nowait (message "%s" (substitute-command-keys @@ -1568,7 +1574,8 @@ starts server process and that is all. Invoked by \\[server-edit]." (server-clients (apply #'server-switch-buffer (server-done))) (t (message "No server editing buffers exist")))) -(defun server-switch-buffer (&optional next-buffer killed-one filepos) +(defun server-switch-buffer (&optional next-buffer killed-one filepos + this-frame-only) "Switch to another buffer, preferably one that has a client. Arg NEXT-BUFFER is a suggestion; if it is a live buffer, use it. @@ -1602,7 +1609,8 @@ be a cons cell (LINENUMBER . COLUMNNUMBER)." ;; OK, we know next-buffer is live, let's display and select it. (if (functionp server-window) (funcall server-window next-buffer) - (let ((win (get-buffer-window next-buffer 0))) + (let ((win (get-buffer-window next-buffer + (if this-frame-only nil 0)))) (if (and win (not server-window)) ;; The buffer is already displayed: just reuse the ;; window. If FILEPOS is non-nil, use it to replace the @@ -1620,7 +1628,8 @@ be a cons cell (LINENUMBER . COLUMNNUMBER)." (setq server-window (make-frame))) (select-window (frame-selected-window server-window)))) (when (window-minibuffer-p) - (select-window (next-window nil 'nomini 0))) + (select-window (next-window nil 'nomini + (if this-frame-only nil 0)))) ;; Move to a non-dedicated window, if we have one. (when (window-dedicated-p) (select-window commit 07f748da431b67353767a7494083c10a2d17d7c4 Author: Lars Ingebrigtsen Date: Tue Sep 29 15:59:50 2020 +0200 Make M-x compile skip the header when looking for errors etc * lisp/progmodes/compile.el (compilation--ensure-parse): Skip the header when parsing (bug#43651). (compilation-start): Mark the end. diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index a408d16e37..4fe13770b5 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -33,6 +33,7 @@ (eval-when-compile (require 'cl-lib)) (require 'tool-bar) (require 'comint) +(require 'text-property-search) (defgroup compilation nil "Run compiler as inferior of Emacs, parse error messages." @@ -1573,7 +1574,14 @@ to `compilation-error-regexp-alist' if RULES is nil." ;; grep.el) don't need to flush-parse when they modify the buffer ;; in a way that impacts buffer positions but does not require ;; re-parsing. - (setq compilation--parsed (point-min-marker))) + (setq compilation--parsed + (set-marker (make-marker) + (save-excursion + (goto-char (point-min)) + (text-property-search-forward 'compilation-header-end) + ;; If we have no end marker, this will be + ;; `point-min' still. + (point))))) (when (< compilation--parsed limit) (let ((start (max compilation--parsed (point-min)))) (move-marker compilation--parsed limit) @@ -1818,6 +1826,9 @@ Returns the compilation buffer created." mode-name (substring (current-time-string) 0 19)) command "\n") + ;; Mark the end of the header so that we don't interpret + ;; anything in it as an error. + (put-text-property (1- (point)) (point) 'compilation-header-end t) (setq thisdir default-directory)) (set-buffer-modified-p nil)) ;; Pop up the compilation buffer. commit da40e5ecd79f8ad14915dae477c40f4090ce22ac Author: Lars Ingebrigtsen Date: Tue Sep 29 15:36:46 2020 +0200 Fix space parsing in gnus-base64-repad * lisp/gnus/gnus-util.el (gnus-base64-repad): Get the separator regexp right -- there will often be spaces around the newlines. diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index f8126906b8..e98af10e1a 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -1368,7 +1368,7 @@ CRLF (RFC 5321 SMTP)." ;; input (3.1, 3.3) ;; - if line-length is set, error on input exceeding the limit (3.1) ;; - reject characters outside base encoding (3.3, also section 12) - (let ((splitstr (split-string str "[\r\n]" t))) + (let ((splitstr (split-string str "\\s-+" t))) (when (and reject-newlines (> (length splitstr) 1)) (error "Invalid Base64 string")) (dolist (substr splitstr) commit 511c9d02b7addbb5ca0143af0cade21f0f06bd05 Author: Mattias Engdegård Date: Tue Sep 29 12:33:50 2020 +0200 * lisp/gnus/smime.el (smime-openssl-program): Allow nil value. diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el index 5500148e51..eb27fee88c 100644 --- a/lisp/gnus/smime.el +++ b/lisp/gnus/smime.el @@ -174,8 +174,9 @@ and the files themselves should be in PEM format." (eq 0 (call-process "openssl" nil nil nil "version")) (error nil)) "openssl") - "Name of OpenSSL binary." - :type 'string + "Name of OpenSSL binary or nil if none." + :type '(choice string + (const :tag "none" nil)) :group 'smime) ;; OpenSSL option to select the encryption cipher commit 4d57124fc8833f63e3f3cfb938cec99bd7f8ff81 Author: Mattias Engdegård Date: Tue Sep 29 11:24:38 2020 +0200 Fix custom-tests with non-GNU grep * admin/cus-test.el (cus-test-get-lisp-files): Add path argument required by standard grep (BSD, for instance). diff --git a/admin/cus-test.el b/admin/cus-test.el index cee8c19ba1..b4e4b42651 100644 --- a/admin/cus-test.el +++ b/admin/cus-test.el @@ -347,7 +347,7 @@ Optional argument ALL non-nil means list all (non-obsolete) Lisp files." ;; Hack to remove leading "./". (mapcar (lambda (e) (substring e 2)) (apply 'process-lines find-program - "-name" "obsolete" "-prune" "-o" + "." "-name" "obsolete" "-prune" "-o" "-name" "[^.]*.el" ; ignore .dir-locals.el (if all '("-print")