commit e2391d486e8a97e383db2337fad6a93c2c11656a (HEAD, refs/remotes/origin/master) Author: Eli Zaretskii Date: Fri Sep 11 08:56:51 2020 +0300 * lisp/simple.el (undo-redo): Doc fix. diff --git a/lisp/simple.el b/lisp/simple.el index 3b2b5c92e9..b5002dd189 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2752,7 +2752,8 @@ Contrary to `undo', this will not redo a previous undo." (let ((undo-no-redo t)) (undo arg))) (defun undo-redo (&optional arg) - "Undo the last ARG undos." + "Undo the last ARG undos, i.e., redo the last ARG changes. +Interactively, ARG is the prefix numeric argument and defaults to 1." (interactive "*p") (cond ((not (undo--last-change-was-undo-p buffer-undo-list)) commit 8cf274f9603a19d99e9caa4c5da37e8b91ae4a7c Author: Andrew G Cohen Date: Fri Sep 11 10:31:47 2020 +0800 Allow an info structure as argument for gnus-group-get-parameter * lisp/gnus/gnus.el (gnus-group-get-parameter): Allow the group argument to be either a group name or a group info structure. This is then parallel to gnus-group-set-parameter. diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 8cd35e3d7b..cb534260a6 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -3628,11 +3628,12 @@ If you call this function inside a loop, consider using the faster (defun gnus-group-get-parameter (group &optional symbol allow-list) "Return the group parameters for GROUP. -If SYMBOL, return the value of that symbol in the group parameters. -If ALLOW-LIST, also allow list as a result. -Most functions should use `gnus-group-find-parameter', which -also examines the topic parameters." - (let ((params (gnus-info-params (gnus-get-info group)))) +If SYMBOL, return the value of that symbol in the group +parameters. If ALLOW-LIST, also allow list as a result. Most +functions should use `gnus-group-find-parameter', which also +examines the topic parameters. GROUP can also be an info structure." + (let ((params (gnus-info-params (if (listp group) group + (gnus-get-info group))))) (if symbol (gnus-group-parameter-value params symbol allow-list) params))) commit f7e35f8162d366e2a91dcd1f21b3d59abc6d10d1 Author: Stefan Monnier Date: Thu Sep 10 22:10:02 2020 -0400 * lisp/loadup.el ("button"): Move to after loaddefs.el diff --git a/lisp/loadup.el b/lisp/loadup.el index 97525b2708..568b9fe40d 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -170,7 +170,6 @@ (load "cus-face") (load "faces") ; after here, `defface' may be used. -(load "button") ;; We don't want to store loaddefs.el in the repository because it is ;; a generated file; but it is required in order to compile the lisp files. @@ -193,6 +192,7 @@ definition-prefixes) (setq definition-prefixes new)) +(load "button") ;After loaddefs, because of define-minor-mode! (load "emacs-lisp/nadvice") (load "emacs-lisp/cl-preloaded") (load "obarray") ;abbrev.el is implemented in terms of obarrays. commit 206cff84bda2a7dd204a0da19e29abf389643f6b Author: Andrew G Cohen Date: Fri Sep 11 09:02:09 2020 +0800 Clean up group-finding in Gnus nnir search This is part of removing code from nnir.el that isn't related to searching backends and therefore belongs somewhere else. * lisp/gnus/gnus-group.el (gnus-group-make-search-group) (gnus-group-read-ephemeral-search-group): Put the logic for determining the groups to search here, rather than in nnir. Improve documentation. * lisp/gnus/gnus-int.el (gnus-server-get-active): Renamed from 'nnir-get-active. * lisp/gnus/nnir.el (nnir-run-imap, nnir-run-find-grep): Use it. (nnir-get-active): Remove. (nnir-make-specs): Make obsolete. * lisp/gnus/nnselect.el (nnselect-group-server): Make obsolete in favor of 'gnus-group-server. diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index fcaa6d7859..1d614f8a8d 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -3166,30 +3166,67 @@ mail messages or news articles in files that have numeric names." (list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir))))) -(autoload 'nnir-make-specs "nnir") +(autoload 'nnir-read-parms "nnir") +(autoload 'nnir-server-to-search-engine "nnir") (autoload 'gnus-group-topic-name "gnus-topic") ;; Temporary to make group creation easier (defun gnus-group-make-search-group (nnir-extra-parms &optional specs) + "Make a group based on a search. +Prompt for a search query and determine the groups to search as +follows: if called from the *Server* buffer search all groups +belonging to the server on the current line; if called from the +*Group* buffer search any marked groups, or the group on the +current line, or all the groups under the current topic. Calling +with a prefix arg prompts for additional search-engine specific +constraints. A non-nil SPECS arg must be an alist with +`nnir-query-spec' and `nnir-group-spec' keys, and skips all +prompting." (interactive "P") (let ((name (gnus-read-group "Group name: "))) (with-current-buffer gnus-group-buffer - (gnus-group-make-group - name - (list 'nnselect "nnselect") - nil - (list - (cons 'nnselect-specs - (list - (cons 'nnselect-function 'nnir-run-query) - (cons 'nnselect-args - (nnir-make-specs nnir-extra-parms specs))))))))) + (let* ((group-spec + (or + (cdr (assq 'nnir-group-spec specs)) + (if (gnus-server-server-name) + (list (list (gnus-server-server-name))) + (seq-group-by + (lambda (elt) (gnus-group-server elt)) + (or gnus-group-marked + (if (gnus-group-group-name) + (list (gnus-group-group-name)) + (cdr + (assoc (gnus-group-topic-name) gnus-topic-alist)))))))) + (query-spec + (or + (cdr (assq 'nnir-query-spec specs)) + (apply + 'append + (list (cons 'query + (read-string "Query: " nil 'nnir-search-history))) + (when nnir-extra-parms + (mapcar + (lambda (x) + (nnir-read-parms (nnir-server-to-search-engine (car x)))) + group-spec)))))) + (gnus-group-make-group + name + (list 'nnselect "nnselect") + nil + (list + (cons 'nnselect-specs + (list + (cons 'nnselect-function 'nnir-run-query) + (cons 'nnselect-args + (list (cons 'nnir-query-spec query-spec) + (cons 'nnir-group-spec group-spec))))) + (cons 'nnselect-artlist nil))))))) (define-obsolete-function-alias 'gnus-group-make-nnir-group 'gnus-group-read-ephemeral-search-group "28.1") (defun gnus-group-read-ephemeral-search-group (nnir-extra-parms &optional specs) - "Create an nnselect group based on a search. + "Read an nnselect group based on a search. Prompt for a search query and determine the groups to search as follows: if called from the *Server* buffer search all groups belonging to the server on the current line; if called from the @@ -3200,19 +3237,42 @@ constraints. A non-nil SPECS arg must be an alist with `nnir-query-spec' and `nnir-group-spec' keys, and skips all prompting." (interactive "P") - (gnus-group-read-ephemeral-group - (concat "nnselect-" (message-unique-id)) - (list 'nnselect "nnselect") - nil - (cons (current-buffer) gnus-current-window-configuration) - nil nil - (list - (cons 'nnselect-specs - (list - (cons 'nnselect-function 'nnir-run-query) - (cons 'nnselect-args - (nnir-make-specs nnir-extra-parms specs)))) - (cons 'nnselect-artlist nil)))) + (let* ((group-spec + (or (cdr (assq 'nnir-group-spec specs)) + (if (gnus-server-server-name) + (list (list (gnus-server-server-name))) + (seq-group-by + (lambda (elt) (gnus-group-server elt)) + (or gnus-group-marked + (if (gnus-group-group-name) + (list (gnus-group-group-name)) + (cdr + (assoc (gnus-group-topic-name) gnus-topic-alist)))))))) + (query-spec + (or (cdr (assq 'nnir-query-spec specs)) + (apply + 'append + (list (cons 'query + (read-string "Query: " nil 'nnir-search-history))) + (when nnir-extra-parms + (mapcar + (lambda (x) + (nnir-read-parms (nnir-server-to-search-engine (car x)))) + group-spec)))))) + (gnus-group-read-ephemeral-group + (concat "nnselect-" (message-unique-id)) + (list 'nnselect "nnselect") + nil + (cons (current-buffer) gnus-current-window-configuration) + nil nil + (list + (cons 'nnselect-specs + (list + (cons 'nnselect-function 'nnir-run-query) + (cons 'nnselect-args + (list (cons 'nnir-query-spec query-spec) + (cons 'nnir-group-spec group-spec))))) + (cons 'nnselect-artlist nil))))) (defun gnus-group-add-to-virtual (n vgroup) "Add the current group to a virtual group." diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el index da385a1802..b8be766c84 100644 --- a/lisp/gnus/gnus-int.el +++ b/lisp/gnus/gnus-int.el @@ -365,6 +365,48 @@ If it is down, start it up (again)." (funcall (gnus-get-function gnus-command-method 'request-list) (nth 1 gnus-command-method))) +(defun gnus-server-get-active (server &optional ignored) + "Return the active list for SERVER. +Groups matching the IGNORED regexp are excluded." + (let ((method (gnus-server-to-method server)) + groups) + (gnus-request-list method) + (with-current-buffer nntp-server-buffer + (let ((cur (current-buffer))) + (goto-char (point-min)) + (unless (or (null ignored) + (string= ignored "")) + (delete-matching-lines ignored)) + (if (eq (car method) 'nntp) + (while (not (eobp)) + (ignore-errors + (push (gnus-group-full-name + (buffer-substring + (point) + (progn + (skip-chars-forward "^ \t") + (point))) + method) + groups)) + (forward-line)) + (while (not (eobp)) + (ignore-errors + (push (if (eq (char-after) ?\") + (gnus-group-full-name (read cur) method) + (let ((p (point)) (name "")) + (skip-chars-forward "^ \t\\\\") + (setq name (buffer-substring p (point))) + (while (eq (char-after) ?\\) + (setq p (1+ (point))) + (forward-char 2) + (skip-chars-forward "^ \t\\\\") + (setq name (concat name (buffer-substring + p (point))))) + (gnus-group-full-name name method))) + groups)) + (forward-line))))) + groups)) + (defun gnus-finish-retrieve-group-infos (gnus-command-method infos data) "Read and update infos from GNUS-COMMAND-METHOD." (when (stringp gnus-command-method) diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index c46903a458..168c994bae 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -549,6 +549,7 @@ construct the vector entries." ;;; Search Engine Interfaces: +(autoload 'gnus-server-get-active "gnus-int") (autoload 'nnimap-change-group "nnimap") (declare-function nnimap-buffer "nnimap" ()) (declare-function nnimap-command "nnimap" (&rest args)) @@ -567,7 +568,8 @@ extensions." (cdr (assoc nnir-imap-default-search-key nnir-imap-search-arguments)))) (gnus-inhibit-demon t) - (groups (or groups (nnir-get-active srv)))) + (groups + (or groups (gnus-server-get-active srv nnir-ignored-newsgroups)))) (message "Opening server %s" server) (apply 'vconcat @@ -1205,7 +1207,8 @@ construct path: search terms (see the variable (directory (cadr (assoc sym (cddr method)))) (regexp (cdr (assoc 'query query))) (grep-options (cdr (assoc 'grep-options query))) - (grouplist (or grouplist (nnir-get-active server)))) + (grouplist + (or grouplist (gnus-server-get-active server nnir-ignored-newsgroups)))) (unless directory (error "No directory found in method specification of server %s" server)) @@ -1332,54 +1335,13 @@ environment unless NOT-GLOBAL is non-nil." ((and (not not-global) (boundp key)) (symbol-value key)) (t nil)))) -(autoload 'gnus-request-list "gnus-int") - -(defun nnir-get-active (srv) - "Return the active list for SRV." - (let ((method (gnus-server-to-method srv)) - groups) - (gnus-request-list method) - (with-current-buffer nntp-server-buffer - (let ((cur (current-buffer))) - (goto-char (point-min)) - (unless (or (null nnir-ignored-newsgroups) - (string= nnir-ignored-newsgroups "")) - (delete-matching-lines nnir-ignored-newsgroups)) - (if (eq (car method) 'nntp) - (while (not (eobp)) - (ignore-errors - (push (gnus-group-full-name - (buffer-substring - (point) - (progn - (skip-chars-forward "^ \t") - (point))) - method) - groups)) - (forward-line)) - (while (not (eobp)) - (ignore-errors - (push (if (eq (char-after) ?\") - (gnus-group-full-name (read cur) method) - (let ((p (point)) (name "")) - (skip-chars-forward "^ \t\\\\") - (setq name (buffer-substring p (point))) - (while (eq (char-after) ?\\) - (setq p (1+ (point))) - (forward-char 2) - (skip-chars-forward "^ \t\\\\") - (setq name (concat name (buffer-substring - p (point))))) - (gnus-group-full-name name method))) - groups)) - (forward-line))))) - groups)) - -(autoload 'nnselect-categorize "nnselect" nil nil) (autoload 'gnus-group-topic-name "gnus-topic" nil nil) (defvar gnus-group-marked) (defvar gnus-topic-alist) +(make-obsolete 'nnir-make-specs "This function should no longer +be used." "28.1") + (defun nnir-make-specs (nnir-extra-parms &optional specs) "Make the query-spec and group-spec for a search with NNIR-EXTRA-PARMS. Query for the specs, or use SPECS." @@ -1387,12 +1349,12 @@ Query for the specs, or use SPECS." (or (cdr (assq 'nnir-group-spec specs)) (if (gnus-server-server-name) (list (list (gnus-server-server-name))) - (nnselect-categorize + (seq-group-by + (lambda (elt) (gnus-group-server elt)) (or gnus-group-marked (if (gnus-group-group-name) (list (gnus-group-group-name)) - (cdr (assoc (gnus-group-topic-name) gnus-topic-alist)))) - 'nnselect-group-server)))) + (cdr (assoc (gnus-group-topic-name) gnus-topic-alist)))))))) (query-spec (or (cdr (assq 'nnir-query-spec specs)) (apply @@ -1407,6 +1369,8 @@ Query for the specs, or use SPECS." (list (cons 'nnir-query-spec query-spec) (cons 'nnir-group-spec group-spec)))) +(define-obsolete-function-alias 'nnir-get-active 'gnus-server-get-active "28.1") + ;; The end. (provide 'nnir) diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el index b9769310ea..94dd93b354 100644 --- a/lisp/gnus/nnselect.el +++ b/lisp/gnus/nnselect.el @@ -105,9 +105,7 @@ (gnus-uncompress-sequence artseq)) selection))) selection))) -(defun nnselect-group-server (group) - "Return the server for GROUP." - (gnus-group-server group)) +(make-obsolete 'nnselect-group-server 'gnus-group-server "28.1") ;; Data type article list. commit f7be259400b9e31704560d137562e6e9cbf2a0be Author: Andrew G Cohen Date: Fri Sep 11 07:31:56 2020 +0800 Allow editing articles in Gnus nnselect groups * lisp/gnus/nnselect.el (nnselect-request-replace-article): New function. diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el index 4916286e37..b9769310ea 100644 --- a/lisp/gnus/nnselect.el +++ b/lisp/gnus/nnselect.el @@ -418,6 +418,21 @@ If this variable is nil, or if the provided function returns nil, to-newsgroup ; Not respooling (gnus-group-real-name to-newsgroup))))) +(deffoo nnselect-request-replace-article + (article _group buffer &optional no-encode) + (pcase-let ((`[,artgroup ,artnumber ,artrsv] + (with-current-buffer gnus-summary-buffer + (nnselect-artlist-article gnus-newsgroup-selection article)))) + (unless (gnus-check-backend-function + 'request-replace-article artgroup) + (user-error "The group %s does not support article editing" artgroup)) + (let ((newart + (gnus-request-replace-article artnumber artgroup buffer no-encode))) + (with-current-buffer gnus-summary-buffer + (cl-nsubstitute `[,artgroup ,newart ,artrsv] + `[,artgroup ,artnumber ,artrsv] + gnus-newsgroup-selection + :test #'equal :count 1))))) (deffoo nnselect-request-expire-articles (articles _group &optional _server force) commit 37c095a23fc8ac2f3f43acfe33c9dcd7664d9a89 Author: Elad Lahav Date: Fri Sep 11 00:01:06 2020 +0200 Fix QNX build * configure.ac: The __NO_EXT_QNX flag is no longer needed, and is masking the declaration of memset_s() (bug#43234). Copyright-paperwork-exempt: yes diff --git a/configure.ac b/configure.ac index 0bcff587e8..33948fd776 100644 --- a/configure.ac +++ b/configure.ac @@ -785,10 +785,7 @@ case "${canonical}" in *-nto-qnx* ) opsys=qnxnto test -z "$CC" && CC=qcc - CFLAGS="$CFLAGS -D__NO_EXT_QNX" - if test "$with_unexec" = yes; then - LDFLAGS="-N2MB $LDFLAGS" - fi + LDFLAGS="-N2M $LDFLAGS" ;; ## Intel 386 machines where we don't care about the manufacturer. commit 8e1376a39125c3ffc0484077b502444d853eca79 Author: Boruch Baum Date: Thu Sep 10 23:44:16 2020 +0200 Use a header line in calc mode instead of a regular in-buffer line * lisp/calc/calc.el (calc-trail-here): Use a header line. (calc--header-line): New function. (calc-trail-mode): Use a header line. diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index fb1287baaa..9b95bc149a 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -1382,6 +1382,29 @@ Notations: 3.14e6 3.14 * 10^6 (set-keymap-parent map calc-mode-map) map)) +(defun calc--header-line (long short width &optional fudge) + "Return a Calc header line appropriate for the buffer width. + +LONG is a desired text for a wide window, SHORT is a desired +abbreviated text, and width is the buffer width, which will be +some fraction of the 'parent' window width (At the time of +writing, 2/3 for calc, 1/3 for trail). The optional FUDGE is a +trial-and-error adjustment number for the edge-cases at the +border of the two cases." + ;; TODO: This could be called as part of a 'window-resize' hook. + (setq header-line-format + (let* ((len-long (length long)) + (len-short (length short)) + (fudge (or fudge 0)) + ;; fudge for trail is: -3 (added to len-long) + ;; (width ) for trail + (factor (if (> width (+ len-long fudge)) len-long len-short)) + (size (/ (- width factor) 2)) + (fill (make-string size ?-)) + (pre (replace-regexp-in-string ".$" " " fill)) + (post (replace-regexp-in-string "^." " " fill))) + (concat pre (if (= factor len-long) long short) post)))) + (define-derived-mode calc-trail-mode fundamental-mode "Calc Trail" "Calc Trail mode. This mode is used by the *Calc Trail* buffer, which records all results @@ -1396,9 +1419,9 @@ commands given here will actually operate on the *Calculator* stack." (setq buffer-read-only t) (make-local-variable 'overlay-arrow-position) (make-local-variable 'overlay-arrow-string) - (when (= (buffer-size) 0) - (let ((inhibit-read-only t)) - (insert (propertize "Emacs Calculator Trail\n" 'face 'italic))))) + (when calc-show-banner + (calc--header-line "Emacs Calculator Trail" "Calc Trail" + (/ (window-width) 3) -3))) (defun calc-create-buffer () "Create and initialize a buffer for the Calculator." @@ -1451,7 +1474,6 @@ commands given here will actually operate on the *Calculator* stack." (pop-to-buffer (current-buffer))))))) (with-current-buffer (calc-trail-buffer) (and calc-display-trail - (= (window-width) (frame-width)) (calc-trail-display 1 t))) (message "Welcome to the GNU Emacs Calculator! Press `?' or `h' for help, `q' to quit") (run-hooks 'calc-start-hook) @@ -1986,13 +2008,11 @@ See calc-keypad for details." (calc-any-evaltos nil)) (setq calc-any-selections nil) (erase-buffer) - (when calc-show-banner - (insert (propertize "--- Emacs Calculator Mode ---\n" - 'face 'italic))) + (when calc-show-banner + (calc--header-line "Emacs Calculator Mode" "Emacs Calc" + (* 2 (/ (window-width) 3)) -3)) (while thing (goto-char (point-min)) - (when calc-show-banner - (forward-line 1)) (insert (math-format-stack-value (car thing)) "\n") (setq thing (cdr thing))) (calc-renumber-stack) @@ -2076,7 +2096,6 @@ the United States." (eq (marker-buffer calc-trail-pointer) calc-trail-buffer)) (with-current-buffer calc-trail-buffer (goto-char (point-min)) - (forward-line 1) (setq calc-trail-pointer (point-marker)))) calc-trail-buffer) @@ -2144,10 +2163,8 @@ the United States." (if (derived-mode-p 'calc-trail-mode) (progn (beginning-of-line) - (if (bobp) - (forward-line 1) - (if (eobp) - (forward-line -1))) + (if (eobp) + (forward-line -1)) (if (or (bobp) (eobp)) (setq overlay-arrow-position nil) ; trail is empty (set-marker calc-trail-pointer (point) (current-buffer)) @@ -2161,7 +2178,7 @@ the United States." (if win (save-excursion (forward-line (/ (window-height win) 2)) - (forward-line (- 1 (window-height win))) + (forward-line (- 2 (window-height win))) (set-window-start win (point)) (set-window-point win (+ calc-trail-pointer 4)) (set-buffer calc-main-buffer) commit a4d37877f8da3588aa176672f65952a91daf1699 Author: Lars Ingebrigtsen Date: Thu Sep 10 23:26:30 2020 +0200 Tweak how `M-RET' in Message mode fills paragraphs * lisp/gnus/message.el (message-newline-and-reformat): Pick up any longer white-space prefix before starting to fill (bug#43299). This fixes the problem of hitting M-RET on a line that's just ">". diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index e10322417d..3e7e18906c 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -3536,8 +3536,8 @@ Prefix arg means justify as well." (equal quoted (match-string 0))) (goto-char (match-end 0)) (looking-at "[ \t]*") - (if (> (length leading-space) (length (match-string 0))) - (setq leading-space (match-string 0))) + (when (< (length leading-space) (length (match-string 0))) + (setq leading-space (match-string 0))) (forward-line 1)) (setq end (point)) (goto-char beg) commit da344e1884481e8d5e294b0f46df447c234bab41 Author: Lars Ingebrigtsen Date: Thu Sep 10 23:03:50 2020 +0200 Doc fix for diff-no-select * lisp/vc/diff.el (diff-no-select): Document the BUF argument (bug#43307). diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el index 9e7e771963..2ed8573c07 100644 --- a/lisp/vc/diff.el +++ b/lisp/vc/diff.el @@ -145,9 +145,13 @@ Possible values are: (defun diff-no-select (old new &optional switches no-async buf) ;; Noninteractive helper for creating and reverting diff buffers - "Compare the OLD and NEW file/buffer, and return a diff buffer. + "Compare the OLD and NEW file/buffer. -See `diff' for the meaning of the arguments." +If BUF is nil, the \"*Diff*\" buffer will be used as the diff +buffer. If non-nil, BUF will be used as the diff buffer. The +buffer used will be returned by this value. + +See `diff' for the meaning of the SWITCHES and NO-ASYNC arguments." (unless (bufferp new) (setq new (expand-file-name new))) (unless (bufferp old) (setq old (expand-file-name old))) (or switches (setq switches diff-switches)) ; If not specified, use default. commit bd5b7754523a825d7b8d2bb55d420c0e3347fa2a Author: Caio Henrique Date: Thu Sep 10 22:57:48 2020 +0200 Add a "Redo" entry to the menu * lisp/menu-bar.el (menu-bar-edit-menu): Add "Redo" under "Undo" in the Edit menu (bug#43315). Copyright-paperwork-exempt: yes diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index bc094c9050..30d86c7f17 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -536,6 +536,12 @@ (if (featurep 'ns) (bindings--define-key menu [separator-undo] menu-bar-separator)) + (bindings--define-key menu [undo-redo] + '(menu-item "Redo" undo-redo + :enable (and (not buffer-read-only) + (undo--last-change-was-undo-p buffer-undo-list)) + :help "Undo last undo")) + (bindings--define-key menu [undo] '(menu-item "Undo" undo :enable (and (not buffer-read-only) commit a70ce631c685f26a9d3f46993e198566ebf98baa Author: Stefan Kangas Date: Thu Sep 10 20:56:46 2020 +0200 * lisp/textmodes/artist.el: Remove obsolete comments. diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el index 9f08772ec3..9c94fff12c 100644 --- a/lisp/textmodes/artist.el +++ b/lisp/textmodes/artist.el @@ -115,8 +115,6 @@ ;;; Requirements: -;; Artist requires Emacs 19.28 or higher. -;; ;; Artist requires the `rect' package (which comes with Emacs) to be ;; loadable, unless the variable `artist-interface-with-rect' is set ;; to nil. @@ -127,9 +125,6 @@ ;;; Known bugs: -;; The shifted operations are not available when drawing with the mouse -;; in Emacs 19.29 and 19.30. -;; ;; It is not possible to change between shifted and unshifted operation ;; while drawing with the mouse. (See the comment in the function ;; artist-shift-has-changed for further details.) commit 27b711f834a12384e31ac624a586711c5d07af6b Author: Juri Linkov Date: Thu Sep 10 21:58:26 2020 +0300 ; Fix typos in format-prompt diff --git a/lisp/calc/calcalg3.el b/lisp/calc/calcalg3.el index 75e691a28f..2d38c9c45b 100644 --- a/lisp/calc/calcalg3.el +++ b/lisp/calc/calcalg3.el @@ -472,7 +472,7 @@ (setq defc (calc-invent-parameter-variables nc defv))) (let ((vars (read-string (format-prompt "Fitting variables" - (format "%s; %s)" + (format "%s; %s" (mapconcat 'symbol-name (mapcar (function (lambda (v) (nth 1 v))) diff --git a/lisp/misearch.el b/lisp/misearch.el index 7796df49c4..36a7afe518 100644 --- a/lisp/misearch.el +++ b/lisp/misearch.el @@ -317,7 +317,7 @@ Every next/previous file in the defined sequence is visited by "Return a list of files specified interactively, one by one." ;; Most code from `multi-occur'. (let* ((files (list (read-file-name - (format-prompt "First file to search: " + (format-prompt "First file to search" (file-name-nondirectory buffer-file-name)) default-directory buffer-file-name))) (file nil)) commit 4ba71eee8d8991c95028df40cb784cb9cb2e964d Author: Stefan Kangas Date: Thu Sep 10 20:40:34 2020 +0200 Convert indent test for css-mode into automatic test * test/lisp/textmodes/css-mode-tests.el (css-mode-test-indent): New test. (css-mode-tests-data-dir): New variable. * test/manual/indent/css-mode.css: Move from here... * test/lisp/textmodes/css-mode-resources/test-indent.css: ...to here. diff --git a/test/manual/indent/css-mode.css b/test/lisp/textmodes/css-mode-resources/test-indent.css similarity index 100% rename from test/manual/indent/css-mode.css rename to test/lisp/textmodes/css-mode-resources/test-indent.css diff --git a/test/lisp/textmodes/css-mode-tests.el b/test/lisp/textmodes/css-mode-tests.el index 38cb73b355..f627d1c02c 100644 --- a/test/lisp/textmodes/css-mode-tests.el +++ b/test/lisp/textmodes/css-mode-tests.el @@ -30,6 +30,12 @@ (require 'ert) (require 'seq) +(defvar css-mode-tests-data-dir + (file-truename + (expand-file-name "css-mode-resources/" + (file-name-directory (or load-file-name + buffer-file-name))))) + (ert-deftest css-test-property-values () ;; The `float' property has a flat value list. (should @@ -411,5 +417,13 @@ (point)) "black"))))) +(ert-deftest css-mode-test-indent () + (with-current-buffer + (find-file-noselect (expand-file-name "test-indent.css" + css-mode-tests-data-dir)) + (let ((orig (buffer-string))) + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) orig))))) + (provide 'css-mode-tests) ;;; css-mode-tests.el ends here commit 498773447ad0640b500572915a15958ac7320f2d Author: Stefan Kangas Date: Thu Sep 10 20:31:42 2020 +0200 ; * test/manual/indent/elisp.el: Use lexical-binding. diff --git a/test/manual/indent/elisp.el b/test/manual/indent/elisp.el index f3874b5c3e..7d634ae84c 100644 --- a/test/manual/indent/elisp.el +++ b/test/manual/indent/elisp.el @@ -1,3 +1,4 @@ +;; -*- lexical-binding:t -*- (defun x () (print (quote ( thingy great stuff))) commit 262d0c6acfe898d826b6037bc1155a21fa785f1e Author: Stefan Kangas Date: Thu Sep 10 20:25:19 2020 +0200 Mark some tests as expensive * test/lisp/autorevert-tests.el (auto-revert-test00-auto-revert-mode) (auto-revert-test03-auto-revert-tail-mode) (auto-revert-test04-auto-revert-mode-dired): * test/lisp/cedet/semantic-utest-c.el (semantic-test-c-preprocessor-simulation): * test/lisp/cedet/srecode-utest-getset.el (srecode-utest-getset-output): * test/lisp/emacs-lisp/cl-seq-tests.el (cl-seq-test-bug24264): * test/lisp/emacs-lisp/package-tests.el (package-test-update-archives-async): * test/lisp/filenotify-tests.el (file-notify-test03-events) (file-notify-test04-autorevert) (file-notify-test05-file-validity, file-notify-test08-backup): * test/lisp/net/gnutls-tests.el (test-gnutls-005-aead-ciphers): * test/lisp/shadowfile-tests.el (shadow-test00-clusters) (shadow-test09-shadow-copy-files): diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el index ec3e4bb77b..3243a80e52 100644 --- a/test/lisp/autorevert-tests.el +++ b/test/lisp/autorevert-tests.el @@ -156,6 +156,7 @@ This expects `auto-revert--messages' to be bound by "Check autorevert for a file." ;; `auto-revert-buffers' runs every 5". And we must wait, until the ;; file has been reverted. + :tags '(:expensive-test) (let ((tmpfile (make-temp-file "auto-revert-test")) buf) (unwind-protect @@ -356,6 +357,7 @@ This expects `auto-revert--messages' to be bound by "Check autorevert tail mode." ;; `auto-revert-buffers' runs every 5". And we must wait, until the ;; file has been reverted. + :tags '(:expensive-test) (let ((tmpfile (make-temp-file "auto-revert-test")) buf) (unwind-protect @@ -394,6 +396,7 @@ This expects `auto-revert--messages' to be bound by "Check autorevert for dired." ;; `auto-revert-buffers' runs every 5". And we must wait, until the ;; file has been reverted. + :tags '(:expensive-test) (let* ((tmpfile (make-temp-file "auto-revert-test")) (name (file-name-nondirectory tmpfile)) buf) diff --git a/test/lisp/cedet/semantic-utest-c.el b/test/lisp/cedet/semantic-utest-c.el index c3496648f2..c776a0fbaa 100644 --- a/test/lisp/cedet/semantic-utest-c.el +++ b/test/lisp/cedet/semantic-utest-c.el @@ -46,7 +46,7 @@ ;;;###autoload (ert-deftest semantic-test-c-preprocessor-simulation () "Run parsing test for C from the test directory." - (interactive) + :tags '(:expensive-test) (semantic-mode 1) (dolist (fp semantic-utest-c-comparisons) (let* ((semantic-lex-c-nested-namespace-ignore-second nil) diff --git a/test/lisp/cedet/srecode-utest-getset.el b/test/lisp/cedet/srecode-utest-getset.el index 3419b18afb..fc66ac4edf 100644 --- a/test/lisp/cedet/srecode-utest-getset.el +++ b/test/lisp/cedet/srecode-utest-getset.el @@ -55,6 +55,7 @@ private: (defvar srecode-insert-getset-fully-automatic-flag) ; Silence byte-compiler. (ert-deftest srecode-utest-getset-output () "Test various template insertion options." + :tags '(:expensive-test) (save-excursion (let ((testbuff (find-file-noselect srecode-utest-getset-testfile)) (srecode-insert-getset-fully-automatic-flag t)) diff --git a/test/lisp/emacs-lisp/cl-seq-tests.el b/test/lisp/emacs-lisp/cl-seq-tests.el index cddefbbdee..7e0f538454 100644 --- a/test/lisp/emacs-lisp/cl-seq-tests.el +++ b/test/lisp/emacs-lisp/cl-seq-tests.el @@ -294,6 +294,7 @@ Body are forms defining the test." (ert-deftest cl-seq-test-bug24264 () "Test for https://debbugs.gnu.org/24264 ." + :tags '(:expensive-test) (let ((list (append (make-list 8000005 1) '(8))) (list2 (make-list 8000005 2))) (should (cl-position 8 list)) diff --git a/test/lisp/emacs-lisp/package-tests.el b/test/lisp/emacs-lisp/package-tests.el index dd8ae39c7e..cbb2410f95 100644 --- a/test/lisp/emacs-lisp/package-tests.el +++ b/test/lisp/emacs-lisp/package-tests.el @@ -492,6 +492,7 @@ Must called from within a `tar-mode' buffer." (ert-deftest package-test-update-archives-async () "Test updating package archives asynchronously." + :tags '(:expensive-test) (skip-unless (executable-find "python2")) (let* ((package-menu-async t) (default-directory package-test-data-dir) diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index 42d86ee153..47ed661ebf 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el @@ -611,6 +611,7 @@ delivered." (ert-deftest file-notify-test03-events () "Check file creation/change/removal notifications." + :tags '(:expensive-test) (skip-unless (file-notify--test-local-enabled)) (unwind-protect @@ -888,6 +889,7 @@ delivered." (ert-deftest file-notify-test04-autorevert () "Check autorevert via file notification." + :tags '(:expensive-test) (skip-unless (file-notify--test-local-enabled)) ;; `auto-revert-buffers' runs every 5". And we must wait, until the @@ -983,6 +985,7 @@ delivered." (ert-deftest file-notify-test05-file-validity () "Check `file-notify-valid-p' for files." + :tags '(:expensive-test) (skip-unless (file-notify--test-local-enabled)) (unwind-protect @@ -1235,6 +1238,7 @@ delivered." (ert-deftest file-notify-test08-backup () "Check that backup keeps file notification." + :tags '(:expensive-test) (skip-unless (file-notify--test-local-enabled)) (unwind-protect diff --git a/test/lisp/net/gnutls-tests.el b/test/lisp/net/gnutls-tests.el index 07e30b6464..5205f0b851 100644 --- a/test/lisp/net/gnutls-tests.el +++ b/test/lisp/net/gnutls-tests.el @@ -241,6 +241,7 @@ (ert-deftest test-gnutls-005-aead-ciphers () "Test the GnuTLS AEAD ciphers" + :tags '(:expensive-test) (skip-unless (memq 'AEAD-ciphers (gnutls-available-p))) (setq gnutls-tests-message-prefix "AEAD verification: ") (let ((keys '("mykey" "mykey2")) diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index 03c62de1fd..f40f6a1cdb 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -125,6 +125,7 @@ Per definition, all files are identical on the different hosts of a cluster (or site). This is not tested here; it must be guaranteed by the originator of a cluster definition." + :tags '(:expensive-test) (skip-unless (not (memq system-type '(windows-nt ms-dos)))) (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) @@ -865,6 +866,7 @@ guaranteed by the originator of a cluster definition." (ert-deftest shadow-test09-shadow-copy-files () "Check that needed shadow files are copied." + :tags '(:expensive-test) (skip-unless (not (memq system-type '(windows-nt ms-dos)))) (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) (skip-unless (file-writable-p shadow-test-remote-temporary-file-directory)) commit be4c4a7389cf0a47bc2c3e2896d4d0e2f09daa16 Author: Stefan Kangas Date: Thu Sep 10 19:32:33 2020 +0200 Use lexical-binding in mml-sec-tests.el * test/lisp/gnus/mml-sec-tests.el: Use lexical-binding. (mml-secure-test-mail-fixture) (mml-secure-test-en-decrypt-with-passphrase): Fix warnings. diff --git a/test/lisp/gnus/mml-sec-tests.el b/test/lisp/gnus/mml-sec-tests.el index 673fa6984a..0911932665 100644 --- a/test/lisp/gnus/mml-sec-tests.el +++ b/test/lisp/gnus/mml-sec-tests.el @@ -1,4 +1,4 @@ -;;; gnustest-mml-sec.el --- Tests mml-sec.el, see README-mml-secure.txt. +;;; mml-sec-tests.el --- Tests mml-sec.el, see README-mml-secure.txt. -*- lexical-binding:t -*- ;; Copyright (C) 2015 Free Software Foundation, Inc. ;; Author: Jens Lechtenbörger @@ -51,6 +51,8 @@ Mostly, the empty passphrase is used. However, the keys for '(sign-pgp sign-pgp-mime sign-smime) '(sign-pgp sign-pgp-mime))) +(defvar mml-smime-use) + (defun mml-secure-test-fixture (body &optional interactive) "Setup GnuPG home containing test keys and prepare environment for BODY. If optional INTERACTIVE is non-nil, allow questions to the user in case of @@ -120,9 +122,9 @@ Subject: Test Pass optional INTERACTIVE to mml-secure-test-fixture." (mml-secure-test-fixture (lambda () - (let ((context (if (memq method '(enc-smime enc-sign-smime sign-smime)) - (epg-make-context 'CMS) - (epg-make-context 'OpenPGP))) + (let ((_context (if (memq method '(enc-smime enc-sign-smime sign-smime)) + (epg-make-context 'CMS) + (epg-make-context 'OpenPGP))) ;; Verify and decrypt by default. (mm-verify-option 'known) (mm-decrypt-option 'known) @@ -546,6 +548,10 @@ Pass optional INTERACTIVE to mml-secure-test-mail-fixture." )))))) interactive)) +(defvar mml-smime-cache-passphrase) +(defvar mml2015-cache-passphrase) +(defvar mml1991-cache-passphrase) + (defun mml-secure-test-en-decrypt-with-passphrase (method to from checksig jl-passphrase do-cache &optional enc-keys expectfail) @@ -562,7 +568,7 @@ If optional EXPECTFAIL is non-nil, a decryption failure is expected." (mml-smime-cache-passphrase do-cache) ) (cl-letf (((symbol-function 'read-passwd) - (lambda (prompt &optional confirm default) jl-passphrase))) + (lambda (_prompt &optional _confirm _default) jl-passphrase))) (mml-secure-test-en-decrypt method to from checksig t enc-keys expectfail) ))) @@ -897,4 +903,4 @@ So the second decryption fails." (let ((with-smime nil)) (ert-run-tests-batch))) -;;; gnustest-mml-sec.el ends here +;;; mml-sec-tests.el ends here commit ba3e2b80c04440c6a258b647a583d0a0afeabf83 Author: Stefan Kangas Date: Thu Sep 10 18:55:54 2020 +0200 * test/lisp/org/org-tests.el: Use lexical-binding. diff --git a/test/lisp/org/org-tests.el b/test/lisp/org/org-tests.el index 918d79b8dc..6e91dd2864 100644 --- a/test/lisp/org/org-tests.el +++ b/test/lisp/org/org-tests.el @@ -1,4 +1,4 @@ -;;; org-tests.el --- tests for org/org.el +;;; org-tests.el --- tests for org/org.el -*- lexical-binding:t -*- ;; Copyright (C) 2018-2020 Free Software Foundation, Inc. commit d32cf354b0c82d9ea7e0a538f7baaae89e8d32cb Author: Stefan Kangas Date: Thu Sep 10 18:54:12 2020 +0200 Use lexical-binding in url-future-tests.el * test/lisp/url/url-future-tests.el: Use lexical-binding. (url-future-tests--saver): New variable. (url-future-tests): Use new variable. diff --git a/test/lisp/url/url-future-tests.el b/test/lisp/url/url-future-tests.el index 2c5d45d62b..a07730a2be 100644 --- a/test/lisp/url/url-future-tests.el +++ b/test/lisp/url/url-future-tests.el @@ -1,4 +1,4 @@ -;;; url-future-tests.el --- Test suite for url-future. +;;; url-future-tests.el --- Test suite for url-future. -*- lexical-binding:t -*- ;; Copyright (C) 2011-2020 Free Software Foundation, Inc. @@ -25,31 +25,33 @@ (require 'ert) (require 'url-future) +(defvar url-future-tests--saver) + (ert-deftest url-future-tests () - (let* (saver + (let* (url-future-tests--saver (text "running future") (good (make-url-future :value (lambda () (format text)) - :callback (lambda (f) (set 'saver f)))) + :callback (lambda (f) (set 'url-future-tests--saver f)))) (bad (make-url-future :value (lambda () (/ 1 0)) - :errorback (lambda (&rest d) (set 'saver d)))) + :errorback (lambda (&rest d) (set 'url-future-tests--saver d)))) (tocancel (make-url-future :value (lambda () (/ 1 0)) - :callback (lambda (f) (set 'saver f)) + :callback (lambda (f) (set 'url-future-tests--saver f)) :errorback (lambda (&rest d) - (set 'saver d))))) + (set 'url-future-tests--saver d))))) (should (equal good (url-future-call good))) - (should (equal good saver)) + (should (equal good url-future-tests--saver)) (should (equal text (url-future-value good))) (should (url-future-completed-p good)) (should-error (url-future-call good)) - (setq saver nil) + (setq url-future-tests--saver nil) (should (equal bad (url-future-call bad))) (should-error (url-future-call bad)) - (should (equal saver (list bad '(arith-error)))) + (should (equal url-future-tests--saver (list bad '(arith-error)))) (should (url-future-errored-p bad)) - (setq saver nil) + (setq url-future-tests--saver nil) (should (equal (url-future-cancel tocancel) tocancel)) (should-error (url-future-call tocancel)) - (should (null saver)) + (should (null url-future-tests--saver)) (should (url-future-cancelled-p tocancel)))) (provide 'url-future-tests) commit 88a25960ec19bbc079f7ba07f020e8ab048e7efc Author: Stefan Kangas Date: Thu Sep 10 18:47:07 2020 +0200 Use lexical-binding in semantic-utest-c.el * test/lisp/cedet/semantic-utest-c.el: Use lexical-binding. (semantic-test-gcc-output-parser): Fix warning. diff --git a/test/lisp/cedet/semantic-utest-c.el b/test/lisp/cedet/semantic-utest-c.el index bdd6c050df..c3496648f2 100644 --- a/test/lisp/cedet/semantic-utest-c.el +++ b/test/lisp/cedet/semantic-utest-c.el @@ -1,4 +1,4 @@ -;;; semantic-utest-c.el --- C based parsing tests. +;;; semantic-utest-c.el --- C based parsing tests. -*- lexical-binding:t -*- ;; Copyright (C) 2008-2020 Free Software Foundation, Inc. @@ -40,6 +40,8 @@ (defvar semantic-utest-c-test-directory (expand-file-name "tests" cedet-utest-directory) "Location of test files.") +(defvar semantic-lex-c-nested-namespace-ignore-second) + ;;; Code: ;;;###autoload (ert-deftest semantic-test-c-preprocessor-simulation () @@ -146,33 +148,32 @@ gcc version 2.95.2 19991024 (release)" (ert-deftest semantic-test-gcc-output-parser () "Test the output parser against some collected strings." - (let ((fail nil)) - (dolist (S semantic-gcc-test-strings) - (let* ((fields (semantic-gcc-fields S)) - (v (cdr (assoc 'version fields))) - (h (or (cdr (assoc 'target fields)) - (cdr (assoc '--target fields)) - (cdr (assoc '--host fields)))) - (p (cdr (assoc '--prefix fields))) - ) - ;; No longer test for prefixes. - (when (not (and v h)) - (let ((strs (split-string S "\n"))) - (message "Test failed on %S\nV H P:\n%S %S %S" (car strs) v h p) - )) - (should (and v h)) - )) - (dolist (S semantic-gcc-test-strings-fail) - (let* ((fields (semantic-gcc-fields S)) - (v (cdr (assoc 'version fields))) - (h (or (cdr (assoc '--host fields)) - (cdr (assoc 'target fields)))) - (p (cdr (assoc '--prefix fields))) - ) - ;; negative test - (should-not (and v h p)) - )) - )) + (dolist (S semantic-gcc-test-strings) + (let* ((fields (semantic-gcc-fields S)) + (v (cdr (assoc 'version fields))) + (h (or (cdr (assoc 'target fields)) + (cdr (assoc '--target fields)) + (cdr (assoc '--host fields)))) + (p (cdr (assoc '--prefix fields))) + ) + ;; No longer test for prefixes. + (when (not (and v h)) + (let ((strs (split-string S "\n"))) + (message "Test failed on %S\nV H P:\n%S %S %S" (car strs) v h p) + )) + (should (and v h)) + )) + (dolist (S semantic-gcc-test-strings-fail) + (let* ((fields (semantic-gcc-fields S)) + (v (cdr (assoc 'version fields))) + (h (or (cdr (assoc '--host fields)) + (cdr (assoc 'target fields)))) + (p (cdr (assoc '--prefix fields))) + ) + ;; negative test + (should-not (and v h p)) + )) + ) (provide 'semantic-utest-c) commit be5047c0d2a3696f8cbd0e36987ef78ded6df09b Author: Michael Albinus Date: Thu Sep 10 18:49:22 2020 +0200 Implement D-Bus properties with compound type. * lisp/net/dbus.el (dbus-set-property): Fix thinko. (dbus-register-property, dbus-property-handler): Support compound properties. * src/dbusbind.c (dbus-registered-objects-table): Fix docstring. * test/lisp/net/dbus-tests.el (dbus--test-interface): Make it different to `dbus--test-service'. (dbus-test05-register-property) (dbus-test05-register-property-several-paths): Adapt tests. diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index 5afc7f111f..b0151200ff 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -1462,7 +1462,7 @@ VALUE. Otherwise, return nil. ;; "Set" requires a variant. (dbus-call-method bus service path dbus-interface-properties - "Set" :timeout 500 interface property (cons :variant args)) + "Set" :timeout 500 interface property (list :variant args)) ;; Return VALUE. The property could have the `:write' access type, ;; so we ignore errors in `dbus-get-property'. (dbus-ignore-errors @@ -1543,13 +1543,15 @@ clients from discovering the still incomplete interface. \(dbus-register-property BUS SERVICE PATH INTERFACE PROPERTY ACCESS \ [TYPE] VALUE &optional EMITS-SIGNAL DONT-REGISTER-SERVICE)" - (let ((type (when (symbolp (car args)) (pop args))) + (let ((signature "s") ;; FIXME: For the time being. + ;; Read basic type symbol. + (type (when (symbolp (car args)) (pop args))) (value (pop args)) (emits-signal (pop args)) (dont-register-service (pop args))) (unless (member access '(:read :write :readwrite)) (signal 'wrong-type-argument (list "Access type invalid" access))) - (unless type + (unless (or type (consp value)) (setq type (cond ((memq value '(t nil)) :boolean) @@ -1559,6 +1561,8 @@ clients from discovering the still incomplete interface. ((stringp value) :string) (t (signal 'wrong-type-argument (list "Value type invalid" value)))))) + (unless (consp value) + (setq value (list type value))) ;; Add handlers for the three property-related methods. (dbus-register-method @@ -1579,12 +1583,14 @@ clients from discovering the still incomplete interface. (when emits-signal (dbus-send-signal bus service path dbus-interface-properties "PropertiesChanged" - (if (member access '(:read :readwrite)) - `(:array - (:dict-entry - ,property - ,(if type (list :variant type value) (list :variant value)))) - '(:array: :signature "{sv}")) + ;; changed_properties. + (if (eq access :write) + '(:array: :signature "{sv}") + `(:array + (:dict-entry + ,property + ,(if type (list :variant type value) (list :variant value))))) + ;; invalidated_properties. (if (eq access :write) `(:array ,property) '(:array)))) @@ -1595,10 +1601,7 @@ clients from discovering the still incomplete interface. (val (cons (list - nil service path - (cons - (if emits-signal (list access :emits-signal) (list access)) - (if type (list type value) (list value)))) + nil service path (list access emits-signal signature value)) (dbus-get-other-registered-properties bus service path interface property)))) (puthash key val dbus-registered-objects-table) @@ -1626,16 +1629,19 @@ It will be registered for all objects created by `dbus-register-property'." `(:error ,dbus-error-unknown-property ,(format-message "No such property \"%s\" at path \"%s\"" property path))) - ((memq :write (car object)) + ((eq :write (car object)) `(:error ,dbus-error-access-denied ,(format-message "Property \"%s\" at path \"%s\" is not readable" property path))) - ;; Return the result. - (t (list :variant (cdar (last (car entry)))))))) + ;; Return the result. Since variant is a list, we must embed + ;; it into another list. + (t (list (if (eq :array (car (nth 3 object))) + (list :variant (nth 3 object)) + (cons :variant (nth 3 object)))))))) - ;; "Set" expects a variant. + ;; "Set" expects the same type as registered. ((string-equal method "Set") - (let* ((value (caar (cddr args))) + (let* ((value (caar (nth 2 args))) (entry (dbus-get-this-registered-property bus service path interface property)) (object (car (last (car entry))))) @@ -1644,27 +1650,30 @@ It will be registered for all objects created by `dbus-register-property'." `(:error ,dbus-error-unknown-property ,(format-message "No such property \"%s\" at path \"%s\"" property path))) - ((memq :read (car object)) + ((eq :read (car object)) `(:error ,dbus-error-property-read-only ,(format-message "Property \"%s\" at path \"%s\" is not writable" property path))) - (t (puthash (list :property bus interface property) + (t (unless (consp value) + (setq value (list (car (nth 3 object)) value))) + (puthash (list :property bus interface property) (cons (append (butlast (car entry)) - ;; Reuse ACCESS und TYPE from registration. - (list (list (car object) (cadr object) value))) + ;; Reuse ACCESS, EMITS-SIGNAL and TYPE. + (list (append (butlast object) (list value)))) (dbus-get-other-registered-properties bus service path interface property)) dbus-registered-objects-table) ;; Send the "PropertiesChanged" signal. - (when (member :emits-signal (car object)) + (when (nth 1 object) (dbus-send-signal bus service path dbus-interface-properties "PropertiesChanged" - (if (or (member :read (car object)) - (member :readwrite (car object))) - `(:array (:dict-entry ,property (:variant ,value))) - '(:array: :signature "{sv}")) - (if (eq (car object) :write) + ;; changed_properties. + (if (eq :write (car object)) + '(:array: :signature "{sv}") + `(:array (:dict-entry ,property (:variant ,value)))) + ;; invalidated_properties. + (if (eq :write (car object)) `(:array ,property) '(:array)))) ;; Return empty reply. @@ -1677,18 +1686,22 @@ It will be registered for all objects created by `dbus-register-property'." (lambda (key val) (when (consp val) (dolist (item val) - (when (and (equal (butlast key) (list :property bus interface)) - (string-equal path (nth 2 item)) - (consp (car (last item))) - (not (memq :write (caar (last item))))) - (push - (list :dict-entry - (car (last key)) - (cons :variant (cdar (last item)))) - result))))) + (let ((object (car (last item)))) + (when (and (equal (butlast key) (list :property bus interface)) + (string-equal path (nth 2 item)) + (consp object) + (not (eq :write (car object)))) + (push + (list :dict-entry + (car (last key)) + (if (eq :array (car (nth 3 object))) + (list :variant (nth 3 object)) + (cons :variant (nth 3 object)))) + result)))))) dbus-registered-objects-table) - ;; Return the result, or an empty array. - (list :array (or result '(:signature "{sv}"))))) + ;; Return the result, or an empty array. An array must be + ;; embedded in a list. + (list (cons :array (or result '(:signature "{sv}")))))) (t `(:error ,dbus-error-unknown-method ,(format-message @@ -1896,6 +1909,8 @@ this connection to those buses." ;;; TODO: +;; Support other compound properties but array. + ;; * Implement org.freedesktop.DBus.ObjectManager.InterfacesAdded and ;; org.freedesktop.DBus.ObjectManager.InterfacesRemoved. ;; diff --git a/src/dbusbind.c b/src/dbusbind.c index af294afe92..02af244ac3 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -1824,10 +1824,11 @@ SERVICE PATH OBJECT [RULE]) ...). SERVICE is the service name as registered, UNAME is the corresponding unique name. In case of registered methods and properties, UNAME is nil. PATH is the object path of the sending object. All of them can be nil, which means a -wildcard then. OBJECT is either the handler to be called when a D-Bus -message, which matches the key criteria, arrives (TYPE `:method' and -`:signal'), or a list containing the value of the property and its -attributes (TYPE `:property'). +wildcard then. + +OBJECT is either the handler to be called when a D-Bus message, which +matches the key criteria, arrives (TYPE `:method' and `:signal'), or a +list (ACCESS EMITS-SIGNAL SIGNATURE VALUE) for TYPE `:property'. For entries of type `:signal', there is also a fifth element RULE, which keeps the match string the signal is registered with. diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el index 8b456c3551..a8e052efbe 100644 --- a/test/lisp/net/dbus-tests.el +++ b/test/lisp/net/dbus-tests.el @@ -41,7 +41,7 @@ (defconst dbus--test-path "/org/gnu/Emacs/TestDBus" "Test object path.") -(defconst dbus--test-interface "org.gnu.Emacs.TestDBus" +(defconst dbus--test-interface "org.gnu.Emacs.TestDBus.Interface" "Test interface.") (defun dbus--test-availability (bus) @@ -249,6 +249,7 @@ This includes initialization and closing the bus." ;; Cleanup. (dbus-unregister-service :session dbus--test-service))) +;; TODO: Test emits-signal, unregister. (ert-deftest dbus-test05-register-property () "Check property registration for an own service." (skip-unless dbus--test-enabled-session-bus) @@ -271,7 +272,7 @@ This includes initialization and closing the bus." (dbus-register-property :session dbus--test-service dbus--test-path dbus--test-interface property1 :read "foo") - `((:property :session "org.gnu.Emacs.TestDBus" ,property1) + `((:property :session ,dbus--test-interface ,property1) (,dbus--test-service ,dbus--test-path)))) (should (string-equal @@ -296,7 +297,7 @@ This includes initialization and closing the bus." (dbus-register-property :session dbus--test-service dbus--test-path dbus--test-interface property2 :write "bar") - `((:property :session "org.gnu.Emacs.TestDBus" ,property2) + `((:property :session ,dbus--test-interface ,property2) (,dbus--test-service ,dbus--test-path)))) (should-not ;; Due to `:write' access type. (dbus-get-property @@ -319,7 +320,7 @@ This includes initialization and closing the bus." (dbus-register-property :session dbus--test-service dbus--test-path dbus--test-interface property3 :readwrite :object-path "/baz") - `((:property :session "org.gnu.Emacs.TestDBus" ,property3) + `((:property :session ,dbus--test-interface ,property3) (,dbus--test-service ,dbus--test-path)))) (should (string-equal @@ -381,14 +382,14 @@ This includes initialization and closing the bus." (dbus-register-property :session dbus--test-service dbus--test-path dbus--test-interface property1 :readwrite "foo") - `((:property :session "org.gnu.Emacs.TestDBus" ,property1) + `((:property :session ,dbus--test-interface ,property1) (,dbus--test-service ,dbus--test-path)))) (should (equal (dbus-register-property :session dbus--test-service dbus--test-path dbus--test-interface property2 :readwrite "bar") - `((:property :session "org.gnu.Emacs.TestDBus" ,property2) + `((:property :session ,dbus--test-interface ,property2) (,dbus--test-service ,dbus--test-path)))) (should (string-equal @@ -434,14 +435,14 @@ This includes initialization and closing the bus." (dbus-register-property :session dbus--test-service (concat dbus--test-path dbus--test-path) dbus--test-interface property2 :readwrite "foo") - `((:property :session "org.gnu.Emacs.TestDBus" ,property2) + `((:property :session ,dbus--test-interface ,property2) (,dbus--test-service ,(concat dbus--test-path dbus--test-path))))) (should (equal (dbus-register-property :session dbus--test-service (concat dbus--test-path dbus--test-path) dbus--test-interface property3 :readwrite "bar") - `((:property :session "org.gnu.Emacs.TestDBus" ,property3) + `((:property :session ,dbus--test-interface ,property3) (,dbus--test-service ,(concat dbus--test-path dbus--test-path))))) (should (string-equal commit 70a8d06fe125f66266d66ece2a428c01f1d9b4e1 Author: Nick Savage Date: Thu Sep 10 15:18:46 2020 +0200 Open describe-function NEWS links in view-mode * lisp/help-mode.el (help-news): Open describe-function NEWS links in view-mode (Bug#39912) Copyright-paperwork-exempt: yes diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 9c2d1d7227..0dc6c9ffae 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -308,7 +308,7 @@ The format is (FUNCTION ARGS...).") :supertype 'help-xref 'help-function (lambda (file pos) - (pop-to-buffer (find-file-noselect file)) + (view-buffer-other-window (find-file-noselect file)) (goto-char pos)) 'help-echo (purecopy "mouse-2, RET: show corresponding NEWS announcement")) commit 6c46dddcb25c959836d4b7ab1d6f174db5dff4b2 Author: Alex Bochannek Date: Thu Sep 10 15:16:04 2020 +0200 Fix up < and > "date" scoring rules in Gnus * lisp/gnus/gnus-score.el (gnus-score-date): The previous < and > "date" scoring rules (added in the previous patch) had reversed logic (bug#43270). Copyright-paperwork-exempt: yes diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index c5156a195a..6a0e8ceb99 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -1695,9 +1695,10 @@ score in `gnus-newsgroup-scored' by SCORE." match (gnus-date-iso8601 (nth 0 kill)))) ((eq type '<) (setq type 'after - match-func 'gnus-string> + match-func 'string< match (gnus-time-iso8601 - (time-add (current-time) (* 86400 (nth 0 kill)))))) + (time-subtract (current-time) + (* 86400 (nth 0 kill)))))) ((eq type 'before) (setq match-func 'gnus-string> match (gnus-date-iso8601 (nth 0 kill)))) @@ -1705,7 +1706,8 @@ score in `gnus-newsgroup-scored' by SCORE." (setq type 'before match-func 'gnus-string> match (gnus-time-iso8601 - (time-add (current-time) (* -86400 (nth 0 kill)))))) + (time-subtract (current-time) + (* 86400 (nth 0 kill)))))) ((eq type 'at) (setq match-func 'string= match (gnus-date-iso8601 (nth 0 kill)))) commit c033bb8648dc6fc14c96925710d662dbcd214cc7 Author: Mauro Aranda Date: Thu Sep 10 15:12:50 2020 +0200 Fix :match function for the file widget * lisp/wid-edit.el (file widget): Return nil if value is not a string (bug#25678). diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index e9799dc00f..bc2afc6a6f 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -3162,8 +3162,9 @@ It reads a file name from an editable text field." #'completion-file-name-table (not read-file-name-completion-ignore-case)) :match (lambda (widget value) - (or (not (widget-get widget :must-match)) - (file-exists-p value))) + (and (stringp value) + (or (not (widget-get widget :must-match)) + (file-exists-p value)))) :validate (lambda (widget) (let ((value (widget-value widget))) (unless (widget-apply widget :match value) commit 5d522b430bd5ecfb8f082906cd634883dbb68f3e Author: Lars Ingebrigtsen Date: Thu Sep 10 14:21:07 2020 +0200 Revert back to using ESC as viper-ESC-key again * lisp/emulation/viper-keym.el (viper-ESC-key): Revert back to using ESC instead of `escape' (bug#18182). This allows using `C-[' again on terminals for ESC. The key should be mapped back to `escape' by `function-key-map'. diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el index 1b149b12e4..d76cf71b31 100644 --- a/lisp/emulation/viper-keym.el +++ b/lisp/emulation/viper-keym.el @@ -184,7 +184,7 @@ In insert mode, this key also functions as Meta." :type 'string :group 'viper) -(defconst viper-ESC-key [escape] +(defconst viper-ESC-key (kbd "ESC") "Key used to ESC.") commit be64c36dd465efd3230b9201f82afbd005a1f412 Author: Andrew G Cohen Date: Thu Sep 10 20:23:34 2020 +0800 Fix new summary-line after editing an article in Gnus * lisp/gnus/gnus-sum.el (gnus-summary-edit-article-done): Strip ^M from the ends of lines after saving an edited article. Otherwise the new header isn't always parsed properly, resulting in an incorrect subject line in the summary buffer. diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 45397b518c..2f0ea0c58f 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -10708,6 +10708,7 @@ groups." ;; We only have to update this line. (save-excursion (save-restriction + (nnheader-ms-strip-cr) (message-narrow-to-head) (let ((head (buffer-substring-no-properties (point-min) (point-max)))