commit 81aed7becfdc66af464e54c90680e9507693bdaf (HEAD, refs/remotes/origin/master) Author: Glenn Morris Date: Sun Sep 20 17:20:08 2020 -0700 ; * lisp/emacs-lisp/syntax.el (syntax-propertize-function): Doc fix. diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el index 487faacd73..62f1b16d75 100644 --- a/lisp/emacs-lisp/syntax.el +++ b/lisp/emacs-lisp/syntax.el @@ -65,7 +65,7 @@ cannot be handled just by the buffer's syntax-table. The specified function may call `syntax-ppss' on any position before END, but if it calls `syntax-ppss' on some position and later modifies the buffer on some earlier position, -then it is its responsability to call `syntax-ppss-flush-cache' to flush +then it is its responsibility to call `syntax-ppss-flush-cache' to flush the now obsolete ppss info from the cache. Note: When this variable is a function, it must apply _all_ the commit 7a5132954b89736001351d7e03a72beed9372c84 Merge: 2e33c3fd8d 02a31c9632 Author: Glenn Morris Date: Sun Sep 20 17:18:16 2020 -0700 Merge from origin/emacs-27 02a31c9632 (origin/emacs-27) Minor improvement in the ELisp manual's ... f750def778 Mention in PROBLEMS the problems with fonts and Uniscribe 082d8a21b1 Minor copyedits in 'line-height' documentation 5b23393bcc ; * src/frame.c (syms_of_frame) : ... commit 2e33c3fd8d77bc34d27464e2ae0926d1c8e5184d Merge: 3675993d76 c151797da9 Author: Glenn Morris Date: Sun Sep 20 17:18:16 2020 -0700 ; Merge from origin/emacs-27 The following commit was skipped: c151797da9 * doc/misc/eww.texi: Document the `w' key's double function commit 3675993d76cc6db43703240d0ff0fd892abf1b41 Merge: 15c594c282 df04f3e755 Author: Glenn Morris Date: Sun Sep 20 17:18:16 2020 -0700 Merge from origin/emacs-27 df04f3e755 Fix a rare segfault in syntax.c fd1fe1e1ec Add doc to syntax-propertize-function saying it must do a ... fcd599bbea Minor copyedits of doc of 'with-silent-modifications' 759399cdb1 Improve documentation of 'max-mini-window-height' 3223302aa2 Use modern constant names for the NS pasteboard 985703d380 Fix doc string of 'toggle-menu-bar-mode-from-frame' 184a4977c7 Make vc-bzr tests work with brz 3.1 (bug#43314) # Conflicts: # lisp/emacs-lisp/syntax.el # src/syntax.c commit 15c594c282176cf8e29072de2934a046922053b1 Merge: 5a2125b854 03093baf90 Author: Glenn Morris Date: Sun Sep 20 17:10:50 2020 -0700 ; Merge from origin/emacs-27 The following commit was skipped: 03093baf90 diff-no-select doc string clarification commit 5a2125b854b58d52554ad545f66a74e21caa6d32 Merge: ec6254e552 694acda5f2 Author: Glenn Morris Date: Sun Sep 20 17:10:50 2020 -0700 Merge from origin/emacs-27 694acda5f2 Fix compilation on TERMINFO platforms with GCC 10 f3373901e5 Fix the font-lock-debug-fontify NEWS entry # Conflicts: # etc/NEWS commit ec6254e5527b2b0aa6d93d6c83873aa400c20db3 Author: Lars Ingebrigtsen Date: Mon Sep 21 00:26:54 2020 +0200 Fix infloop when folding difficult headers in Message * lisp/mail/rfc2047.el (rfc2047-fold-field): Return the end point. * lisp/gnus/message.el (message--fold-long-headers): Use that to reliably achieve progress. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 3e7e18906c..16f47c8d4c 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -4843,10 +4843,10 @@ If you always want Gnus to send messages in one piece, set Each line should be no more than 79 characters long." (goto-char (point-min)) (while (not (eobp)) - (when (and (looking-at "[^:]+:") - (> (- (line-end-position) (point)) 79)) - (mail-header-fold-field)) - (forward-line 1))) + (if (and (looking-at "[^:]+:") + (> (- (line-end-position) (point)) 79)) + (goto-char (mail-header-fold-field)) + (forward-line 1)))) (defvar sendmail-program) (defvar smtpmail-smtp-server) diff --git a/lisp/mail/rfc2047.el b/lisp/mail/rfc2047.el index 234f319669..4aa0c2809b 100644 --- a/lisp/mail/rfc2047.el +++ b/lisp/mail/rfc2047.el @@ -716,11 +716,13 @@ Point moves to the end of the region." (goto-char e))))) (defun rfc2047-fold-field () - "Fold the current header field." + "Fold the current header field. +Return the new end point." (save-excursion (save-restriction (rfc2047-narrow-to-field) - (rfc2047-fold-region (point-min) (point-max))))) + (rfc2047-fold-region (point-min) (point-max)) + (point-max)))) (defun rfc2047-fold-region (b e) "Fold long lines in region B to E." commit f4d186b3b80c513338d6c7ddaef75f5aaa5c1dcb Author: Lars Ingebrigtsen Date: Mon Sep 21 00:22:22 2020 +0200 Allow not selecting messages in Gnus before resending * lisp/gnus/gnus-msg.el (gnus-summary-resend-message): Allow not selecting messages. This is faster when resending huge spam messages. diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index 7bc7fb5be4..465871eafb 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -1352,8 +1352,10 @@ For the \"inline\" alternatives, also see the variable gcc))) (insert "Gcc: " (mapconcat 'identity gcc ", ") "\n"))))))) -(defun gnus-summary-resend-message (address n) - "Resend the current article to ADDRESS." +(defun gnus-summary-resend-message (address n &optional no-select) + "Resend the current article to ADDRESS. +Uses the process/prefix convention. If NO-SELECT, don't display +the message before resending." (interactive (list (message-read-from-minibuffer "Resend message(s) to: " @@ -1372,6 +1374,7 @@ For the \"inline\" alternatives, also see the variable 'posting-style t)) (user-full-name user-full-name) (user-mail-address user-mail-address) + (group gnus-newsgroup-name) tem) (dolist (style styles) (when (stringp (cadr style)) @@ -1395,11 +1398,18 @@ For the \"inline\" alternatives, also see the variable '(gnus-agent-possibly-do-gcc) '(gnus-inews-do-gcc))))) (dolist (article (gnus-summary-work-articles n)) - (gnus-summary-select-article nil nil nil article) - (with-current-buffer gnus-original-article-buffer - (let ((gnus-gcc-externalize-attachments nil) - (message-inhibit-body-encoding t)) - (message-resend address))) + (if no-select + (with-current-buffer " *nntpd*" + (erase-buffer) + (gnus-request-article article group) + (let ((gnus-gcc-externalize-attachments nil) + (message-inhibit-body-encoding t)) + (message-resend address))) + (gnus-summary-select-article nil nil nil article) + (with-current-buffer gnus-original-article-buffer + (let ((gnus-gcc-externalize-attachments nil) + (message-inhibit-body-encoding t)) + (message-resend address)))) (gnus-summary-mark-article-as-forwarded article)))) ;; From: Matthieu Moy commit 6d9297abe0561e9a3750d4f07919b2973ec31504 Author: Lars Ingebrigtsen Date: Sun Sep 20 23:32:45 2020 +0200 Make xterm-mouse-event check whether the click event is valid * lisp/xt-mouse.el (xterm-mouse-event): Defensively check against a situation that shouldn't happen (but does) (bug#17378). diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index 2b9fab556e..362d29b943 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -237,7 +237,10 @@ which is the \"1006\" extension implemented in Xterm >= 277." (xterm-mouse--read-event-sequence extension)) (t (error "Unsupported XTerm mouse protocol"))))) - (when click + (when (and click + ;; In very obscure circumstances, the click may become + ;; invalid (see bug#17378). + (>= (nth 1 click) 0)) (let* ((type (nth 0 click)) (x (nth 1 click)) (y (nth 2 click)) commit 6089dec2b495527cd3ab7dc2390ae053cec33f00 Author: Alan Mackenzie Date: Sun Sep 20 19:57:05 2020 +0000 C++ Mode: Modernize the fontification of "using" Since "using" is now used in three distinct ways in C++, write a special function to handle these rather than attempting to adapt the old regular expressions. * lisp/progmodes/cc-fonts.el (c-font-lock-declarators): Amend to allow the argument TYPES to be a face. This face is given to the declarator being processed. (c-font-lock-single-decl): Make an argument to c-font-lock-declarators nil or t, not merely nil or non-nil. (c-complex-decl-matchers): Include c-font-lock-c++-using in the C++ value of this variable. (c-font-lock-c++-using): New function. * lisp/progmodes/cc-langs.el (c-using-kwds, c-using-key): New lang consts/vars. (c-modifier-kwds): Remove "using" from the C++ value. diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 386cc2f16f..bb7e5bea6e 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -1073,17 +1073,18 @@ casts and declarations are fontified. Used on level 2 and higher." (defun c-font-lock-declarators (limit list types not-top &optional template-class) ;; Assuming the point is at the start of a declarator in a declaration, - ;; fontify the identifier it declares. (If TYPES is set, it does this via - ;; the macro `c-fontify-types-and-refs'.) + ;; fontify the identifier it declares. (If TYPES is t, it does this via the + ;; macro `c-fontify-types-and-refs'.) ;; ;; If LIST is non-nil, also fontify the ids in any following declarators in ;; a comma separated list (e.g. "foo" and "*bar" in "int foo = 17, *bar;"); ;; additionally, mark the commas with c-type property 'c-decl-id-start or ;; 'c-decl-type-start (according to TYPES). Stop at LIMIT. ;; - ;; If TYPES is non-nil, fontify all identifiers as types. If NOT-TOP is - ;; non-nil, we are not at the top-level ("top-level" includes being directly - ;; inside a class or namespace, etc.). + ;; If TYPES is t, fontify all identifiers as types, if it is nil fontify as + ;; either variables or functions, otherwise TYPES is a face to use. If + ;; NOT-TOP is non-nil, we are not at the top-level ("top-level" includes + ;; being directly inside a class or namespace, etc.). ;; ;; TEMPLATE-CLASS is non-nil when the declaration is in template delimiters ;; and was introduced by, e.g. "typename" or "class", such that if there is @@ -1100,9 +1101,10 @@ casts and declarations are fontified. Used on level 2 and higher." () (c-do-declarators limit list not-top - (if types 'c-decl-type-start 'c-decl-id-start) + (cond ((eq types t) 'c-decl-type-start) + ((null types) 'c-decl-id-start)) (lambda (id-start _id-end end-pos _not-top is-function init-char) - (if types + (if (eq types t) ;; Register and fontify the identifier as a type. (let ((c-promote-possible-types t)) (goto-char id-start) @@ -1121,9 +1123,10 @@ casts and declarations are fontified. Used on level 2 and higher." ;; `c-forward-declarator'. (c-put-font-lock-face (car c-last-identifier-range) (cdr c-last-identifier-range) - (if is-function - 'font-lock-function-name-face - 'font-lock-variable-name-face)))) + (cond + ((not (memq types '(nil t))) types) + (is-function 'font-lock-function-name-face) + (t 'font-lock-variable-name-face))))) (and template-class (eq init-char ?=) ; C++ ""? (progn @@ -1357,7 +1360,8 @@ casts and declarations are fontified. Used on level 2 and higher." 'c-decl-id-start))))) (c-font-lock-declarators (min limit (point-max)) decl-list - (cadr decl-or-cast) (not toplev) template-class)) + (not (null (cadr decl-or-cast))) + (not toplev) template-class)) ;; A declaration has been successfully identified, so do all the ;; fontification of types and refs that've been recorded. @@ -2004,6 +2008,9 @@ on level 2 only and so aren't combined with `c-complex-decl-matchers'." ,@(when (c-major-mode-is 'c++-mode) '(c-font-lock-c++-lambda-captures)) + ,@(when (c-lang-const c-using-key) + `(c-font-lock-c++-using)) + ;; The first two rules here mostly find occurrences that ;; `c-font-lock-declarations' has found already, but not ;; declarations containing blocks in the type (see note below). @@ -2263,6 +2270,40 @@ need for `c-font-lock-extra-types'.") ;;; C++. +(defun c-font-lock-c++-using (limit) + ;; Fontify any clauses starting with the keyword `using'. + ;; + ;; This function will be called from font-lock- for a region bounded by + ;; POINT and LIMIT, as though it were to identify a keyword for + ;; font-lock-keyword-face. It always returns NIL to inhibit this and + ;; prevent a repeat invocation. See elisp/lispref page "Search-based + ;; fontification". + (let (pos after-name) + (while (c-syntactic-re-search-forward c-using-key limit 'end) + (while ; Do one declarator of a comma separated list, each time around. + (progn + (c-forward-syntactic-ws) + (setq pos (point)) ; token after "using". + (when (and (c-on-identifier) + (c-forward-name)) + (setq after-name (point)) + (cond + ((eq (char-after) ?=) ; using foo = ; + (goto-char pos) + (c-font-lock-declarators limit nil t nil)) + ((save-excursion + (and c-colon-type-list-re + (c-go-up-list-backward) + (eq (char-after) ?{) + (eq (car (c-beginning-of-decl-1)) 'same) + (looking-at c-colon-type-list-re))) + ;; Inherited protected member: leave unfontified + ) + (t (goto-char pos) + (c-font-lock-declarators limit nil c-label-face-name nil))) + (eq (char-after) ?,))) + (forward-char))) ; over the comma. + nil)) (defun c-font-lock-c++-new (limit) ;; FIXME!!! Put in a comment about the context of this function's diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index bf035c9a9e..13e70a3251 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -2338,6 +2338,16 @@ will be handled." t (c-make-keywords-re t (c-lang-const c-typedef-decl-kwds))) (c-lang-defvar c-typedef-decl-key (c-lang-const c-typedef-decl-key)) +(c-lang-defconst c-using-kwds + "Keywords which behave like `using' in C++" + t nil + c++ '("using")) + +(c-lang-defconst c-using-key + ;; Regexp matching C++'s `using'. + t (c-make-keywords-re t (c-lang-const c-using-kwds))) +(c-lang-defvar c-using-key (c-lang-const c-using-key)) + (c-lang-defconst c-typeless-decl-kwds "Keywords introducing declarations where the (first) identifier \(declarator) follows directly after the keyword, without any type. @@ -2388,7 +2398,8 @@ will be handled." t nil (c c++) '("auto" "extern" "inline" "register" "static") c++ (append '("constexpr" "explicit" "friend" "mutable" "template" - "thread_local" "using" "virtual") + "thread_local" "virtual") + ;; "using" is now handled specially (2020-09-14). (c-lang-const c-modifier-kwds)) objc '("auto" "bycopy" "byref" "extern" "in" "inout" "oneway" "out" "static") ;; FIXME: Some of those below ought to be on `c-other-decl-kwds' instead. commit 2007cd3cac689e4683bdf6c01b220cde48d25aa2 Author: Lars Ingebrigtsen Date: Sun Sep 20 21:43:01 2020 +0200 Restore the previous minimum-width specs in the line/column mode lines * lisp/bindings.el (mode-line-position-line-format) (mode-line-position-column-format) (mode-line-position-column-line-format, mode-line-position): Restore the previous min-width specs (bug#28648). diff --git a/lisp/bindings.el b/lisp/bindings.el index a1751a253c..f31c6cc336 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -433,32 +433,32 @@ displayed in `mode-line-position', a component of the default :group 'mode-line) (put 'mode-line-percent-position 'risky-local-variable t) -(defcustom mode-line-position-line-format '(-6 " L%l") +(defcustom mode-line-position-line-format '(" L%l") "Format used to display line numbers in the mode line. This is used when `line-number-mode' is switched on. The \"%l\" format spec will be replaced by the line number." - :type 'form + :type '(list string) :version "28.1" :group 'mode-line) -(defcustom mode-line-position-column-format '(-6 " C%c") +(defcustom mode-line-position-column-format '(" C%c") "Format used to display column numbers in the mode line. This is used when `column-number-mode' is switched on. The \"%c\" format spec will be replaced by the column number, which is zero-based if `column-number-indicator-zero-based' is non-nil, and one-based if `column-number-indicator-zero-based' is nil." - :type 'form + :type '(list string) :version "28.1" :group 'mode-line) -(defcustom mode-line-position-column-line-format '(-10 " (%l,%c)") +(defcustom mode-line-position-column-line-format '(" (%l,%c)") "Format used to display combined line/column numbers in the mode line. This is used when `column-number-mode' and `line-number-mode' are switched on. The \"%c\" format spec will be replaced by the column number, which is zero-based if `column-number-indicator-zero-based' is non-nil, and one-based if `column-number-indicator-zero-based' is nil." - :type 'form + :type '(list string) :version "28.1" :group 'mode-line) @@ -487,27 +487,30 @@ mouse-1: Display Line and Column Mode Menu"))) (line-number-mode ((column-number-mode (column-number-indicator-zero-based - (:propertize - mode-line-position-column-line-format - ,@mode-line-position--column-line-properties) - (:propertize - (,(car mode-line-position-column-line-format) + (10 + (:propertize + mode-line-position-column-line-format + ,@mode-line-position--column-line-properties)) + (10 + (:propertize (:eval (replace-in-string - "%c" "%C" (cadr mode-line-position-column-line-format)))) - ,@mode-line-position--column-line-properties)) - (:propertize - mode-line-position-line-format - ,@mode-line-position--column-line-properties))) + "%c" "%C" (car mode-line-position-column-line-format))) + ,@mode-line-position--column-line-properties))) + (6 + (:propertize + mode-line-position-line-format + ,@mode-line-position--column-line-properties)))) (column-number-mode (column-number-indicator-zero-based - (:propertize - mode-line-position-column-format - ,@mode-line-position--column-line-properties) - (:propertize - (,(car mode-line-position-column-format) + (6 + (:propertize + mode-line-position-column-format + (,@mode-line-position--column-line-properties))) + (6 + (:propertize (:eval (replace-in-string - "%c" "%C" (cadr mode-line-position-column-format)))) - ,@mode-line-position--column-line-properties))))) + "%c" "%C" (car mode-line-position-column-format))) + ,@mode-line-position--column-line-properties)))))) "Mode line construct for displaying the position in the buffer. Normally displays the buffer percentage and, optionally, the buffer size, the line number and the column number.") commit dc2168ebf25b15a4bc960e17f65ce5117cc77467 Author: Lars Ingebrigtsen Date: Sun Sep 20 21:30:54 2020 +0200 Make (let ((:key 'foo)) :key) signal an error in lexical elisp, too * src/lread.c (intern_sym): Mark keywords as special (bug#38872). diff --git a/src/lread.c b/src/lread.c index 8064bf4d0e..4b788e9940 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4104,6 +4104,9 @@ intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index) { make_symbol_constant (sym); XSYMBOL (sym)->u.s.redirect = SYMBOL_PLAINVAL; + /* Mark keywords as special. This makes (let ((:key 'foo)) ...) + in lexically bound elisp signal an error, as documented. */ + XSYMBOL (sym)->u.s.declared_special = true; SET_SYMBOL_VAL (XSYMBOL (sym), sym); } commit 300a5a57573fc5814c33ae6d6de50477f96624e4 Author: Lars Ingebrigtsen Date: Sun Sep 20 19:20:57 2020 +0200 Fix typo in dbus.texi * doc/misc/dbus.texi (Type Conversion): Remove spurious { character. diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi index bea5581486..c317e5dd23 100644 --- a/doc/misc/dbus.texi +++ b/doc/misc/dbus.texi @@ -1036,7 +1036,7 @@ All basic D-Bus types based on a number are truncated to their type range. For example, @code{:byte 1025} is equal to @code{:byte 1}. If typed explicitly, a non-@code{nil} boolean value like -{@code{:boolean 'symbol} is handled like @code{t} or @code{:boolean t}. +@code{:boolean 'symbol} is handled like @code{t} or @code{:boolean t}. A D-Bus compound type is always represented as a list. The @sc{car} of this list can be the type symbol @code{:array}, @code{:variant}, commit f8624fb834e2d49eb7876f9768d668194ce6e407 Author: Michael Albinus Date: Sun Sep 20 16:44:17 2020 +0200 Make D-Bus properties type safe * doc/misc/dbus.texi (Properties and Annotations): Precise dbus-get-property and dbus-set-property. (Type Conversion): Explain :byte and :boolean type conversion. (Errors and Events): dbus-ignore-errors returns nil when there is a D-Bus error. Remove dbus-show-dbus-errors. * etc/NEWS: Some D-Bus relevant changes. * lisp/net/dbus.el (dbus-show-dbus-errors): Remove. (dbus-ignore-errors): Replay implamentation without that variable. (dbus-check-arguments): New defun. (dbus-list-activatable-names, dbus-list-names) (dbus-list-queued-owners, dbus-get-name-owner, dbus-introspect) (dbus-get-all-properties, dbus-get-all-managed-objects): Don't debug. (dbus-get-property, dbus-set-property): Propagate errors. (dbus-register-property): Check for valid VALUE. (dbus-property-handler): Simplify. * src/dbusbind.c (Fdbus_message_internal): Adapt docstring. Handle DBUS_MESSAGE_TYPE_INVALID. * test/lisp/net/dbus-tests.el (dbus-show-dbus-errors): Don't declare. (dbus-test06-register-property) (dbus-test06-register-property-emits-signal): Adapt tests. diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi index ef5f0b6625..bea5581486 100644 --- a/doc/misc/dbus.texi +++ b/doc/misc/dbus.texi @@ -732,8 +732,8 @@ A @var{property} value can be retrieved by the function @defun dbus-get-property bus service path interface property This function returns the value of @var{property} of @var{interface}. It will be checked at @var{bus}, @var{service}, @var{path}. The -result can be any valid D-Bus value, or @code{nil} if there is no -@var{property}. Example: +result can be any valid D-Bus value. If there is no @var{property}, +or @var{property} cannot be read, an error is raised. Example: @lisp (dbus-get-property @@ -749,7 +749,7 @@ This function sets the value of @var{property} of @var{interface} to @var{value}. It will be checked at @var{bus}, @var{service}, @var{path}. @var{value} can be preceded by a @var{type} symbol. When the value is successfully set, this function returns @var{value}. -Otherwise, it returns @code{nil}. Example: +Example: @lisp (dbus-set-property @@ -761,10 +761,11 @@ Otherwise, it returns @code{nil}. Example: @end defun @defun dbus-get-all-properties bus service path interface -This function returns all properties of @var{interface}. It will be -checked at @var{bus}, @var{service}, @var{path}. The result is a list -of cons. Every cons contains the name of the property, and its value. -If there are no properties, @code{nil} is returned. Example: +This function returns all readable properties of @var{interface}. It +will be checked at @var{bus}, @var{service}, @var{path}. The result +is a list of cons cells. Every cons cell contains the name of the +property, and its value. If there are no properties, @code{nil} is +returned. Example: @lisp (dbus-get-all-properties @@ -782,9 +783,9 @@ If there are no properties, @code{nil} is returned. Example: @defun dbus-get-all-managed-objects bus service path This function returns all objects at @var{bus}, @var{service}, @var{path}, and the children of @var{path}. The result is a list of -objects. Every object is a cons of an existing path name, and the -list of available interface objects. An interface object is another -cons, whose car is the interface name and cdr is the list of +objects. Every object is a cons cell of an existing path name, and +the list of available interface objects. An interface object is +another cons, whose car is the interface name and cdr is the list of properties as returned by @code{dbus-get-all-properties} for that path and interface. Example: @@ -1031,6 +1032,12 @@ represented outside this range are stripped off. For example, @code{:byte ?\C-x} or @code{:byte ?\M-\C-x}. Signed and unsigned integer D-Bus types expect a corresponding integer value. +All basic D-Bus types based on a number are truncated to their type +range. For example, @code{:byte 1025} is equal to @code{:byte 1}. + +If typed explicitly, a non-@code{nil} boolean value like +{@code{:boolean 'symbol} is handled like @code{t} or @code{:boolean t}. + A D-Bus compound type is always represented as a list. The @sc{car} of this list can be the type symbol @code{:array}, @code{:variant}, @code{:struct} or @code{:dict-entry}, which would result in a @@ -1070,7 +1077,7 @@ elements of this array. Example: (format ; Body. "This is a test notification, raised from\n%S" (emacs-version)) '(:array) ; No actions (empty array of strings). - '(:array :signature "@{sv@}") ; No hints + '(:array :signature "@{sv@}") ; No hints ; (empty array of dictionary entries). :int32 -1) ; Default timeout. @@ -1955,8 +1962,9 @@ appended to the @code{dbus-error}. @defspec dbus-ignore-errors forms@dots{} This executes @var{forms} exactly like a @code{progn}, except that -@code{dbus-error} errors are ignored during the @var{forms}. These -errors can be made visible when @code{dbus-debug} is set to @code{t}. +@code{dbus-error} errors are ignored during the @var{forms} (the macro +returns @code{nil} then). These errors can be made visible when +@code{dbus-debug} is set to non-@code{nil}. @end defspec Incoming D-Bus messages are handled as Emacs events, @pxref{Misc @@ -2035,11 +2043,10 @@ This function returns the member name of the D-Bus object @var{event} is coming from. It is either a signal name or a method name. @end defun -@vindex dbus-show-dbus-errors -D-Bus error messages are not propagated during event handling, because -it is usually not desired. D-Bus errors in events can be made visible -by setting the user option @code{dbus-show-dbus-errors} to -non-@code{nil}. They can also be handled by a hook function. +D-Bus errors are not propagated during event handling, because it is +usually not desired. D-Bus errors in events can be made visible by +setting the variable @code{dbus-debug} to non-@code{nil}. They can +also be handled by a hook function. @defvar dbus-event-error-functions This hook variable keeps a list of functions, which are called when a diff --git a/etc/NEWS b/etc/NEWS index 14d52008ac..1f52341ae4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -375,7 +375,7 @@ tags to be considered as well. ** Gnus +++ -*** New variable 'gnus-global-groups'. +*** New user option 'gnus-global-groups'. Gnus handles private groups differently from public (i.e., NNTP-like) groups. Most importantly, Gnus doesn't download external images from mail-like groups. This can be overridden by putting group names in @@ -389,8 +389,8 @@ You can now score based on the relative age of an article with the new +++ *** User-defined scoring is now possible. -The new type is 'score-fn'. More information in -(Gnus)Score File Format. +The new type is 'score-fn'. More information in the Gnus manual node +"(gnus) Score File Format". +++ *** New backend 'nnselect'. @@ -1045,7 +1045,7 @@ whose default value is 5. *** New user option 'reveal-auto-hide'. If non-nil (the default), revealed text is automatically hidden when point leaves the text. If nil, the text is not hidden again. Instead -`M-x reveal-hide-revealed' can be used to hide all the revealed text. +'M-x reveal-hide-revealed' can be used to hide all the revealed text. +++ *** New user options to control the look of line/column numbers in the mode line. @@ -1205,7 +1205,7 @@ The old names are now obsolete. +++ *** Property values can be typed explicitly. 'dbus-register-property' and 'dbus-set-property' accept now optional -type symbols. +type symbols. Both functions propagate D-Bus errors. +++ *** Registered properties can have the new access type ':write'. @@ -1215,9 +1215,7 @@ type symbols. +++ *** D-Bus errors, which have been converted from incoming D-Bus error -messages, contain the error name of that message now. They can be -made visible by setting user variable 'dbus-show-dbus-errors' to -non-nil, even if protected by 'dbus-ignore-errors' otherwise. +messages, contain the error name of that message now. --- *** D-Bus events keep the type information of their arguments. @@ -1557,7 +1555,7 @@ non-nil value. Please report any bugs you find while using the native image API via 'M-x report-emacs-bug'. --- -** The variable 'make-pointer-invisible' is now honored on macOS. +** The user option 'make-pointer-invisible' is now honored on macOS. ---------------------------------------------------------------------- diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index aab08dd0d4..458ee81d70 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -162,11 +162,6 @@ See URL `https://dbus.freedesktop.org/doc/dbus-specification.html#standard-inter :link '(custom-manual "(dbus)Top") :version "28.1") -(defcustom dbus-show-dbus-errors nil - "Propagate incoming D-Bus error messages." - :version "28.1" - :type 'boolean) - (defconst dbus-error-dbus "org.freedesktop.DBus.Error" "The namespace for default error names. See /usr/include/dbus-1.0/dbus/dbus-protocol.h.") @@ -225,17 +220,11 @@ shall be subdirectories of this path.") (defmacro dbus-ignore-errors (&rest body) "Execute BODY; signal D-Bus error when `dbus-debug' is non-nil. -Signals also D-Bus error when `dbus-show-dbus-errors' is non-nil -and a D-Bus error message has arrived. Otherwise, return result -of last form in BODY, or all other errors." +Otherwise, return result of last form in BODY, or all other errors." (declare (indent 0) (debug t)) `(condition-case err (progn ,@body) - (dbus-error - (when (or dbus-debug - (and dbus-show-dbus-errors - (= dbus-message-type-error (nth 2 last-input-event)))) - (signal (car err) (cdr err)))))) + (dbus-error (when dbus-debug (signal (car err) (cdr err)))))) (defvar dbus-event-error-functions '(dbus-notice-synchronous-call-errors) "Functions to be called when a D-Bus error happens in the event handler. @@ -548,6 +537,21 @@ This is an internal function, it shall not be used outside dbus.el." (apply #'dbus-message-internal dbus-message-type-error bus service serial error-name args)) +(defun dbus-check-arguments (bus service &rest args) + "Check arguments ARGS by side effect. +BUS, SERVICE and ARGS have the same format as in `dbus-call-method'. +Any wrong argument triggers a D-Bus error. Otherwise, return t. +This is an internal function, it shall not be used outside dbus.el." + + (or (featurep 'dbusbind) + (signal 'dbus-error (list "Emacs not compiled with dbus support"))) + (or (memq bus '(:system :session)) (stringp bus) + (signal 'wrong-type-argument (list 'keywordp bus))) + (or (stringp service) + (signal 'wrong-type-argument (list 'stringp service))) + + (apply #'dbus-message-internal dbus-message-type-invalid bus service args)) + ;;; Hash table of registered functions. @@ -1200,10 +1204,11 @@ function signals a `dbus-error' if the event is not well formed." BUS defaults to `:system' when nil or omitted. The result is a list of strings, which is nil when there are no activatable service names at all." - (dbus-ignore-errors - (dbus-call-method - (or bus :system) dbus-service-dbus - dbus-path-dbus dbus-interface-dbus "ListActivatableNames"))) + (let (dbus-debug) + (dbus-ignore-errors + (dbus-call-method + (or bus :system) dbus-service-dbus + dbus-path-dbus dbus-interface-dbus "ListActivatableNames")))) (defun dbus-list-names (bus) "Return the service names registered at D-Bus BUS. @@ -1211,9 +1216,10 @@ The result is a list of strings, which is nil when there are no registered service names at all. Well known names are strings like \"org.freedesktop.DBus\". Names starting with \":\" are unique names for services." - (dbus-ignore-errors - (dbus-call-method - bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus "ListNames"))) + (let (dbus-debug) + (dbus-ignore-errors + (dbus-call-method + bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus "ListNames")))) (defun dbus-list-known-names (bus) "Retrieve all services which correspond to a known name in BUS. @@ -1226,18 +1232,20 @@ A service has a known name if it doesn't start with \":\"." "Return the unique names registered at D-Bus BUS and queued for SERVICE. The result is a list of strings, or nil when there are no queued name owner service names at all." - (dbus-ignore-errors - (dbus-call-method - bus dbus-service-dbus dbus-path-dbus - dbus-interface-dbus "ListQueuedOwners" service))) + (let (dbus-debug) + (dbus-ignore-errors + (dbus-call-method + bus dbus-service-dbus dbus-path-dbus + dbus-interface-dbus "ListQueuedOwners" service)))) (defun dbus-get-name-owner (bus service) "Return the name owner of SERVICE registered at D-Bus BUS. The result is either a string, or nil if there is no name owner." - (dbus-ignore-errors - (dbus-call-method - bus dbus-service-dbus dbus-path-dbus - dbus-interface-dbus "GetNameOwner" service))) + (let (dbus-debug) + (dbus-ignore-errors + (dbus-call-method + bus dbus-service-dbus dbus-path-dbus + dbus-interface-dbus "GetNameOwner" service)))) (defun dbus-ping (bus service &optional timeout) "Check whether SERVICE is registered for D-Bus BUS. @@ -1307,10 +1315,11 @@ and PATH must be a valid object path. The last two parameters are strings. The result, the introspection data, is a string in XML format." ;; We don't want to raise errors. - (dbus-ignore-errors - (dbus-call-method - bus service path dbus-interface-introspectable "Introspect" - :timeout 1000))) + (let (dbus-debug) + (dbus-ignore-errors + (dbus-call-method + bus service path dbus-interface-introspectable "Introspect" + :timeout 1000)))) (defalias 'dbus--parse-xml-buffer (if (libxml-available-p) @@ -1512,12 +1521,11 @@ If NAME is a `signal' or a `property', DIRECTION is ignored." "Return the value of PROPERTY of INTERFACE. It will be checked at BUS, SERVICE, PATH. The result can be any valid D-Bus value, or nil if there is no PROPERTY, or PROPERTY cannot be read." - (dbus-ignore-errors - ;; "Get" returns a variant, so we must use the `car'. - (car - (dbus-call-method - bus service path dbus-interface-properties - "Get" :timeout 500 interface property)))) + ;; "Get" returns a variant, so we must use the `car'. + (car + (dbus-call-method + bus service path dbus-interface-properties + "Get" :timeout 500 interface property))) (defun dbus-set-property (bus service path interface property &rest args) "Set value of PROPERTY of INTERFACE to VALUE. @@ -1527,26 +1535,30 @@ property's access type is not `:write', return VALUE. Otherwise, return nil. \(dbus-set-property BUS SERVICE PATH INTERFACE PROPERTY [TYPE] VALUE)" - (dbus-ignore-errors - ;; "Set" requires a variant. - (dbus-call-method - bus service path dbus-interface-properties - "Set" :timeout 500 interface property (cons :variant args)) - ;; Return VALUE. - (or (dbus-get-property bus service path interface property) - (if (keywordp (car args)) (cadr args) (car args))))) + ;; "Set" requires a variant. + (dbus-call-method + bus service path dbus-interface-properties + "Set" :timeout 500 interface property (cons :variant args)) + ;; Return VALUE. + (condition-case err + (dbus-get-property bus service path interface property) + (dbus-error + (if (string-equal dbus-error-access-denied (cadr err)) + (car args) + (signal (car err) (cdr err)))))) (defun dbus-get-all-properties (bus service path interface) "Return all properties of INTERFACE at BUS, SERVICE, PATH. The result is a list of entries. Every entry is a cons of the name of the property, and its value. If there are no properties, nil is returned." - (dbus-ignore-errors - ;; "GetAll" returns "a{sv}". - (mapcar (lambda (dict) - (cons (car dict) (caadr dict))) - (dbus-call-method bus service path dbus-interface-properties - "GetAll" :timeout 500 interface)))) + (let (dbus-debug) + (dbus-ignore-errors + ;; "GetAll" returns "a{sv}". + (mapcar (lambda (dict) + (cons (car dict) (caadr dict))) + (dbus-call-method bus service path dbus-interface-properties + "GetAll" :timeout 500 interface))))) (defun dbus-get-this-registered-property (bus _service path interface property) "Return PROPERTY entry of `dbus-registered-objects-table'. @@ -1631,6 +1643,7 @@ clients from discovering the still incomplete interface. (setq value (list type value))) (setq value (if (member (car value) dbus-compound-types) (list :variant value) (cons :variant value))) + (dbus-check-arguments bus service value) ;; Add handlers for the three property-related methods. (dbus-register-method @@ -1647,19 +1660,6 @@ clients from discovering the still incomplete interface. (unless (or dont-register-service (member service (dbus-list-names bus))) (dbus-register-service bus service)) - ;; Send the PropertiesChanged signal. - (when emits-signal - (dbus-send-signal - bus service path dbus-interface-properties "PropertiesChanged" - ;; changed_properties. - (if (eq access :write) - '(:array: :signature "{sv}") - `(:array (:dict-entry ,property ,value))) - ;; invalidated_properties. - (if (eq access :write) - `(:array ,property) - '(:array)))) - ;; Create a hash table entry. We use nil for the unique name, ;; because the property might be accessed from anybody. (let ((key (list :property bus interface property)) @@ -1670,6 +1670,14 @@ clients from discovering the still incomplete interface. bus service path interface property)))) (puthash key val dbus-registered-objects-table) + ;; Set or Get the property, in order to validate the property's + ;; value and to send the PropertiesChanged signal. + (when (member service (dbus-list-names bus)) + (if (eq access :read) + (dbus-get-property bus service path interface property) + (apply + #'dbus-set-property bus service path interface property (cdr value)))) + ;; Return the object. (list key (list service path))))) @@ -1704,7 +1712,7 @@ It will be registered for all objects created by `dbus-register-property'." ;; "Set" needs the third typed argument from `last-input-event'. ((string-equal method "Set") - (let* ((value (nth 11 last-input-event)) + (let* ((value (dbus-flatten-types (nth 11 last-input-event))) (entry (dbus-get-this-registered-property bus service path interface property)) (object (car (last (car entry))))) @@ -1721,8 +1729,7 @@ It will be registered for all objects created by `dbus-register-property'." (cons (append (butlast (car entry)) ;; Reuse ACCESS and EMITS-SIGNAL. - (list (append (butlast object) - (list (dbus-flatten-types value))))) + (list (append (butlast object) (list value)))) (dbus-get-other-registered-properties bus service path interface property)) dbus-registered-objects-table) @@ -1733,7 +1740,7 @@ It will be registered for all objects created by `dbus-register-property'." ;; changed_properties. (if (eq :write (car object)) '(:array: :signature "{sv}") - `(:array (:dict-entry ,property (:variant ,value)))) + `(:array (:dict-entry ,property ,value))) ;; invalidated_properties. (if (eq :write (car object)) `(:array ,property) @@ -1804,10 +1811,11 @@ and \"org.freedesktop.DBus.Properties.GetAll\", which is slow." (let ((result ;; Direct call. Fails, if the target does not support the ;; object manager interface. - (dbus-ignore-errors - (dbus-call-method - bus service path dbus-interface-objectmanager - "GetManagedObjects" :timeout 1000)))) + (let (dbus-debug) + (dbus-ignore-errors + (dbus-call-method + bus service path dbus-interface-objectmanager + "GetManagedObjects" :timeout 1000))))) (if result ;; Massage the returned structure. diff --git a/src/dbusbind.c b/src/dbusbind.c index 46e2e22aa0..eb883e5dc8 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -1269,6 +1269,10 @@ The following usages are expected: (dbus-message-internal dbus-message-type-error BUS SERVICE SERIAL ERROR-NAME &rest ARGS) +`dbus-check-arguments': (does not send a message) + (dbus-message-internal + dbus-message-type-invalid BUS SERVICE &rest ARGS) + usage: (dbus-message-internal &rest REST) */) (ptrdiff_t nargs, Lisp_Object *args) { @@ -1286,7 +1290,7 @@ usage: (dbus-message-internal &rest REST) */) dbus_uint32_t serial = 0; unsigned int ui_serial; int timeout = -1; - ptrdiff_t count; + ptrdiff_t count, count0; char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH]; /* Initialize parameters. */ @@ -1296,7 +1300,7 @@ usage: (dbus-message-internal &rest REST) */) handler = Qnil; CHECK_FIXNAT (message_type); - if (! (DBUS_MESSAGE_TYPE_INVALID < XFIXNAT (message_type) + if (! (DBUS_MESSAGE_TYPE_INVALID <= XFIXNAT (message_type) && XFIXNAT (message_type) < DBUS_NUM_MESSAGE_TYPES)) XD_SIGNAL2 (build_string ("Invalid message type"), message_type); mtype = XFIXNAT (message_type); @@ -1311,13 +1315,16 @@ usage: (dbus-message-internal &rest REST) */) handler = args[6]; count = (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL) ? 7 : 6; } - else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */ + else if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN) + || (mtype == DBUS_MESSAGE_TYPE_ERROR)) { serial = xd_extract_unsigned (args[3], TYPE_MAXIMUM (dbus_uint32_t)); if (mtype == DBUS_MESSAGE_TYPE_ERROR) error_name = args[4]; count = (mtype == DBUS_MESSAGE_TYPE_ERROR) ? 5 : 4; } + else /* DBUS_MESSAGE_TYPE_INVALID */ + count = 3; /* Check parameters. */ XD_DBUS_VALIDATE_BUS_ADDRESS (bus); @@ -1367,7 +1374,7 @@ usage: (dbus-message-internal &rest REST) */) XD_OBJECT_TO_STRING (service), ui_serial); break; - default: /* DBUS_MESSAGE_TYPE_ERROR */ + case DBUS_MESSAGE_TYPE_ERROR: ui_serial = serial; XD_DEBUG_MESSAGE ("%s %s %s %u %s", XD_MESSAGE_TYPE_TO_STRING (mtype), @@ -1375,17 +1382,25 @@ usage: (dbus-message-internal &rest REST) */) XD_OBJECT_TO_STRING (service), ui_serial, XD_OBJECT_TO_STRING (error_name)); + break; + default: /* DBUS_MESSAGE_TYPE_INVALID */ + XD_DEBUG_MESSAGE ("%s %s %s", + XD_MESSAGE_TYPE_TO_STRING (mtype), + XD_OBJECT_TO_STRING (bus), + XD_OBJECT_TO_STRING (service)); } /* Retrieve bus address. */ connection = xd_get_connection_address (bus); - /* Create the D-Bus message. */ - dmessage = dbus_message_new (mtype); + /* Create the D-Bus message. Since DBUS_MESSAGE_TYPE_INVALID is not + a valid message type, we mockup it with DBUS_MESSAGE_TYPE_SIGNAL. */ + dmessage = dbus_message_new + ((mtype == DBUS_MESSAGE_TYPE_INVALID) ? DBUS_MESSAGE_TYPE_SIGNAL : mtype); if (dmessage == NULL) XD_SIGNAL1 (build_string ("Unable to create a new message")); - if (STRINGP (service)) + if ((STRINGP (service)) && (mtype != DBUS_MESSAGE_TYPE_INVALID)) { if (mtype != DBUS_MESSAGE_TYPE_SIGNAL) /* Set destination. */ @@ -1427,7 +1442,8 @@ usage: (dbus-message-internal &rest REST) */) XD_SIGNAL1 (build_string ("Unable to set the message parameter")); } - else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */ + else if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN) + || (mtype == DBUS_MESSAGE_TYPE_ERROR)) { if (!dbus_message_set_reply_serial (dmessage, serial)) XD_SIGNAL1 (build_string ("Unable to create a return message")); @@ -1449,6 +1465,7 @@ usage: (dbus-message-internal &rest REST) */) dbus_message_iter_init_append (dmessage, &iter); /* Append parameters to the message. */ + count0 = count - 1; for (; count < nargs; ++count) { dtype = XD_OBJECT_TO_DBUS_TYPE (args[count]); @@ -1456,15 +1473,17 @@ usage: (dbus-message-internal &rest REST) */) { XD_DEBUG_VALID_LISP_OBJECT_P (args[count]); XD_DEBUG_VALID_LISP_OBJECT_P (args[count+1]); - XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", count - 4, + XD_DEBUG_MESSAGE ("Parameter%"pD"d: %s Parameter%"pD"d: %s", + count - count0, XD_OBJECT_TO_STRING (args[count]), + count + 1 - count0, XD_OBJECT_TO_STRING (args[count+1])); ++count; } else { XD_DEBUG_VALID_LISP_OBJECT_P (args[count]); - XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", count - 4, + XD_DEBUG_MESSAGE ("Parameter%"pD"d: %s", count - count0, XD_OBJECT_TO_STRING (args[count])); } @@ -1475,7 +1494,10 @@ usage: (dbus-message-internal &rest REST) */) xd_append_arg (dtype, args[count], &iter); } - if (!NILP (handler)) + if (mtype == DBUS_MESSAGE_TYPE_INVALID) + result = Qt; + + else if (!NILP (handler)) { /* Send the message. The message is just added to the outgoing message queue. */ @@ -1500,7 +1522,8 @@ usage: (dbus-message-internal &rest REST) */) result = Qnil; } - XD_DEBUG_MESSAGE ("Message sent: %s", XD_OBJECT_TO_STRING (result)); + if (mtype != DBUS_MESSAGE_TYPE_INVALID) + XD_DEBUG_MESSAGE ("Message sent: %s", XD_OBJECT_TO_STRING (result)); /* Cleanup. */ dbus_message_unref (dmessage); @@ -1548,7 +1571,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) } /* Read message type, message serial, unique name, object path, - interface and member from the message. */ + interface, member and error name from the message. */ mtype = dbus_message_get_type (dmessage); ui_serial = serial = ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN) @@ -1590,7 +1613,8 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) event.arg = Fcons (value, (mtype == DBUS_MESSAGE_TYPE_ERROR) - ? Fcons (list2 (QCstring, build_string (error_name)), args) : args); + ? Fcons (list2 (QCstring, build_string (error_name)), args) + : args); } else /* DBUS_MESSAGE_TYPE_METHOD_CALL, DBUS_MESSAGE_TYPE_SIGNAL. */ diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el index 8affc2ddd4..b12b02771a 100644 --- a/test/lisp/net/dbus-tests.el +++ b/test/lisp/net/dbus-tests.el @@ -25,8 +25,6 @@ (defvar dbus-debug nil) (declare-function dbus-get-unique-name "dbusbind.c" (bus)) -(setq dbus-show-dbus-errors nil) - (defconst dbus--test-enabled-session-bus (and (featurep 'dbusbind) (dbus-ignore-errors (dbus-get-unique-name :session))) @@ -383,19 +381,14 @@ This includes initialization and closing the bus." "foo")) ;; Due to `:read' access type, we don't get a proper reply ;; from `dbus-set-property'. - (should-not - (dbus-set-property - :session dbus--test-service dbus--test-path - dbus--test-interface property1 "foofoo")) - (let ((dbus-show-dbus-errors t)) - (should - (equal - (butlast - (should-error - (dbus-set-property - :session dbus--test-service dbus--test-path - dbus--test-interface property1 "foofoo"))) - `(dbus-error ,dbus-error-property-read-only)))) + (should + (equal + (butlast + (should-error + (dbus-set-property + :session dbus--test-service dbus--test-path + dbus--test-interface property1 "foofoo"))) + `(dbus-error ,dbus-error-property-read-only))) (should (string-equal (dbus-get-property @@ -413,29 +406,29 @@ This includes initialization and closing the bus." (,dbus--test-service ,dbus--test-path)))) ;; Due to `:write' access type, we don't get a proper reply ;; from `dbus-get-property'. - (should-not - (dbus-get-property - :session dbus--test-service dbus--test-path - dbus--test-interface property2)) - (let ((dbus-show-dbus-errors t)) - (should - (equal - (butlast - (should-error - (dbus-get-property - :session dbus--test-service dbus--test-path - dbus--test-interface property2))) - `(dbus-error ,dbus-error-access-denied)))) + (should + (equal + (butlast + (should-error + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface property2))) + `(dbus-error ,dbus-error-access-denied))) (should (string-equal (dbus-set-property :session dbus--test-service dbus--test-path dbus--test-interface property2 "barbar") "barbar")) - (should-not ;; Due to `:write' access type. - (dbus-get-property - :session dbus--test-service dbus--test-path - dbus--test-interface property2)) + ;; Still `:write' access type. + (should + (equal + (butlast + (should-error + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface property2))) + `(dbus-error ,dbus-error-access-denied))) ;; `:readwrite' property, typed value (Bug#43252). (should @@ -465,32 +458,22 @@ This includes initialization and closing the bus." "/baz/baz")) ;; Not registered property. - (should-not - (dbus-get-property - :session dbus--test-service dbus--test-path - dbus--test-interface property4)) - (let ((dbus-show-dbus-errors t)) - (should - (equal - (butlast - (should-error - (dbus-get-property - :session dbus--test-service dbus--test-path - dbus--test-interface property4))) - `(dbus-error ,dbus-error-unknown-property)))) - (should-not - (dbus-set-property - :session dbus--test-service dbus--test-path - dbus--test-interface property4 "foobarbaz")) - (let ((dbus-show-dbus-errors t)) - (should - (equal - (butlast - (should-error - (dbus-set-property - :session dbus--test-service dbus--test-path - dbus--test-interface property4 "foobarbaz"))) - `(dbus-error ,dbus-error-unknown-property)))) + (should + (equal + (butlast + (should-error + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface property4))) + `(dbus-error ,dbus-error-unknown-property))) + (should + (equal + (butlast + (should-error + (dbus-set-property + :session dbus--test-service dbus--test-path + dbus--test-interface property4 "foobarbaz"))) + `(dbus-error ,dbus-error-unknown-property))) ;; `dbus-get-all-properties'. We cannot retrieve a value for ;; the property with `:write' access type. @@ -516,19 +499,14 @@ This includes initialization and closing the bus." ;; Unregister property. (should (dbus-unregister-object registered)) (should-not (dbus-unregister-object registered)) - (should-not - (dbus-get-property - :session dbus--test-service dbus--test-path - dbus--test-interface property1)) - (let ((dbus-show-dbus-errors t)) - (should - (equal - (butlast - (should-error - (dbus-get-property - :session dbus--test-service dbus--test-path - dbus--test-interface property1))) - `(dbus-error ,dbus-error-unknown-property))))) + (should + (equal + (butlast + (should-error + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface property1))) + `(dbus-error ,dbus-error-unknown-property)))) ;; Cleanup. (dbus-unregister-service :session dbus--test-service))) @@ -745,7 +723,7 @@ This includes initialization and closing the bus." (read-event nil nil 0.1))) (should (equal - dbus--test-signal-received `(((,property ((((1) (2) (3)))))) ()))) + dbus--test-signal-received `(((,property ((1 2 3)))) ()))) (should (equal commit 02a31c9632693b882e46b6dbdd2653297bbfdead (refs/remotes/origin/emacs-27) Author: Eli Zaretskii Date: Sun Sep 20 17:33:55 2020 +0300 Minor improvement in the ELisp manual's Introduction * doc/lispref/intro.texi (Printing Notation): Clarify what "execute code" means in this context. (Bug#43463) diff --git a/doc/lispref/intro.texi b/doc/lispref/intro.texi index 8e4fbc7c31..0dc7c804e7 100644 --- a/doc/lispref/intro.texi +++ b/doc/lispref/intro.texi @@ -249,7 +249,8 @@ indicated with @samp{@equiv{}}. Many of the examples in this manual print text when they are evaluated. If you execute example code in a Lisp Interaction buffer -(such as the buffer @file{*scratch*}), the printed text is inserted into +(such as the buffer @file{*scratch*}) by typing @kbd{C-j} after the +closing parenthesis of the example, the printed text is inserted into the buffer. If you execute the example by other means (such as by evaluating the function @code{eval-region}), the printed text is displayed in the echo area. commit 209dfa11a4218311984a9e7a695fab75364f5623 Author: Eli Zaretskii Date: Sun Sep 20 17:16:38 2020 +0300 Improve documentation of a recently-added feature * lisp/isearch.el (search-highlight-submatches): Improve the doc string. * doc/emacs/search.texi (Search Customizations): Improve the documentation of 'search-highlight-submatches'. * etc/NEWS: Minor change of the entry for 'search-highlight-submatches'. diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index 9716d87504..508debd13c 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -1978,14 +1978,18 @@ using the @code{isearch} face. This highlighting can be disabled by setting the variable @code{search-highlight} to @code{nil}. @vindex search-highlight-submatches - When searching for regular expressions (with @kbd{C-u C-s}, for + When searching for regular expressions (with @kbd{C-M-s}, for instance), subexpressions receive special highlighting depending on -the @code{search-highlight-submatches} variable. If this variable is -zero, no special highlighting is done, but if this is larger than -zero, subexpressions will be matched with -@code{isearch-group-}@samp{X} faces. For instance, when searching for +the @code{search-highlight-submatches} variable. If this variable's +value is zero, no special highlighting is done, but if the value is a +positive integer @var{n}, the strings matching the first @var{n} +@samp{\( @dots{} \)} constructs (a.k.a.@: ``subexpressions'') in the +regular expression will be highlighted with distinct faces, named +@code{isearch-group-@var{n}}. For instance, when searching for @samp{foo-\([0-9]+\)}, the part matched by @samp{[0-9]+} will be -highlighted with the @code{isearch-group-1} face. +highlighted with the @code{isearch-group-1} face if +@code{search-highlight-submatches} is greater or equal to 1. The +default value of @code{search-highlight-submatches} is 5. @cindex lazy highlighting customizations @vindex isearch-lazy-highlight diff --git a/etc/NEWS b/etc/NEWS index 2eff558243..14d52008ac 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1036,9 +1036,10 @@ window after starting). This variable defaults to nil. +++ *** Interactive regular expression search now uses faces for sub-groups. -'C-u C-s foo-\([0-9]+\)' will now use the 'isearch-group-1' face on the -part of the regexp that matches the sub-expression "[0-9]+". This is -controlled by the 'search-highlight-submatches' variable. +E.g., 'C-M-s foo-\([0-9]+\)' will now use the 'isearch-group-1' face +on the part of the regexp that matches the sub-expression "[0-9]+". +This is controlled by the 'search-highlight-submatches' variable, +whose default value is 5. --- *** New user option 'reveal-auto-hide'. diff --git a/lisp/isearch.el b/lisp/isearch.el index cdd1588cd1..0c2cc7686a 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -270,15 +270,15 @@ are `word-search-regexp' \(`\\[isearch-toggle-word]'), `isearch-symbol-regexp' :type 'boolean) (defcustom search-highlight-submatches 5 - "Highlight regexp subexpressions of the current regexp match. -An integer means highlight regexp subexpressions up to the -specified maximal number. + "Whether to highlight regexp subexpressions of the current regexp match. +A positive integer N means highlight regexp subexpressions 1 to N. -When 0, do not highlight regexp subexpressions. +When 0, do not highlight regexp subexpressions. A negative value is +treated as zero. -The faces used to do the highlights are named `isearch-group-1' -and so on, and if you increase this variable from the default, -you have to add more of these faces." +The faces used to do the highlights are named `isearch-group-1', +`isearch-group-2', and so on, and if you increase this variable from +the default, you have to add more of these faces." :type 'integer :version "28.1") commit 09e109851b94d826424a073b56700a46bdbf4b5f Author: Juri Linkov Date: Sun Sep 20 15:46:19 2020 +0200 Highlight regexp sub-expressions * doc/emacs/search.texi (Search Customizations): Document it. * lisp/isearch.el (search-highlight-submatches): New variable. (isearch-group-1, isearch-group-2, isearch-group-3) (isearch-group-4, isearch-group-5): New faces. (isearch-highlight): Use them. (isearch-dehighlight): Ditto (bug#6227). diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index 2e094f3ad9..9716d87504 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -1977,6 +1977,16 @@ performs case folding and lax-whitespace matching. using the @code{isearch} face. This highlighting can be disabled by setting the variable @code{search-highlight} to @code{nil}. +@vindex search-highlight-submatches + When searching for regular expressions (with @kbd{C-u C-s}, for +instance), subexpressions receive special highlighting depending on +the @code{search-highlight-submatches} variable. If this variable is +zero, no special highlighting is done, but if this is larger than +zero, subexpressions will be matched with +@code{isearch-group-}@samp{X} faces. For instance, when searching for +@samp{foo-\([0-9]+\)}, the part matched by @samp{[0-9]+} will be +highlighted with the @code{isearch-group-1} face. + @cindex lazy highlighting customizations @vindex isearch-lazy-highlight @cindex @code{lazy-highlight} face diff --git a/etc/NEWS b/etc/NEWS index 7c6367257b..2eff558243 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1034,6 +1034,12 @@ window after starting). This variable defaults to nil. ** Miscellaneous ++++ +*** Interactive regular expression search now uses faces for sub-groups. +'C-u C-s foo-\([0-9]+\)' will now use the 'isearch-group-1' face on the +part of the regexp that matches the sub-expression "[0-9]+". This is +controlled by the 'search-highlight-submatches' variable. + --- *** New user option 'reveal-auto-hide'. If non-nil (the default), revealed text is automatically hidden when diff --git a/lisp/isearch.el b/lisp/isearch.el index 7fb1d8a3ca..cdd1588cd1 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -269,6 +269,19 @@ are `word-search-regexp' \(`\\[isearch-toggle-word]'), `isearch-symbol-regexp' "Non-nil means incremental search highlights the current match." :type 'boolean) +(defcustom search-highlight-submatches 5 + "Highlight regexp subexpressions of the current regexp match. +An integer means highlight regexp subexpressions up to the +specified maximal number. + +When 0, do not highlight regexp subexpressions. + +The faces used to do the highlights are named `isearch-group-1' +and so on, and if you increase this variable from the default, +you have to add more of these faces." + :type 'integer + :version "28.1") + (defface isearch '((((class color) (min-colors 88) (background light)) ;; The background must not be too dark, for that means @@ -3654,6 +3667,57 @@ since they have special meaning in a regexp." ;; Highlighting (defvar isearch-overlay nil) +(defvar isearch-submatches-overlays nil) + +(defface isearch-group-1 + '((((class color) (background light)) + (:background "#ff00ff" :foreground "lightskyblue1")) + (((class color) (background dark)) + (:background "palevioletred3" :foreground "brown4")) + (t (:inverse-video t))) + "Face for highlighting Isearch sub-group matches (first sub-group)." + :group 'isearch + :version "28.1") + +(defface isearch-group-2 + '((((class color) (background light)) + (:background "#d000d0" :foreground "lightskyblue1")) + (((class color) (background dark)) + (:background "#be698f" :foreground "black")) + (t (:inverse-video t))) + "Face for highlighting Isearch sub-group matches (second sub-group)." + :group 'isearch + :version "28.1") + +(defface isearch-group-3 + '((((class color) (background light)) + (:background "#a000a0" :foreground "lightskyblue1")) + (((class color) (background dark)) + (:background "#a06080" :foreground "brown4")) + (t (:inverse-video t))) + "Face for highlighting Isearch sub-group matches (third sub-group)." + :group 'isearch + :version "28.1") + +(defface isearch-group-4 + '((((class color) (background light)) + (:background "#800080" :foreground "lightskyblue1")) + (((class color) (background dark)) + (:background "#905070" :foreground "brown4")) + (t (:inverse-video t))) + "Face for highlighting Isearch sub-group matches (fourth sub-group)." + :group 'isearch + :version "28.1") + +(defface isearch-group-5 + '((((class color) (background light)) + (:background "#600060" :foreground "lightskyblue1")) + (((class color) (background dark)) + (:background "#804060" :foreground "black")) + (t (:inverse-video t))) + "Face for highlighting Isearch sub-group matches (fifth sub-group)." + :group 'isearch + :version "28.1") (defun isearch-highlight (beg end) (if search-highlight @@ -3664,11 +3728,28 @@ since they have special meaning in a regexp." (setq isearch-overlay (make-overlay beg end)) ;; 1001 is higher than lazy's 1000 and ediff's 100+ (overlay-put isearch-overlay 'priority 1001) - (overlay-put isearch-overlay 'face isearch-face)))) + (overlay-put isearch-overlay 'face isearch-face))) + (when (and (integerp search-highlight-submatches) + (> search-highlight-submatches 0) + isearch-regexp) + (mapc 'delete-overlay isearch-submatches-overlays) + (setq isearch-submatches-overlays nil) + (let ((i 0) ov) + (while (<= i search-highlight-submatches) + (when (match-beginning i) + (setq ov (make-overlay (match-beginning i) (match-end i))) + (overlay-put ov 'face (intern-soft (format "isearch-group-%d" i))) + (overlay-put ov 'priority 1002) + (push ov isearch-submatches-overlays)) + (setq i (1+ i)))))) (defun isearch-dehighlight () (when isearch-overlay - (delete-overlay isearch-overlay))) + (delete-overlay isearch-overlay)) + (when search-highlight-submatches + (mapc 'delete-overlay isearch-submatches-overlays) + (setq isearch-submatches-overlays nil))) + ;; isearch-lazy-highlight feature ;; by Bob Glickstein commit f8d8d28bc67cc69efd9a5d9d9bf3aba43219e0e3 Author: Kévin Le Gouguec Date: Sun Sep 20 14:16:19 2020 +0200 Tweak dired warning about "wildcard" characters * lisp/dired-aux.el (dired-isolated-string-re): Use explicitly numbered groups. (dired--star-or-qmark-p): Add START parameter. Make sure to return the first isolated match. (dired--need-confirm-positions, dired--mark-positions) (dired--highlight-no-subst-chars, dired--no-subst-explain) (dired--no-subst-ask, dired--no-subst-confirm): New functions. (dired-do-shell-command): Use them (bug#28969, bug#35564). * test/lisp/dired-aux-tests.el (dired-test-bug27496): Adapt to new prompt. (dired-test--check-highlighting): New test helper. (dired-test-highlight-metachar): New tests. diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index cf2926ad37..df25a6418f 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -60,24 +60,132 @@ Isolated means that STRING is surrounded by spaces or at the beginning/end of a string followed/prefixed with an space. The regexp capture the preceding blank, STRING and the following blank as the groups 1, 2 and 3 respectively." - (format "\\(\\`\\|[ \t]\\)\\(%s\\)\\([ \t]\\|\\'\\)" string)) + (format "\\(?1:\\`\\|[ \t]\\)\\(?2:%s\\)\\(?3:[ \t]\\|\\'\\)" string)) -(defun dired--star-or-qmark-p (string match &optional keep) +(defun dired--star-or-qmark-p (string match &optional keep start) "Return non-nil if STRING contains isolated MATCH or `\\=`?\\=`'. MATCH should be the strings \"?\", `\\=`?\\=`', \"*\" or nil. The latter means STRING contains either \"?\" or `\\=`?\\=`' or \"*\". If optional arg KEEP is non-nil, then preserve the match data. Otherwise, this function changes it and saves MATCH as the second match group. +START is the position to start matching from. Isolated means that MATCH is surrounded by spaces or at the beginning/end of STRING followed/prefixed with an space. A match to `\\=`?\\=`', isolated or not, is also valid." - (let ((regexps (list (dired-isolated-string-re (if match (regexp-quote match) "[*?]"))))) + (let ((regexp (dired-isolated-string-re (if match (regexp-quote match) "[*?]")))) (when (or (null match) (equal match "?")) - (setq regexps (append (list "\\(\\)\\(`\\?`\\)\\(\\)") regexps))) - (cl-some (lambda (x) - (funcall (if keep #'string-match-p #'string-match) x string)) - regexps))) + (cl-callf concat regexp "\\|\\(?1:\\)\\(?2:`\\?`\\)\\(?3:\\)")) + (funcall (if keep #'string-match-p #'string-match) regexp string start))) + +(defun dired--need-confirm-positions (command string) + "Search for non-isolated matches of STRING in COMMAND. +Return a list of positions that match STRING, but would not be +considered \"isolated\" by `dired--star-or-qmark-p'." + (cl-assert (= (length string) 1)) + (let ((start 0) + (isolated-char-positions nil) + (confirm-positions nil) + (regexp (regexp-quote string))) + ;; Collect all ? and * surrounded by spaces and `?`. + (while (dired--star-or-qmark-p command string nil start) + (push (cons (match-beginning 2) (match-end 2)) + isolated-char-positions) + (setq start (match-end 2))) + ;; Now collect any remaining ? and *. + (setq start 0) + (while (string-match regexp command start) + (unless (cl-member (match-beginning 0) isolated-char-positions + :test (lambda (pos match) + (<= (car match) pos (cdr match)))) + (push (match-beginning 0) confirm-positions)) + (setq start (match-end 0))) + confirm-positions)) + +(defun dired--mark-positions (positions) + (let ((markers (make-string + (1+ (apply #'max positions)) + ?\s))) + (dolist (pos positions) + (setf (aref markers pos) ?^)) + markers)) + +(defun dired--highlight-no-subst-chars (positions command mark) + (cl-callf substring-no-properties command) + (dolist (pos positions) + (add-face-text-property pos (1+ pos) 'warning nil command)) + (if mark + (concat command "\n" (dired--mark-positions positions)) + command)) + +(defun dired--no-subst-explain (buf char-positions command mark-positions) + (with-current-buffer buf + (erase-buffer) + (insert + (format-message "\ +If your command contains occurrences of `*' surrounded by +whitespace, `dired-do-shell-command' substitutes them for the +entire file list to process. Otherwise, if your command contains +occurrences of `?' surrounded by whitespace or `%s', Dired will +run the command once for each file, substituting `?' for each +file name. + +Your command contains occurrences of `%s' that will not be +substituted, and will be passed through normally to the shell. + +%s + +(Press ^ to %s markers below these occurrences.) +" + "`" + (string (aref command (car char-positions))) + (dired--highlight-no-subst-chars char-positions command mark-positions) + (if mark-positions "remove" "add"))))) + +(defun dired--no-subst-ask (char nb-occur details) + (let ((hilit-char (propertize (string char) 'face 'warning)) + (choices `(?y ?n ?? ,@(when details '(?^))))) + (read-char-from-minibuffer + (format-message + (ngettext + "%d occurrence of `%s' will not be substituted. Proceed? (%s) " + "%d occurrences of `%s' will not be substituted. Proceed? (%s) " + nb-occur) + nb-occur hilit-char (mapconcat #'string choices ", ")) + choices))) + +(defun dired--no-subst-confirm (char-positions command) + (let ((help-buf (get-buffer-create "*Dired help*")) + (char (aref command (car char-positions))) + (nb-occur (length char-positions)) + (done nil) + (details nil) + (markers nil) + proceed) + (unwind-protect + (save-window-excursion + (while (not done) + (cl-case (dired--no-subst-ask char nb-occur details) + (?y + (setq done t + proceed t)) + (?n + (setq done t + proceed nil)) + (?? + (if details + (progn + (quit-window nil details) + (setq details nil)) + (dired--no-subst-explain + help-buf char-positions command markers) + (setq details (display-buffer help-buf)))) + (?^ + (setq markers (not markers)) + (dired--no-subst-explain + help-buf char-positions command markers))))) + (kill-buffer help-buf)) + proceed)) ;;;###autoload (defun dired-diff (file &optional switches) @@ -772,28 +880,19 @@ prompted for the shell command to use interactively." (dired-read-shell-command "! on %s: " current-prefix-arg files) current-prefix-arg files))) - (cl-flet ((need-confirm-p - (cmd str) - (let ((res cmd) - (regexp (regexp-quote str))) - ;; Drop all ? and * surrounded by spaces and `?`. - (while (and (string-match regexp res) - (dired--star-or-qmark-p res str)) - (setq res (replace-match "" t t res 2))) - (string-match regexp res)))) (let* ((on-each (not (dired--star-or-qmark-p command "*" 'keep))) (no-subst (not (dired--star-or-qmark-p command "?" 'keep))) + (confirmations nil) ;; Get confirmation for wildcards that may have been meant ;; to control substitution of a file name or the file name list. - (ok (cond ((not (or on-each no-subst)) - (error "You can not combine `*' and `?' substitution marks")) - ((need-confirm-p command "*") - (y-or-n-p (format-message - "Confirm--do you mean to use `*' as a wildcard? "))) - ((need-confirm-p command "?") - (y-or-n-p (format-message - "Confirm--do you mean to use `?' as a wildcard? "))) - (t)))) + (ok (cond + ((not (or on-each no-subst)) + (error "You can not combine `*' and `?' substitution marks")) + ((setq confirmations (dired--need-confirm-positions command "*")) + (dired--no-subst-confirm confirmations command)) + ((setq confirmations (dired--need-confirm-positions command "?")) + (dired--no-subst-confirm confirmations command)) + (t)))) (cond ((not ok) (message "Command canceled")) (t (if on-each @@ -804,7 +903,7 @@ prompted for the shell command to use interactively." nil file-list) ;; execute the shell command (dired-run-shell-command - (dired-shell-stuff-it command file-list nil arg)))))))) + (dired-shell-stuff-it command file-list nil arg))))))) ;; Might use {,} for bash or csh: (defvar dired-mark-prefix "" diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index 1fe155718d..54ec5d673c 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -28,7 +28,7 @@ (let* ((foo (make-temp-file "foo")) (files (list foo))) (unwind-protect - (cl-letf (((symbol-function 'y-or-n-p) 'error)) + (cl-letf (((symbol-function 'read-char-from-minibuffer) 'error)) (dired temporary-file-directory) (dired-goto-file foo) ;; `dired-do-shell-command' returns nil on success. @@ -114,6 +114,49 @@ (mapc #'delete-file `(,file1 ,file2)) (kill-buffer buf))))) +(defun dired-test--check-highlighting (command positions) + (let ((start 1)) + (dolist (pos positions) + (should-not (text-property-not-all start (1- pos) 'face nil command)) + (should (equal 'warning (get-text-property pos 'face command))) + (setq start (1+ pos))) + (should-not (text-property-not-all + start (length command) 'face nil command)))) + +(ert-deftest dired-test-highlight-metachar () + "Check that non-isolated meta-characters are highlighted." + (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`") + (markers " ^ ^") + (result (dired--highlight-no-subst-chars + (dired--need-confirm-positions command "?") + command + t)) + (lines (split-string result "\n"))) + (should (= (length lines) 2)) + (should (string-match (regexp-quote command) (nth 0 lines))) + (should (string-match (regexp-quote markers) (nth 1 lines))) + (dired-test--check-highlighting (nth 0 lines) '(15 29))) + ;; Note that `?` is considered isolated, but `*` is not. + (let* ((command "sed -e 's/o*/a/' -e 's/o`*` /a/'") + (markers " ^ ^") + (result (dired--highlight-no-subst-chars + (dired--need-confirm-positions command "*") + command + t)) + (lines (split-string result "\n"))) + (should (= (length lines) 2)) + (should (string-match (regexp-quote command) (nth 0 lines))) + (should (string-match (regexp-quote markers) (nth 1 lines))) + (dired-test--check-highlighting (nth 0 lines) '(11 25))) + (let* ((command "sed 's/\\?/!/'") + (result (dired--highlight-no-subst-chars + (dired--need-confirm-positions command "?") + command + nil)) + (lines (split-string result "\n"))) + (should (= (length lines) 1)) + (should (string-match (regexp-quote command) (nth 0 lines))) + (dired-test--check-highlighting (nth 0 lines) '(8)))) (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here commit f750def7785a548d4be3aa27071ac47219f7a4e2 Author: Eli Zaretskii Date: Sun Sep 20 14:08:35 2020 +0300 Mention in PROBLEMS the problems with fonts and Uniscribe * etc/PROBLEMS: Mention font-related problems with Uniscribe on MS-Windows. (Bug#39340) diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 12cfbd0de2..32ac715e62 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -918,6 +918,19 @@ index 5504171..431adf8 100644 If you can't modify that file directly, copy it to the directory ~/.m17n.d/ (create it if it doesn't exist), and apply the patch. +** On MS-Windows, some characters display as boxes with hex code. + +Also, some characters could display with wrong fonts. + +This can happen if Emacs was compiled without HarfBuzz support, and/or +if the HarfBuzz DLLs are not available at run time. Emacs will then +fall back to the Uniscribe as its shaping engine; Uniscribe was +deprecated by Microsoft, and sometimes fails to display correctly when +modern fonts are used, such as Noto Emoji or Ebrima. + +The solution is to switch to a configuration that uses HarfBuzz as its +shaping engine, where these problems don't exist. + * Internationalization problems ** M-{ does not work on a Spanish PC keyboard. commit 163ff19cf3cd32bc3c50da56a587976121e3f1d2 Author: Lars Ingebrigtsen Date: Sun Sep 20 13:03:20 2020 +0200 Fix bug out when indenting inserted images in shr * lisp/net/shr.el (shr-fill-line): We may not have a shr-indentation text property here. In that case, default to the dynamically bound value. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 1f53bc4016..dcb64155d4 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -714,7 +714,8 @@ size, and full-buffer size." (forward-char 1)))) (defun shr-fill-line () - (let ((shr-indentation (get-text-property (point) 'shr-indentation)) + (let ((shr-indentation (or (get-text-property (point) 'shr-indentation) + shr-indentation)) (continuation (get-text-property (point) 'shr-continuation-indentation)) start) commit 8da6eb3a7006542ec7ee8e6c0e9bcf94b64c1676 Author: Lars Ingebrigtsen Date: Sun Sep 20 12:57:53 2020 +0200 Remove code checked in to lread.c by mistake * src/lread.c (intern_sym): Remove code under development inadvertently checked in. diff --git a/src/lread.c b/src/lread.c index f465b451a9..8064bf4d0e 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4104,7 +4104,6 @@ intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index) { make_symbol_constant (sym); XSYMBOL (sym)->u.s.redirect = SYMBOL_PLAINVAL; - XSYMBOL (sym)->u.s.declared_special = true; SET_SYMBOL_VAL (XSYMBOL (sym), sym); } commit 321bba0c99c6712921830d0dcf7e681e804c7cd1 Author: dickmao Date: Sun Sep 20 12:43:37 2020 +0200 Terminate `comint-password-function' tests * test/lisp/comint-tests.el (comint-test-no-password-function) (comint-test-password-function-with-value) (comint-test-password-function-with-nil): refactor (comint-tests/test-password-function): actually test `comint-send-invisible' and inhibit inadvertent interactive query (bug#38825). diff --git a/src/lread.c b/src/lread.c index 8064bf4d0e..f465b451a9 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4104,6 +4104,7 @@ intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index) { make_symbol_constant (sym); XSYMBOL (sym)->u.s.redirect = SYMBOL_PLAINVAL; + XSYMBOL (sym)->u.s.declared_special = true; SET_SYMBOL_VAL (XSYMBOL (sym), sym); } diff --git a/test/lisp/comint-tests.el b/test/lisp/comint-tests.el index 132fe875f7..5b59340902 100644 --- a/test/lisp/comint-tests.el +++ b/test/lisp/comint-tests.el @@ -52,73 +52,41 @@ (dolist (str comint-testsuite-password-strings) (should (string-match comint-password-prompt-regexp str)))) -(ert-deftest comint-test-no-password-function () - "Test that `comint-password-function' not being set does not -alter normal password flow." - (cl-letf - (((symbol-function 'read-passwd) - (lambda (_prompt &optional _confirm _default) - "PaSsWoRd123"))) - (let ((cat (executable-find "cat"))) - (when cat +(defun comint-tests/test-password-function (password-function) + "PASSWORD-FUNCTION can return nil or a string." + (when-let ((cat (executable-find "cat"))) + (let ((comint-password-function password-function)) + (cl-letf (((symbol-function 'read-passwd) + (lambda (&rest _args) "non-nil"))) (with-temp-buffer (make-comint-in-buffer "test-comint-password" (current-buffer) cat) (let ((proc (get-buffer-process (current-buffer)))) (set-process-query-on-exit-flag proc nil) - (comint-send-string proc "Password: ") - (comint-send-eof) - (while (accept-process-output proc 0.1 nil t)) - (should (string-equal (buffer-substring-no-properties (point-min) (point-max)) - "Password: PaSsWoRd123\n")) - (when (process-live-p proc) - (kill-process proc)) - (accept-process-output proc 0 1 t))))))) + (set-process-query-on-exit-flag proc nil) + (comint-send-invisible "Password: ") + (accept-process-output proc 0.1) + (should (string-equal + (buffer-substring-no-properties (point-min) (point-max)) + (concat (or (and password-function + (funcall password-function)) + "non-nil") + "\n"))))))))) + +(ert-deftest comint-test-no-password-function () + "Test that `comint-password-function' not being set does not +alter normal password flow." + (comint-tests/test-password-function nil)) (ert-deftest comint-test-password-function-with-value () "Test that `comint-password-function' alters normal password flow. Hook function returns alternative password." - (cl-letf - (((symbol-function 'read-passwd) - (lambda (_prompt &optional _confirm _default) - "PaSsWoRd123"))) - (let ((cat (executable-find "cat")) - (comint-password-function (lambda (_prompt) "MaGiC-PaSsWoRd789"))) - (when cat - (with-temp-buffer - (make-comint-in-buffer "test-comint-password" (current-buffer) cat) - (let ((proc (get-buffer-process (current-buffer)))) - (set-process-query-on-exit-flag proc nil) - (comint-send-string proc "Password: ") - (comint-send-eof) - (while (accept-process-output proc 0.1 nil t)) - (should (string-equal (buffer-substring-no-properties (point-min) (point-max)) - "Password: MaGiC-PaSsWoRd789\n")) - (when (process-live-p proc) - (kill-process proc)) - (accept-process-output proc 0 1 t))))))) + (comint-tests/test-password-function + (lambda (&rest _args) "MaGiC-PaSsWoRd789"))) (ert-deftest comint-test-password-function-with-nil () "Test that `comint-password-function' does not alter the normal password flow if it returns a nil value." - (cl-letf - (((symbol-function 'read-passwd) - (lambda (_prompt &optional _confirm _default) - "PaSsWoRd456"))) - (let ((cat (executable-find "cat")) - (comint-password-function (lambda (_prompt) nil))) - (when cat - (with-temp-buffer - (make-comint-in-buffer "test-comint-password" (current-buffer) cat) - (let ((proc (get-buffer-process (current-buffer)))) - (set-process-query-on-exit-flag proc nil) - (comint-send-string proc "Password: ") - (comint-send-eof) - (while (accept-process-output proc 0.1 nil t)) - (should (string-equal (buffer-substring-no-properties (point-min) (point-max)) - "Password: PaSsWoRd456\n")) - (when (process-live-p proc) - (kill-process proc)) - (accept-process-output proc 0 1 t))))))) + (comint-tests/test-password-function #'ignore)) ;; Local Variables: ;; no-byte-compile: t commit 3ec7005315f359540e2499b77397a67a86362fdb Author: Lars Ingebrigtsen Date: Sun Sep 20 12:26:29 2020 +0200 Tweak a hash table print test diff --git a/test/src/print-tests.el b/test/src/print-tests.el index 51ef16dd85..eb9572dbdf 100644 --- a/test/src/print-tests.el +++ b/test/src/print-tests.el @@ -374,7 +374,7 @@ otherwise, use a different charset." (should (string-match - "data (99 99" + "data (99 99)" (let ((h (make-hash-table))) (dotimes (i 100) (puthash i i h)) commit 988f45a75b745dc1fee6315749ddb48f00b000eb Author: Pip Cet Date: Sun Sep 20 12:24:16 2020 +0200 Fix printing of hash tables with removed elements * src/print.c (print_vectorlike): Keep track of the actual number of elements printed rather than attempting to use hash bucket indices (bug#38892). diff --git a/src/print.c b/src/print.c index bd1769144e..0ecc98f37b 100644 --- a/src/print.c +++ b/src/print.c @@ -1590,27 +1590,34 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, /* Print the data here as a plist. */ ptrdiff_t real_size = HASH_TABLE_SIZE (h); - ptrdiff_t size = real_size; + ptrdiff_t size = h->count; /* Don't print more elements than the specified maximum. */ if (FIXNATP (Vprint_length) && XFIXNAT (Vprint_length) < size) size = XFIXNAT (Vprint_length); printchar ('(', printcharfun); - for (ptrdiff_t i = 0; i < size; i++) + ptrdiff_t j = 0; + for (ptrdiff_t i = 0; i < real_size; i++) { Lisp_Object key = HASH_KEY (h, i); if (!EQ (key, Qunbound)) { - if (i) printchar (' ', printcharfun); + if (j++) printchar (' ', printcharfun); print_object (key, printcharfun, escapeflag); printchar (' ', printcharfun); print_object (HASH_VALUE (h, i), printcharfun, escapeflag); + if (j == size) + break; } } - if (size < real_size) - print_c_string (" ...", printcharfun); + if (j < h->count) + { + if (j) + printchar (' ', printcharfun); + print_c_string ("...", printcharfun); + } print_c_string ("))", printcharfun); } diff --git a/test/src/print-tests.el b/test/src/print-tests.el index 42e5962137..51ef16dd85 100644 --- a/test/src/print-tests.el +++ b/test/src/print-tests.el @@ -355,5 +355,33 @@ otherwise, use a different charset." (setcdr err err) (should-error (error-message-string err) :type 'circular-list))) +(print-tests--deftest print-hash-table-test () + (should + (string-match + "data (2 3)" + (let ((h (make-hash-table))) + (puthash 1 2 h) + (puthash 2 3 h) + (remhash 1 h) + (format "%S" h)))) + + (should + (string-match + "data ()" + (let ((h (make-hash-table))) + (let ((print-length 0)) + (format "%S" h))))) + + (should + (string-match + "data (99 99" + (let ((h (make-hash-table))) + (dotimes (i 100) + (puthash i i h)) + (dotimes (i 99) + (remhash i h)) + (let ((print-length 1)) + (format "%S" h)))))) + (provide 'print-tests) ;;; print-tests.el ends here commit 23c20c39683766525d17da52482dfad85b943f48 Author: Dmitry Gutov Date: Sun Sep 20 12:12:36 2020 +0200 Don't have vc-git-stash-list bug out on the .git directory * lisp/vc/vc-git.el (vc-git-stash-list): Don't bug out when running on the .git directory itself (bug#39285). diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 84aeb0a110..6ff6951dbc 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1707,12 +1707,13 @@ This command shares argument histories with \\[rgrep] and \\[grep]." (vc-resynch-buffer (vc-git-root default-directory) t t)) (defun vc-git-stash-list () - (delete - "" - (split-string - (replace-regexp-in-string - "^stash@" " " (vc-git--run-command-string nil "stash" "list")) - "\n"))) + (when-let ((out (vc-git--run-command-string nil "stash" "list"))) + (delete + "" + (split-string + (replace-regexp-in-string + "^stash@" " " out) + "\n")))) (defun vc-git-stash-get-at-point (point) (save-excursion commit db6bdef2dd6abe2f2d1e8c49f0d86a490a63d81b Author: Michael Albinus Date: Sun Sep 20 11:48:56 2020 +0200 ; * doc/lispref/processes.texi (Synchronous Processes): Fix typo. diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index e088452075..4556f8aeb5 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -605,7 +605,7 @@ is decoded in the same way as for @code{call-process}. @defun process-lines-ignore-status program &rest args This function is just like @code{process-lines}, but does not signal -an error if @var{program} exists with a non-zero exit status. +an error if @var{program} exits with a non-zero exit status. @end defun @node Asynchronous Processes commit 676398dd7df0a2a2cfc105ee4d46e6c817e6cd9d Author: Earl Date: Sun Sep 20 11:36:52 2020 +0200 Add new tab command `C-x t C-r' * doc/emacs/misc.texi (FFAP): Document new commands (bug#43503). * lisp/ffap.el (ffap-read-only-other-tab): New command. * lisp/tab-bar.el (find-file-read-only-other-tab): New command and keystroke. diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index c8b21e701c..4865ee1751 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -3028,6 +3028,11 @@ point (@code{dired-at-point}). @code{find-file-read-only-other-frame}. @item C-x 5 d @var{directory} @key{RET} @code{ffap-dired-other-frame}, analogous to @code{dired-other-frame}. +@kindex C-x t C-f @r{(FFAP)} +@item C-x t C-f @var{filename} @key{return} +@code{ffap-other-tab}, analogous to @code{find-file-other-tab}. +@item C-x t C-r @var{filename} @key{return} +@code{ffap-read-only-other-tab}, analogous to @code{find-file-read-only-other-tab}. @item M-x ffap-next Search buffer for next file name or URL, then find that file or URL. @item S-mouse-3 diff --git a/etc/NEWS b/etc/NEWS index e7e4910ba1..7c6367257b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -239,6 +239,9 @@ of the next command to be displayed in a new frame. It's bound to the command 'other-tab-prefix' that requests the buffer of the next command to be displayed in a new tab. ++++ +*** New command 'C-x t C-r' to open file read-only in other tab. + *** The tab bar is frame-local when 'tab-bar-show' is a number. Show/hide the tab bar independently for each frame, according to the value of 'tab-bar-show'. diff --git a/lisp/ffap.el b/lisp/ffap.el index 3e65c687af..a1d80f545c 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -1926,6 +1926,14 @@ Only intended for interactive use." (ffap--toggle-read-only value) value)) +(defun ffap-read-only-other-tab (filename) + "Like `ffap', but put buffer in another tab and mark as read-only. +Only intended for interactive use." + (interactive (list (ffap-prompter nil " read only other tab"))) + (let ((value (window-buffer (ffap-other-tab filename)))) + (ffap--toggle-read-only value) + value)) + (defun ffap-alternate-file (filename) "Like `ffap' and `find-alternate-file'. Only intended for interactive use." diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index e4b3c8cf19..9c6b9cbc04 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -1566,6 +1566,20 @@ Like \\[find-file-other-frame] (which see), but creates a new tab." value) (switch-to-buffer-other-tab value)))) +(defun find-file-read-only-other-tab (filename &optional wildcards) + "Edit file FILENAME, in another tab, but don't allow changes. +Like \\[find-file-other-frame] (which see), but creates a new tab. + +Like \\[find-file-other-tab], but marks buffer as read-only. +Use \\[read-only-mode] to permit editing." + (interactive + (find-file-read-args "Find file read-only in other tab: " + (confirm-nonexistent-file-or-buffer))) + (find-file--read-only (lambda (filename wildcards) + (window-buffer + (find-file-other-tab filename wildcards))) + filename wildcards)) + (defun other-tab-prefix () "Display the buffer of the next command in a new tab. The next buffer is the buffer displayed by the next command invoked @@ -1595,6 +1609,7 @@ When `switch-to-buffer-obey-display-actions' is non-nil, (define-key tab-prefix-map "b" 'switch-to-buffer-other-tab) (define-key tab-prefix-map "f" 'find-file-other-tab) (define-key tab-prefix-map "\C-f" 'find-file-other-tab) +(define-key tab-prefix-map "\C-r" 'find-file-read-only-other-tab) (define-key tab-prefix-map "t" 'other-tab-prefix) commit a68a0e69da11430401eb4868ee1bd1c88ae869d4 Author: Noam Postavsky Date: Sun Sep 20 10:46:16 2020 +0200 Fix slow python-mode inserts when there's a lot of strings * lisp/progmodes/python.el (python-info-docstring-p): Doing more than two repetitions here doesn't improve indentation (bug#39598). diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index ccbcb08130..d2eb5f268b 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -5129,21 +5129,22 @@ point's current `syntax-ppss'." (>= 2 (let (last-backward-sexp-point) - (while (save-excursion - (python-nav-backward-sexp) - (setq backward-sexp-point (point)) - (and (= indentation (current-indentation)) - ;; Make sure we're always moving point. - ;; If we get stuck in the same position - ;; on consecutive loop iterations, - ;; bail out. - (prog1 (not (eql last-backward-sexp-point - backward-sexp-point)) - (setq last-backward-sexp-point - backward-sexp-point)) - (looking-at-p - (concat "[uU]?[rR]?" - (python-rx string-delimiter))))) + (while (and (<= counter 2) + (save-excursion + (python-nav-backward-sexp) + (setq backward-sexp-point (point)) + (and (= indentation (current-indentation)) + ;; Make sure we're always moving point. + ;; If we get stuck in the same position + ;; on consecutive loop iterations, + ;; bail out. + (prog1 (not (eql last-backward-sexp-point + backward-sexp-point)) + (setq last-backward-sexp-point + backward-sexp-point)) + (looking-at-p + (concat "[uU]?[rR]?" + (python-rx string-delimiter)))))) ;; Previous sexp was a string, restore point. (goto-char backward-sexp-point) (cl-incf counter)) commit 082d8a21b1751d7e5e5ca5cfcd6112da23f928ff Author: Eli Zaretskii Date: Sat Sep 19 22:22:08 2020 +0300 Minor copyedits in 'line-height' documentation * doc/lispref/display.texi (Line Height): Describe the possible values of the 'line-height' property in a more consistent format. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 2ef27c00b8..6f0e8c1ad2 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -2188,21 +2188,24 @@ actual line height can never be less than the default. @kindex line-height @r{(text property)} A newline can have a @code{line-height} text or overlay property that controls the total height of the display line ending in that -newline. +newline. The property value can be one of several forms: - If the property value is @code{t}, the newline character has no +@table @code +@item t +If the property value is @code{t}, the newline character has no effect on the displayed height of the line---the visible contents alone determine the height. The @code{line-spacing} property, described below, is also ignored in this case. This is useful for tiling small images (or image slices) without adding blank areas between the images. - - If the property value is a list of the form @code{(@var{height} -@var{total})}, that adds extra space @emph{below} the display line. -First Emacs uses @var{height} as a height spec to control extra space -@emph{above} the line; then it adds enough space @emph{below} the line -to bring the total line height up to @var{total}. In this case, any -value of @code{line-spacing} property for the newline is ignored. +@item (@var{height} @var{total}) +If the property value is a list of the form shown, that adds extra +space @emph{below} the display line. First Emacs uses @var{height} as +a height spec to control extra space @emph{above} the line; then it +adds enough space @emph{below} the line to bring the total line height +up to @var{total}. In this case, any value of @code{line-spacing} +property for the newline is ignored. +@end table @cindex height spec Any other kind of property value is a height spec, which translates commit 5b23393bcc0293c61eedd21690a4024efb25d955 Author: Eli Zaretskii Date: Sat Sep 19 21:57:20 2020 +0300 ; * src/frame.c (syms_of_frame) : Doc fix. diff --git a/src/frame.c b/src/frame.c index 4dd8bb1804..255606957c 100644 --- a/src/frame.c +++ b/src/frame.c @@ -6128,7 +6128,7 @@ when the mouse is over clickable text. */); Vmouse_highlight = Qt; DEFVAR_LISP ("make-pointer-invisible", Vmake_pointer_invisible, - doc: /* If non-nil, make pointer invisible while typing. + doc: /* If non-nil, make mouse pointer invisible while typing. The pointer becomes visible again when the mouse is moved. */); Vmake_pointer_invisible = Qt; commit c151797da9c6afc7e870b5d0a95022117c8873e2 Author: Gregor Zattler Date: Sat Sep 19 19:25:24 2020 +0200 * doc/misc/eww.texi: Document the `w' key's double function * doc/misc/eww.texi (Basics): Describe what the `w' command does in eww (bug#43517). diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi index e3191cbe48..faccd96f72 100644 --- a/doc/misc/eww.texi +++ b/doc/misc/eww.texi @@ -92,14 +92,20 @@ default one, which is normally called @file{*eww*}. @findex eww-quit @findex eww-reload @findex eww-copy-page-url +@findex shr-maybe-probe-and-copy-url @kindex q @kindex w @kindex g If loading the URL was successful the buffer @file{*eww*} is opened and the web page is rendered in it. You can leave EWW by pressing @kbd{q} or exit the browser by calling @kbd{eww-quit}. To reload the -web page hit @kbd{g} (@code{eww-reload}). Pressing @kbd{w} -(@code{eww-copy-page-url}) will copy the current URL to the kill ring. +web page hit @kbd{g} (@code{eww-reload}). + + Pressing @kbd{w} when point is on a link will call +@code{shr-maybe-probe-and-copy-url}, which copies this link's +@acronym{URL} to the kill ring. If point is not on a link, pressing +@kbd{w} calls @code{eww-copy-page-url}, which will copy the current +page's URL to the kill ring instead. @findex eww-open-in-new-buffer @kindex M-RET commit df04f3e755f3001ebb9cc428faa7fa46059e636b Author: Eli Zaretskii Date: Sat Sep 19 19:54:01 2020 +0300 Fix a rare segfault in syntax.c * src/syntax.c (Fforward_comment): Prevent the loop for COUNT < 0 from going outside the valid range of character/byte positions. (Bug#43499) * doc/lispref/syntax.texi (Syntax Class Table): Mention the "comment-fence" and "string-fence" as alternative names of 2 syntax classes. diff --git a/doc/lispref/syntax.texi b/doc/lispref/syntax.texi index b3c77665ba..b99b5de0b3 100644 --- a/doc/lispref/syntax.texi +++ b/doc/lispref/syntax.texi @@ -256,10 +256,11 @@ look in the standard syntax table to find the syntax of this character. @item Generic comment delimiters: @samp{!} -Characters that start or end a special kind of comment. @emph{Any} -generic comment delimiter matches @emph{any} generic comment -delimiter, but they cannot match a comment starter or comment ender; -generic comment delimiters can only match each other. +(This syntax class is also known as ``comment-fence''.) Characters +that start or end a special kind of comment. @emph{Any} generic +comment delimiter matches @emph{any} generic comment delimiter, but +they cannot match a comment starter or comment ender; generic comment +delimiters can only match each other. This syntax class is primarily meant for use with the @code{syntax-table} text property (@pxref{Syntax Properties}). You @@ -268,10 +269,11 @@ first and last characters of the range @code{syntax-table} properties identifying them as generic comment delimiters. @item Generic string delimiters: @samp{|} -Characters that start or end a string. This class differs from the -string quote class in that @emph{any} generic string delimiter can -match any other generic string delimiter; but they do not match -ordinary string quote characters. +(This syntax class is also known as ``string-fence''.) Characters +that start or end a string. This class differs from the string quote +class in that @emph{any} generic string delimiter can match any other +generic string delimiter; but they do not match ordinary string quote +characters. This syntax class is primarily meant for use with the @code{syntax-table} text property (@pxref{Syntax Properties}). You diff --git a/src/syntax.c b/src/syntax.c index a79ab86336..e8b32f5a44 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -2545,20 +2545,23 @@ between them, return t; otherwise return nil. */) bool fence_found = 0; ptrdiff_t ini = from, ini_byte = from_byte; - while (1) + if (from > stop) { - DEC_BOTH (from, from_byte); - UPDATE_SYNTAX_TABLE_BACKWARD (from); - c = FETCH_CHAR_AS_MULTIBYTE (from_byte); - if (SYNTAX (c) == Scomment_fence - && !char_quoted (from, from_byte)) + while (1) { - fence_found = 1; - break; + DEC_BOTH (from, from_byte); + UPDATE_SYNTAX_TABLE_BACKWARD (from); + c = FETCH_CHAR_AS_MULTIBYTE (from_byte); + if (SYNTAX (c) == Scomment_fence + && !char_quoted (from, from_byte)) + { + fence_found = 1; + break; + } + else if (from == stop) + break; + rarely_quit (++quit_count); } - else if (from == stop) - break; - rarely_quit (++quit_count); } if (fence_found == 0) { commit fd1fe1e1ecb6c68bbdea4bf071166779388174d0 Author: Alan Mackenzie Date: Sat Sep 19 16:50:27 2020 +0000 Add doc to syntax-propertize-function saying it must do a 100% job and cannot be combined with other ways of applying syntax-table text properties. * lisp/emacs-lisp/syntax.el (syntax-propertize-function): Amend doc string. * doc/lispref/syntax.texi (Syntax Properties): Amend the description of the variable. diff --git a/doc/lispref/syntax.texi b/doc/lispref/syntax.texi index 9eb99a0ac9..b3c77665ba 100644 --- a/doc/lispref/syntax.texi +++ b/doc/lispref/syntax.texi @@ -575,6 +575,15 @@ position before @var{end}. However, it should not call @code{syntax-ppss-flush-cache}; so, it is not allowed to call @code{syntax-ppss} on some position and later modify the buffer at an earlier position. + +@strong{Caution:} When this variable is non-@code{nil}, Emacs removes +@code{syntax-table} text properties arbitrarily and relies on +@code{syntax-propertize-function} to reapply them. Thus if this +facility is used at all, the function must apply @strong{all} +@code{syntax-table} text properties used by the major mode. In +particular, Modes derived from a CC Mode mode must not use this +variable, since CC Mode uses other means to apply and remove these +text properties. @end defvar @defvar syntax-propertize-extend-region-functions diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el index 11cc1988b1..f4f077264b 100644 --- a/lisp/emacs-lisp/syntax.el +++ b/lisp/emacs-lisp/syntax.el @@ -65,7 +65,12 @@ cannot be handled just by the buffer's syntax-table. The specified function may call `syntax-ppss' on any position before END, but it should not call `syntax-ppss-flush-cache', which means that it should not call `syntax-ppss' on some -position and later modify the buffer on some earlier position.") +position and later modify the buffer on some earlier position. + +Note: When this variable is a function, it must apply _all_ the +`syntax-table' properties needed in the given text interval. +Using both this function and other means to apply these +properties won't work properly.") (defvar syntax-propertize-chunk-size 500) commit fcd599bbeaac84113379dedbff4e59910e10e171 Author: Eli Zaretskii Date: Sat Sep 19 11:30:57 2020 +0300 Minor copyedits of doc of 'with-silent-modifications' * doc/lispref/text.texi (Changing Properties): * doc/lispref/buffers.texi (Buffer Modification): Improve documentation and indexing of 'with-silent-modifications'. diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi index 33528fc7fe..2860343628 100644 --- a/doc/lispref/buffers.texi +++ b/doc/lispref/buffers.texi @@ -596,8 +596,8 @@ and features that react to buffer modifications, use the Execute @var{body} pretending it does not modify the buffer. This includes checking whether the buffer's file is locked (@pxref{File Locks}), running buffer modification hooks (@pxref{Change Hooks}), -etc. Note that if @var{body} actually modifies the buffer text, its -undo data may become corrupted. +etc. Note that if @var{body} actually modifies the buffer text (as +opposed to its text properties), its undo data may become corrupted. @end defmac @node Modification Time diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 5d83e7bd6c..c4e92bdced 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -3069,7 +3069,7 @@ construct each part with @code{propertize} and then combine them with @code{buffer-substring-no-properties}, which copies text from the buffer but does not copy its properties. -@findex with-silent-modifications +@findex with-silent-modifications, and changes in text properties If you wish to add text properties to a buffer or remove them without marking the buffer as modified, you can wrap the calls above in the @code{with-silent-modifications} macro. @xref{Buffer commit 759399cdb1d74d282e02725f4e6769566b145e1f Author: Eli Zaretskii Date: Fri Sep 18 22:50:36 2020 +0300 Improve documentation of 'max-mini-window-height' * src/xdisp.c (syms_of_xdisp): * doc/lispref/minibuf.texi (Minibuffer Windows): More accurate wording in the documentation of 'max-mini-window-height', to clarify the meaning of an integer value. diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index c1615993f5..ecab882fed 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -2418,9 +2418,10 @@ changes size automatically. In that case the window resizing commands @defopt max-mini-window-height This option provides a maximum height for resizing minibuffer windows -automatically. A floating-point number specifies a fraction of the -frame's height; an integer specifies the maximum number of lines. The -default value is 0.25. +automatically. A floating-point number specifies the maximum height +as a fraction of the frame's height; an integer specifies the maximum +height in units of the frame's canonical character height +(@pxref{Frame Font}). The default value is 0.25. @end defopt Note that the values of the above two variables take effect at display diff --git a/src/xdisp.c b/src/xdisp.c index ad0ab9987d..d191ef5170 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -34830,8 +34830,10 @@ but does not change the fact they are interpreted as raw bytes. */); DEFVAR_LISP ("max-mini-window-height", Vmax_mini_window_height, doc: /* Maximum height for resizing mini-windows (the minibuffer and the echo area). -If a float, it specifies a fraction of the mini-window frame's height. -If an integer, it specifies a number of lines. */); +If a float, it specifies the maximum height in units of the +mini-window frame's height. +If an integer, it specifies the maximum height in units of the +mini-window frame's default font's height. */); Vmax_mini_window_height = make_float (0.25); DEFVAR_LISP ("resize-mini-windows", Vresize_mini_windows, commit 3223302aa2294d0e2a68216e84e3ee2d4ebcbee1 Author: Daniel Martín Date: Fri Sep 18 13:36:47 2020 +0200 Use modern constant names for the NS pasteboard Use the same pasteboard constant names defined in ns_drag_types. (Bug#43470). * src/nsterm.m: Rename NSURLPboardType to NSPasteboardTypeURL, NSStringPboardType to NSPasteboardTypeString, and NSTabularTextPboardType to NSPasteboardTypeTabularText diff --git a/src/nsterm.m b/src/nsterm.m index ac467840a2..3dd915e370 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -8363,7 +8363,7 @@ -(BOOL)performDragOperation: (id ) sender while ( (file = [fenum nextObject]) ) strings = Fcons (build_string ([file UTF8String]), strings); } - else if ([type isEqualToString: NSURLPboardType]) + else if ([type isEqualToString: NSPasteboardTypeURL]) { NSURL *url = [NSURL URLFromPasteboard: pb]; if (url == nil) return NO; @@ -8372,8 +8372,8 @@ -(BOOL)performDragOperation: (id ) sender strings = list1 (build_string ([[url absoluteString] UTF8String])); } - else if ([type isEqualToString: NSStringPboardType] - || [type isEqualToString: NSTabularTextPboardType]) + else if ([type isEqualToString: NSPasteboardTypeString] + || [type isEqualToString: NSPasteboardTypeTabularText]) { NSString *data; commit 985703d3800fb48feec44e3fd7880e9561bcbdc7 Author: Eli Zaretskii Date: Wed Sep 16 19:16:25 2020 +0300 Fix doc string of 'toggle-menu-bar-mode-from-frame' * lisp/menu-bar.el (toggle-menu-bar-mode-from-frame): Improve the wording of the doc string. (Bug#43383) diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index cc12a17c79..37e046ffdd 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -2426,7 +2426,7 @@ created in the future." (put 'menu-bar-mode 'standard-value '(t)) (defun toggle-menu-bar-mode-from-frame (&optional arg) - "Toggle menu bar on or off, based on the status of the current frame. + "Toggle display of the menu bar of the current frame. See `menu-bar-mode' for more information." (interactive (list (or current-prefix-arg 'toggle))) (if (eq arg 'toggle) commit 184a4977c7f83c1ba5d4a693713355e104a7cb3e Author: Glenn Morris Date: Sat Sep 12 09:51:32 2020 -0700 Make vc-bzr tests work with brz 3.1 (bug#43314) * test/lisp/vc/vc-bzr-tests.el (vc-bzr-test-bug9726) (vc-bzr-test-bug9781, vc-bzr-test-faulty-bzr-autoloads): Make them work with brz 3.1. diff --git a/test/lisp/vc/vc-bzr-tests.el b/test/lisp/vc/vc-bzr-tests.el index f738da7f41..b68a694512 100644 --- a/test/lisp/vc/vc-bzr-tests.el +++ b/test/lisp/vc/vc-bzr-tests.el @@ -38,13 +38,26 @@ ;; abort if they cannot. I could not figure out how to stop bzr ;; doing that, so just give it a temporary homedir for the duration. ;; http://bugs.launchpad.net/bzr/+bug/137407 ? + ;; + ;; Note that with bzr 2.x, this works: + ;; mkdir /tmp/bzr + ;; HOME=/nonexistent BZR_HOME=/tmp/bzr bzr status + ;; but with brz 3.1, it complains: + ;; "failed to open trace file: [Errno 13] Permission denied: '/nonexistent'" + ;; which confuses vc-dir. + ;; We can quieten brz by adding either BRZ_LOG=/dev/null, or + ;; XDG_CACHE_HOME=/tmp/bzr (log defaults to XDG_CACHE_HOME/breezy/brz.log), + ;; but it seems simpler to just set HOME to a newly created + ;; temporary directory. + ;; TODO does this means tests should be setting XDG_ variables (not + ;; just HOME) to temporary values too? (let* ((homedir (make-temp-file "vc-bzr-test" t)) (bzrdir (expand-file-name "bzr" homedir)) (ignored-dir (progn (make-directory bzrdir) (expand-file-name "ignored-dir" bzrdir))) (default-directory (file-name-as-directory bzrdir)) - (process-environment (cons (format "BZR_HOME=%s" homedir) + (process-environment (cons (format "HOME=%s" homedir) process-environment))) (unwind-protect (progn @@ -81,7 +94,7 @@ (expand-file-name "subdir" bzrdir))) (file (expand-file-name "file" bzrdir)) (default-directory (file-name-as-directory bzrdir)) - (process-environment (cons (format "BZR_HOME=%s" homedir) + (process-environment (cons (format "HOME=%s" homedir) process-environment))) (unwind-protect (progn @@ -119,7 +132,7 @@ (expand-file-name "foo.el" bzrdir))) (default-directory (file-name-as-directory bzrdir)) (generated-autoload-file (expand-file-name "loaddefs.el" bzrdir)) - (process-environment (cons (format "BZR_HOME=%s" homedir) + (process-environment (cons (format "HOME=%s" homedir) process-environment))) (unwind-protect (progn commit 03093baf9093c0e855915da5085d272b11588a75 Author: Lars Ingebrigtsen Date: Sat Sep 12 13:08:29 2020 +0200 diff-no-select doc string clarification * lisp/vc/diff.el (diff-no-select): Update doc string from the trunk, don't merge. diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el index 9e7e771963..469888078c 100644 --- a/lisp/vc/diff.el +++ b/lisp/vc/diff.el @@ -145,9 +145,17 @@ 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. +If the optional SWITCHES is nil, the switches specified in the +variable ‘diff-switches’ are passed to the diff command, +otherwise SWITCHES is used. SWITCHES can be a string or a list +of strings. -See `diff' for the meaning of the arguments." +If NO-ASYNC is non-nil, call diff synchronously. + +By default, this function creates the diff in the \"*Diff*\" +buffer. If BUF is non-nil, BUF is used instead. This function +returns the buffer used." (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 694acda5f24e356264c3f2a55a49812e02bcb49a Author: Eli Zaretskii Date: Sat Sep 12 10:11:26 2020 +0300 Fix compilation on TERMINFO platforms with GCC 10 * src/terminfo.c [TERMINFO]: Don't redefine UP, BC, and CP, as that could cause linking errors due to multiple definitions. (Bug#43195) diff --git a/src/terminfo.c b/src/terminfo.c index 51fd32e9e0..0765996401 100644 --- a/src/terminfo.c +++ b/src/terminfo.c @@ -23,9 +23,12 @@ along with GNU Emacs. If not, see . */ /* Define these variables that serve as global parameters to termcap, so that we do not need to conditionalize the places in Emacs - that set them. */ + that set them. But don't do that for terminfo, as that could + cause link errors when using -fno-common. */ +#if !TERMINFO char *UP, *BC, PC; +#endif /* Interface to curses/terminfo library. Turns out that all of the terminfo-level routines look commit f3373901e5cc6c198cc36af29f9e2f64402f3e9e Author: Lars Ingebrigtsen Date: Thu Sep 10 22:52:47 2020 +0200 Fix the font-lock-debug-fontify NEWS entry * etc/NEWS: Fix the name of `font-lock-debug-fontify' (bug#43319). diff --git a/etc/NEWS b/etc/NEWS index 2571108c9e..57fdada357 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -651,7 +651,7 @@ same as the 'C-x C-+' and 'C-x C--' commands. This new command (which inserts an _ skeleton) is bound to 'C-c C-c #'. -** New command 'font-lock-refontify'. +** New command 'font-lock-debug-fontify'. This is an interactive convenience function to be used when developing font locking for a mode. It recomputes the font locking data and then re-fontifies the buffer.