commit 2970d73a71d3c1dff016e98263c0becd12bf1781 (HEAD, refs/remotes/origin/master) Author: Jeff Walsh Date: Thu Oct 15 09:55:29 2020 +0200 Fix segfault in xwidget when there is no title * src/xwidget.c (Fxwidget_webkit_title): Pass emptry string when no title is returned (bug#43989). diff --git a/src/xwidget.c b/src/xwidget.c index 154b3e9c82..e63191ebda 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -793,7 +793,9 @@ DEFUN ("xwidget-webkit-title", WEBKIT_FN_INIT (); #ifdef USE_GTK WebKitWebView *wkwv = WEBKIT_WEB_VIEW (xw->widget_osr); - return build_string (webkit_web_view_get_title (wkwv)); + const gchar *title = webkit_web_view_get_title (wkwv); + + return build_string (title ? title : ""); #elif defined NS_IMPL_COCOA return nsxwidget_webkit_title (xw); #endif commit 730ea4c370826277501ff3e364a5e5e92387bd5d Author: Lars Ingebrigtsen Date: Thu Oct 15 09:17:45 2020 +0200 Fix problem with next-error-message-highlight in *Occur* * lisp/simple.el (next-error-message-highlight): This function is called directly, so clean up the code a bit (bug#32676). (next-error-found): Pass in the error buffer. diff --git a/lisp/simple.el b/lisp/simple.el index a24f2844aa..bd19969341 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -393,7 +393,7 @@ and TO-BUFFER is a target buffer." (when next-error-recenter (recenter next-error-recenter)) (funcall next-error-found-function from-buffer to-buffer) - (next-error-message-highlight) + (next-error-message-highlight from-buffer) (run-hooks 'next-error-hook)) (defun next-error-select-buffer (buffer) @@ -478,20 +478,18 @@ buffer causes automatic display of the corresponding source code location." (next-error-no-select 0)) (error t)))) -(defun next-error-message-highlight () +(defun next-error-message-highlight (error-buffer) "Highlight the current error message in the ‘next-error’ buffer." (when next-error-message-highlight - (with-current-buffer next-error-last-buffer + (with-current-buffer error-buffer (when next-error--message-highlight-overlay (delete-overlay next-error--message-highlight-overlay)) - (save-excursion - (goto-char compilation-current-error) - (let ((ol (make-overlay (line-beginning-position) (line-end-position)))) - ;; do not override region highlighting - (overlay-put ol 'priority -50) - (overlay-put ol 'face 'next-error-message) - (overlay-put ol 'window (get-buffer-window)) - (setf next-error--message-highlight-overlay ol)))))) + (let ((ol (make-overlay (line-beginning-position) (line-end-position)))) + ;; do not override region highlighting + (overlay-put ol 'priority -50) + (overlay-put ol 'face 'next-error-message) + (overlay-put ol 'window (get-buffer-window)) + (setf next-error--message-highlight-overlay ol))))) ;;; commit 8de04e08c84294ec5888353fc463b4778bee435e Author: Lars Ingebrigtsen Date: Thu Oct 15 08:55:27 2020 +0200 Fix NEWS item for C-h R diff --git a/etc/NEWS b/etc/NEWS index cb35dc8483..6b9105f577 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -572,9 +572,7 @@ skipped. *** New command 'describe-keymap' describes keybindings in a keymap. --- -*** New keybinding in 'help-for-help' to display a manual. -The 'R' keybinding after 'C-h C-h' will prompt for a manual name and -then display it. +*** New keybinding 'C-h R' prompts for a manual to display and displays it. +++ ** New command 'lossage-size'. commit a38002cecdb5092004a23efa9409abc7882dbdaa Author: Lars Ingebrigtsen Date: Thu Oct 15 08:39:00 2020 +0200 Make Gnus more liberal when interpreting Face headers again * lisp/gnus/gnus-fun.el (gnus-convert-face-to-png): Do it. * lisp/gnus/gnus-util.el (gnus-base64-repad): Allow not checking anything, but just repadding. diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el index 2461fd45fd..3218649761 100644 --- a/lisp/gnus/gnus-fun.el +++ b/lisp/gnus/gnus-fun.el @@ -205,7 +205,7 @@ different input formats." (defun gnus-convert-face-to-png (face) "Convert FACE (which is base64-encoded) to a PNG. The PNG is returned as a string." - (let ((face (gnus-base64-repad face))) + (let ((face (gnus-base64-repad face nil nil t))) (mm-with-unibyte-buffer (insert face) (ignore-errors diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 684c535f14..807bd6a14a 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -1343,7 +1343,7 @@ forbidden in URL encoding." (setq tmp (concat tmp str)) tmp)) -(defun gnus-base64-repad (str &optional reject-newlines line-length) +(defun gnus-base64-repad (str &optional reject-newlines line-length no-check) "Take a base 64-encoded string and return it padded correctly. Existing padding is ignored. @@ -1353,7 +1353,9 @@ If LINE-LENGTH is set and the string (or any line in the string if REJECT-NEWLINES is nil) is longer than that number, raise an error. Common line length for input characters are 76 plus CRLF (RFC 2045 MIME), 64 plus CRLF (RFC 1421 PEM), and 1000 including -CRLF (RFC 5321 SMTP)." +CRLF (RFC 5321 SMTP). + +If NOCHECK, don't check anything, but just repad." ;; RFC 4648 specifies that: ;; - three 8-bit inputs make up a 24-bit group ;; - the 24-bit group is broken up into four 6-bit values @@ -1372,6 +1374,8 @@ CRLF (RFC 5321 SMTP)." ;; RFC 5322 section 2.2.3 consideration: ;; Because base 64-encoded strings can appear in long header fields, remove ;; folding whitespace while still observing the RFC 4648 decisions above. + (when no-check + (setq str (replace-regexp-in-string "[\n\r \t]+" "" str))); (let ((splitstr (split-string str "[ \t]*[\r\n]+[ \t]?" t))) (when (and reject-newlines (> (length splitstr) 1)) (error "Invalid Base64 string")) diff --git a/test/lisp/gnus/gnus-util-tests.el b/test/lisp/gnus/gnus-util-tests.el index 47f0a9cf76..4869d162fb 100644 --- a/test/lisp/gnus/gnus-util-tests.el +++ b/test/lisp/gnus/gnus-util-tests.el @@ -133,8 +133,6 @@ (should (equal '("1" "1") (gnus-setdiff '(2 "1" 2 "1") '(2))))) (ert-deftest gnus-base64-repad () - (should-error (gnus-base64-repad "" nil nil nil) - :type 'wrong-number-of-arguments) (should-error (gnus-base64-repad 1) :type 'wrong-type-argument) commit 051d31cc797e3601b4a8704bc62343f633cba423 Author: Richard M Stallman Date: Wed Oct 14 19:17:48 2020 -0400 Clarify wording Clarify doc string of line-to-top-of-window. diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 1bd2849bb3..b13b16285c 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -17523,7 +17523,7 @@ Here is the definition: ;;; Line to top of window; ;;; replace three keystroke sequence C-u 0 C-l (defun line-to-top-of-window () - "Move the line point is on to top of window." + "Move the line that point is on to top of window." (interactive) (recenter 0)) @end group commit e8752cf7a94dabc94c34c0b0c54f6a29637bfb5a Author: Richard M Stallman Date: Wed Oct 14 19:11:20 2020 -0400 Handle retrying of MIME failure messages * rmail.el (rmail-retry-failure): Handle retrying of MIME failure messages. diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 7ff7db3e8c..86084b03f4 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -2877,9 +2877,9 @@ The current mail message becomes the message displayed." (rmail-display-labels) (rmail-swap-buffers) (setq rmail-buffer-swapped t) - (run-hooks 'rmail-show-message-hook) (when showing-message - (setq blurb (format "Showing message %d...done" msg))))) + (setq blurb (format "Showing message %d...done" msg))) + (run-hooks 'rmail-show-message-hook))) blurb)) (defun rmail-copy-headers (beg _end &optional ignored-headers) @@ -4147,22 +4147,12 @@ The variable `rmail-retry-ignored-headers' is a regular expression specifying headers which should not be copied into the new message." (interactive) (require 'mail-utils) - ;; FIXME This does not handle rmail-mime-feature != 'rmailmm. - ;; There is no API defined for rmail-mime-feature to provide - ;; rmail-mime-message-p, rmail-mime-toggle-raw equivalents. - ;; But does anyone actually use rmail-mime-feature != 'rmailmm? - (if (and rmail-enable-mime - (eq rmail-mime-feature 'rmailmm) - (featurep rmail-mime-feature)) - (with-current-buffer rmail-buffer - (if (rmail-mime-message-p) - (let ((rmail-mime-mbox-buffer rmail-view-buffer) - (rmail-mime-view-buffer rmail-buffer)) - (rmail-mime-toggle-raw 'raw))))) - - (let ((rmail-this-buffer (current-buffer)) + (let (bounce-buffer ;; Buffer we found it in + bounce-start ;; Position of start of failed message in that buffer + bounce-end ;; Position of end of failed message in that buffer + bounce-indent ;; Number of columns we need to de-indent it. (msgnum rmail-current-message) - bounce-start bounce-end bounce-indent resending + resending (content-type (rmail-get-header "Content-Type"))) (save-excursion (goto-char (point-min)) @@ -4171,19 +4161,27 @@ specifying headers which should not be copied into the new message." (string-match ";[\n\t ]*boundary=\"?\\([-0-9a-z'()+_,./:=? ]+\\)\"?" content-type)) - ;; Handle a MIME multipart bounce message. + ;; Handle a MIME multipart bounce message + ;; by scanning the raw buffer. (let ((codestring (concat "\n--" (substring content-type (match-beginning 1) - (match-end 1))))) - (unless (re-search-forward mail-mime-unsent-header nil t) - (error "Cannot find beginning of header in failed message")) - (unless (search-forward "\n\n" nil t) - (error "Cannot find start of Mime data in failed message")) - (setq bounce-start (point)) - (if (search-forward codestring nil t) - (setq bounce-end (match-beginning 0)) - (setq bounce-end (point-max)))) + (match-end 1)))) + (beg (rmail-msgbeg msgnum)) + (end (rmail-msgend msgnum))) + (with-current-buffer rmail-view-buffer + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (unless (re-search-forward mail-mime-unsent-header nil t) + (error "Cannot find beginning of header in failed message")) + (unless (search-forward "\n\n" nil t) + (error "Cannot find start of Mime data in failed message")) + (setq bounce-start (point)) + (setq bounce-buffer (current-buffer)) + (if (search-forward codestring nil t) + (setq bounce-end (match-beginning 0)) + (setq bounce-end (point-max)))))) ;; Non-MIME bounce. (or (re-search-forward mail-unsent-separator nil t) (error "Cannot parse this as a failure message")) @@ -4198,6 +4196,7 @@ specifying headers which should not be copied into the new message." (setq bounce-indent (- (current-column))) (goto-char (point-max)) (re-search-backward "^End of returned message$" nil t) + (setq bounce-buffer (current-buffer)) (setq bounce-end (point))) ;; One message contained a few random lines before ;; the old message header. The first line of the @@ -4214,8 +4213,10 @@ specifying headers which should not be copied into the new message." (setq bounce-start (point)) (goto-char (point-max)) (search-backward (concat "\n\n" boundary) bounce-start t) + (setq bounce-buffer (current-buffer)) (setq bounce-end (point))) (setq bounce-start (point) + bounce-buffer (current-buffer) bounce-end (point-max))) (unless (search-forward "\n\n" nil t) (error "Cannot find end of header in failed message")))))) @@ -4224,9 +4225,9 @@ specifying headers which should not be copied into the new message." ;; Turn off the usual actions for initializing the message body ;; because we want to get only the text from the failure message. (let (mail-signature mail-setup-hook) - (if (rmail-start-mail nil nil nil nil nil rmail-this-buffer + (if (rmail-start-mail nil nil nil nil nil rmail-buffer (list (list 'rmail-mark-message - rmail-this-buffer + rmail-buffer (aref rmail-msgref-vector msgnum) rmail-retried-attr-index))) ;; Insert original text as initial text of new draft message. @@ -4235,7 +4236,7 @@ specifying headers which should not be copied into the new message." (let ((inhibit-read-only t) eoh) (erase-buffer) - (insert-buffer-substring rmail-this-buffer + (insert-buffer-substring bounce-buffer bounce-start bounce-end) (goto-char (point-min)) (if bounce-indent commit e6aab30128c29dc705065846c4b9c9e17761a240 Author: Richard M Stallman Date: Wed Oct 14 19:10:02 2020 -0400 Handle encrypting mime parts * epa-mail.el (epa-mail-encrypt): Insert any encoded mime parts that are queued up to insert before sending the message. diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el index 3ad4da16c8..dd171ab647 100644 --- a/lisp/epa-mail.el +++ b/lisp/epa-mail.el @@ -243,6 +243,11 @@ If no one is selected, symmetric encryption will be performed. " (setq epa-last-coding-system-specified (or coding-system-for-write (select-safe-coding-system (point) (point-max))))) + + ;; Insert contents of requested attachments, if any. + (when (and (eq major-mode 'mail-mode) mail-encode-mml) + (mml-to-mime) + (setq mail-encode-mml nil)) ;; Don't let some read-only text stop us from encrypting. (let ((inhibit-read-only t)) commit 0fac3f55325cf33e797b33be9935bf39f344c7c9 Author: Stefan Monnier Date: Wed Oct 14 18:03:52 2020 -0400 * lisp/calc: Fix a few issues introduced by lexical scoping Fix a few places I missed, where we incorrectly used lexical scoping on a var that needed dynamic scoping. These were detected thanks to a bit of footwork by Mattias Engdegård! * lisp/calc/calc-ext.el (math-read-big-lines): Declare as dynbound. (math-read-big-bigp): Bind it inside a `let`. * lisp/calc/calc-graph.el (math-arglist): Declare as dynbound. * lisp/calc/calc-map.el (math-arglist): Declare as dynbound. * lisp/calc/calc-misc.el (math-trunc-prec): Declare as dynbound. (math-trunc): Bind it inside a `let`. (math-floor-prec): Declare as dynbound. (math-floor): Bind it inside a `let`. * lisp/calc/calc-nlfit.el (calc-curve-varnames, calc-curve-coefnames): Declare as dynbound. * lisp/calc/calc-sel.el (math-comp-sel-tag): Declare as dynbound. * lisp/calc/calcsel2.el (calc-sel-reselect): Declare as dynbound. diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index fc0a2c88fe..c48d159582 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el @@ -3094,6 +3094,7 @@ If X is not an error form, return 1." (defvar math-read-big-baseline) (defvar math-read-big-h2) (defvar math-read-big-err-msg) +(defvar math-read-big-lines) (defun math-read-big-expr (str) (and (> (length calc-left-label) 0) @@ -3138,41 +3139,42 @@ If X is not an error form, return 1." (defvar math-rb-h2) -(defun math-read-big-bigp (math-read-big-lines) - (and (cdr math-read-big-lines) - (let ((matrix nil) - (v 0) - (height (if (> (length (car math-read-big-lines)) 0) 1 0))) - (while (and (cdr math-read-big-lines) - (let* ((i 0) - j - (l1 (car math-read-big-lines)) - (l2 (nth 1 math-read-big-lines)) - (len (min (length l1) (length l2)))) - (if (> (length l2) 0) - (setq height (1+ height))) - (while (and (< i len) - (or (memq (aref l1 i) '(?\ ?\- ?\_)) - (memq (aref l2 i) '(?\ ?\-)) - (and (memq (aref l1 i) '(?\| ?\,)) - (= (aref l2 i) (aref l1 i))) - (and (eq (aref l1 i) ?\[) - (eq (aref l2 i) ?\[) - (let ((math-rb-h2 (length l1))) - (setq j (math-read-big-balance - (1+ i) v "["))) - (setq i (1- j))))) - (setq i (1+ i))) - (or (= i len) - (and (eq (aref l1 i) ?\[) - (eq (aref l2 i) ?\[) - (setq matrix t) - nil)))) - (setq math-read-big-lines (cdr math-read-big-lines) - v (1+ v))) - (or (and (> height 1) - (not (cdr math-read-big-lines))) - matrix)))) +(defun math-read-big-bigp (read-big-lines) + (when (cdr read-big-lines) + (let ((math-read-big-lines read-big-lines) + (matrix nil) + (v 0) + (height (if (> (length (car read-big-lines)) 0) 1 0))) + (while (and (cdr math-read-big-lines) + (let* ((i 0) + j + (l1 (car math-read-big-lines)) + (l2 (nth 1 math-read-big-lines)) + (len (min (length l1) (length l2)))) + (if (> (length l2) 0) + (setq height (1+ height))) + (while (and (< i len) + (or (memq (aref l1 i) '(?\ ?\- ?\_)) + (memq (aref l2 i) '(?\ ?\-)) + (and (memq (aref l1 i) '(?\| ?\,)) + (= (aref l2 i) (aref l1 i))) + (and (eq (aref l1 i) ?\[) + (eq (aref l2 i) ?\[) + (let ((math-rb-h2 (length l1))) + (setq j (math-read-big-balance + (1+ i) v "["))) + (setq i (1- j))))) + (setq i (1+ i))) + (or (= i len) + (and (eq (aref l1 i) ?\[) + (eq (aref l2 i) ?\[) + (setq matrix t) + nil)))) + (setq math-read-big-lines (cdr math-read-big-lines) + v (1+ v))) + (or (and (> height 1) + (not (cdr math-read-big-lines))) + matrix)))) ;;; Nontrivial "flat" formatting. diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el index 82e9335716..829fa44ca4 100644 --- a/lisp/calc/calc-graph.el +++ b/lisp/calc/calc-graph.el @@ -313,6 +313,7 @@ (defvar calc-graph-blank) (defvar calc-graph-non-blank) (defvar calc-graph-curve-num) +(defvar math-arglist) (defun calc-graph-plot (flag &optional printing) (interactive "P") diff --git a/lisp/calc/calc-map.el b/lisp/calc/calc-map.el index 57483fc659..0ee8282692 100644 --- a/lisp/calc/calc-map.el +++ b/lisp/calc/calc-map.el @@ -493,6 +493,8 @@ (defvar calc-get-operator-history nil "History for calc-get-operator.") +(defvar math-arglist) + (defun calc-get-operator (msg &optional nargs) (setq calc-aborted-prefix nil) (let ((inv nil) (hyp nil) (prefix nil) (forcenargs nil) diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el index 7c97dc6a9a..2db09e2b67 100644 --- a/lisp/calc/calc-misc.el +++ b/lisp/calc/calc-misc.el @@ -757,19 +757,21 @@ loaded and the keystroke automatically re-typed." ;; The variable math-trunc-prec is local to math-trunc, but used by ;; math-trunc-fancy in calc-arith.el, which is called by math-trunc. +(defvar math-trunc-prec) ;;;###autoload -(defun math-trunc (a &optional math-trunc-prec) - (cond (math-trunc-prec +(defun math-trunc (a &optional trunc-prec) + (cond (trunc-prec (require 'calc-ext) - (math-trunc-special a math-trunc-prec)) + (math-trunc-special a trunc-prec)) ((Math-integerp a) a) ((Math-looks-negp a) (math-neg (math-trunc (math-neg a)))) ((eq (car a) 'float) (math-scale-int (nth 1 a) (nth 2 a))) (t (require 'calc-ext) - (math-trunc-fancy a)))) + (let ((math-trunc-prec trunc-prec)) + (math-trunc-fancy a))))) ;;;###autoload (defalias 'calcFunc-trunc 'math-trunc) @@ -777,12 +779,13 @@ loaded and the keystroke automatically re-typed." ;; The variable math-floor-prec is local to math-floor, but used by ;; math-floor-fancy in calc-arith.el, which is called by math-floor. +(defvar math-floor-prec) ;;;###autoload -(defun math-floor (a &optional math-floor-prec) ; [Public] - (cond (math-floor-prec +(defun math-floor (a &optional floor-prec) ; [Public] + (cond (floor-prec (require 'calc-ext) - (math-floor-special a math-floor-prec)) + (math-floor-special a floor-prec)) ((Math-integerp a) a) ((Math-messy-integerp a) (math-trunc a)) ((Math-realp a) @@ -790,7 +793,9 @@ loaded and the keystroke automatically re-typed." (math-add (math-trunc a) -1) (math-trunc a))) (t (require 'calc-ext) - (math-floor-fancy a)))) + (let ((math-floor-prec floor-prec)) + (math-floor-fancy a))))) + ;;;###autoload (defalias 'calcFunc-floor 'math-floor) diff --git a/lisp/calc/calc-nlfit.el b/lisp/calc/calc-nlfit.el index 6f2a601cd9..5ed85fe7ca 100644 --- a/lisp/calc/calc-nlfit.el +++ b/lisp/calc/calc-nlfit.el @@ -665,6 +665,8 @@ (calc-handle-whys)) (defvar calc-curve-nvars) +(defvar calc-curve-varnames) +(defvar calc-curve-coefnames) (defun math-nlfit-fit-curve (fn grad solnexpr initparms &optional sdv) (calc-slow-wrapper diff --git a/lisp/calc/calc-sel.el b/lisp/calc/calc-sel.el index d294448887..23c0e01b52 100644 --- a/lisp/calc/calc-sel.el +++ b/lisp/calc/calc-sel.el @@ -419,6 +419,7 @@ ;; The variable math-comp-sel-tag is local to calc-find-selected-part, ;; but is used by math-comp-sel-flat-term and math-comp-add-string-sel ;; in calccomp.el, which are called (indirectly) by calc-find-selected-part. +(defvar math-comp-sel-tag) (defun calc-find-selected-part () (let* ((math-comp-sel-hpos (- (current-column) calc-selection-cache-offset)) @@ -437,7 +438,8 @@ (current-indentation)) lcount (1+ lcount))) (- lcount (math-comp-ascent - calc-selection-cache-comp) -1)))) + calc-selection-cache-comp) + -1)))) (math-comp-sel-cpos (- (point) toppt calc-selection-cache-offset spaces lcount)) (math-comp-sel-tag nil)) diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el index 99d0549ca8..7894bd9301 100644 --- a/lisp/calc/calcalg2.el +++ b/lisp/calc/calcalg2.el @@ -3259,16 +3259,16 @@ (let ((math-solve-simplifying t)) (math-solve-system-rec exprs math-solve-vars nil))))) -;;; The following backtracking solver works by choosing a variable -;;; and equation, and trying to solve the equation for the variable. -;;; If it succeeds it calls itself recursively with that variable and -;;; equation removed from their respective lists, and with the solution -;;; added to solns as well as being substituted into all existing -;;; equations. The algorithm terminates when any solution path -;;; manages to remove all the variables from var-list. - -;;; To support calcFunc-roots, entries in eqn-list and solns are -;;; actually lists of equations. +;; The following backtracking solver works by choosing a variable +;; and equation, and trying to solve the equation for the variable. +;; If it succeeds it calls itself recursively with that variable and +;; equation removed from their respective lists, and with the solution +;; added to solns as well as being substituted into all existing +;; equations. The algorithm terminates when any solution path +;; manages to remove all the variables from `var-list'. + +;; To support calcFunc-roots, entries in eqn-list and solns are +;; actually lists of equations. ;; The variables math-solve-system-res and math-solve-system-vv are ;; local to math-solve-system-rec, but are used by math-solve-system-subst. diff --git a/lisp/calc/calcsel2.el b/lisp/calc/calcsel2.el index faec230939..d6842aa7ee 100644 --- a/lisp/calc/calcsel2.el +++ b/lisp/calc/calcsel2.el @@ -34,6 +34,7 @@ ;; The variable calc-sel-reselect is local to the methods below, ;; but is used by some functions in calc-sel.el which are called ;; by the functions below. +(defvar calc-sel-reselect) (defun calc-commute-left (arg) (interactive "p") commit 423439b38067c4a428310edab24fba7da082027c Author: Andreas Schwab Date: Wed Oct 14 21:52:57 2020 +0200 Fix layout of custom-face-edit widget * lisp/cus-edit.el (custom-face-edit): Add :format to group widget. (Bug#43977) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 3c93753495..510c6e3b4c 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -3205,6 +3205,7 @@ face attributes (as specified by a `default' defface entry)." :convert-widget 'custom-face-edit-convert-widget :args (mapcar (lambda (att) (list 'group :inline t + :format "%v" :sibling-args (widget-get (nth 1 att) :sibling-args) (list 'const :format "" :value (nth 0 att)) (nth 1 att))) commit 4bf9bb56b56b4acacd5d9430a19db32291bd078b Author: Juri Linkov Date: Wed Oct 14 11:56:23 2020 +0300 Highlight regexp sub-expressions in query-replace * lisp/replace.el (query-replace-highlight-submatches): New defcustom. (replace-submatches-overlays): New variable. (replace-highlight): Use query-replace-highlight-submatches. (replace-dehighlight): Use query-replace-highlight-submatches. * doc/emacs/search.texi (Query Replace): Add documentation for query-replace-highlight-submatches. Suggested by Drew Adams in bug#43702. diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index 2169a4120b..91b433f173 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -1662,6 +1662,7 @@ reused. @cindex @code{query-replace} face @cindex @code{lazy-highlight} face, in replace @vindex query-replace-highlight +@vindex query-replace-highlight-submatches @vindex query-replace-lazy-highlight @vindex query-replace-show-replacement These commands highlight the current match using the face @@ -1674,6 +1675,10 @@ other matches using @code{lazy-highlight} just like incremental search string for the current match in the minibuffer. If you want to keep special sequences @samp{\&} and @samp{\@var{n}} unexpanded, customize @code{query-replace-show-replacement} variable. +Like @code{search-highlight-submatches} highlights subexpressions in +incremental search (@pxref{Search Customizations}), the variable +@code{query-replace-highlight-submatches} defines whether to highlight +subexpressions in the regexp replacement commands. @vindex query-replace-skip-read-only The variable @code{query-replace-skip-read-only}, if set diff --git a/etc/NEWS b/etc/NEWS index 0ee69d9af9..cb35dc8483 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1163,6 +1163,11 @@ This is controlled by the 'search-highlight-submatches' user option. This feature is available only on terminals that have enough colors to distinguish between sub-expression highlighting. ++++ +*** Interactive regular expression replace now uses faces for sub-groups. +Like 'search-highlight-submatches', this is controlled by the new user option +'query-replace-highlight-submatches'. + --- *** New user option 'reveal-auto-hide'. If non-nil (the default), revealed text is automatically hidden when diff --git a/lisp/replace.el b/lisp/replace.el index e363924501..d34cabfe89 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -126,6 +126,18 @@ This variable affects only `query-replace-regexp'." :type 'boolean :group 'matching) +(defcustom query-replace-highlight-submatches t + "Whether to highlight regexp subexpressions during query replacement. +The faces used to do the highlights are named `isearch-group-1', +`isearch-group-2', etc. (By default, only these 2 are defined.) +When there are more matches than faces, then faces are reused from the +beginning, in a cyclical manner, so the `isearch-group-1' face is +isreused for the third match. If you want to use more distinctive colors, +you can define more of these faces using the same numbering scheme." + :type 'boolean + :group 'matching + :version "28.1") + (defcustom query-replace-lazy-highlight t "Controls the lazy-highlighting during query replacements. When non-nil, all text in the buffer matching the current match @@ -2403,6 +2415,7 @@ It is called with three arguments, as if it were (funcall search-function search-string limit t))) (defvar replace-overlay nil) +(defvar replace-submatches-overlays nil) (defun replace-highlight (match-beg match-end range-beg range-end search-string regexp-flag delimited-flag @@ -2413,6 +2426,25 @@ It is called with three arguments, as if it were (setq replace-overlay (make-overlay match-beg match-end)) (overlay-put replace-overlay 'priority 1001) ;higher than lazy overlays (overlay-put replace-overlay 'face 'query-replace))) + + (when (and query-replace-highlight-submatches + regexp-flag) + (mapc 'delete-overlay replace-submatches-overlays) + (setq replace-submatches-overlays nil) + (let ((submatch-data (cddr (butlast (match-data t)))) + (group 0) + ov face) + (while submatch-data + (setq group (1+ group)) + (setq ov (make-overlay (pop submatch-data) (pop submatch-data)) + face (intern-soft (format "isearch-group-%d" group))) + ;; Recycle faces from beginning. + (unless (facep face) + (setq group 1 face 'isearch-group-1)) + (overlay-put ov 'face face) + (overlay-put ov 'priority 1002) + (push ov replace-submatches-overlays)))) + (if query-replace-lazy-highlight (let ((isearch-string search-string) (isearch-regexp regexp-flag) @@ -2433,6 +2465,9 @@ It is called with three arguments, as if it were (defun replace-dehighlight () (when replace-overlay (delete-overlay replace-overlay)) + (when query-replace-highlight-submatches + (mapc 'delete-overlay replace-submatches-overlays) + (setq replace-submatches-overlays nil)) (when query-replace-lazy-highlight (lazy-highlight-cleanup lazy-highlight-cleanup) (setq isearch-lazy-highlight-last-string nil)) commit b13e0c1501a21e942692718194c634e01a13928a Author: Juri Linkov Date: Wed Oct 14 11:45:26 2020 +0300 * lisp/progmodes/grep.el: More fixes for 'lgrep' (bug#23590) * lisp/progmodes/grep.el (grep-expand-template): Add new arg 'more-opts'. (grep-use-directories-skip): New variable. (lgrep): Set 'grep-use-directories-skip' to the result of 'grep-probe'. Use "--directories=skip" when 'grep-use-directories-skip' is t. diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index f028a4279d..9683826974 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -959,10 +959,10 @@ The substitution is based on variables bound dynamically, and these include `opts', `dir', `files', `null-device', `excl' and `regexp'.") -(defun grep-expand-template (template &optional regexp files dir excl) +(defun grep-expand-template (template &optional regexp files dir excl more-opts) "Expand grep COMMAND string replacing , , , , and ." (let* ((command template) - (env `((opts . ,(let (opts) + (env `((opts . ,(let ((opts more-opts)) (when (and case-fold-search (isearch-no-upper-case-p regexp t)) (push "-i" opts)) @@ -1058,6 +1058,8 @@ REGEXP is used as a string in the prompt." (or (cdr (assoc files grep-files-aliases)) files)))) +(defvar grep-use-directories-skip 'auto-detect) + ;;;###autoload (defun lgrep (regexp &optional files dir confirm) "Run grep, searching for REGEXP in FILES in directory DIR. @@ -1103,6 +1105,12 @@ command before it's run." (if (string= command grep-command) (setq command nil)) (setq dir (file-name-as-directory (expand-file-name dir))) + (unless (or (not grep-use-directories-skip) (eq grep-use-directories-skip t)) + (setq grep-use-directories-skip + (grep-probe grep-program + `(nil nil nil "--directories=skip" "foo" + ,null-device) + nil 1))) (setq command (grep-expand-template grep-template regexp @@ -1119,13 +1127,10 @@ command before it's run." (shell-quote-argument (cdr ignore)))))) grep-find-ignored-files - " --exclude="))))) + " --exclude="))) + (and (eq grep-use-directories-skip t) + '("--directories=skip")))) (when command - (when (grep-probe grep-program - `(nil nil nil "--directories=skip" "foo" - ,null-device) - nil 1) - (setq command (concat command " --directories=skip"))) (if confirm (setq command (read-from-minibuffer "Confirm: "